Need MUMPS Sample Code

I am working on an analysis tool for which I need开发者_如何学Python MUMPS sample code. Can anyone provide me MUMPS live code or sample code? Also suggest some links for same.

---

This is some MUMPS i wrote for fun. I guess if you can analyze this, your tool works:

Q N R,Q,C,D,E,W,B,G,H,S,T,U,V,F,L,P,N,J,A S N=$G(N),Q='N,F=Q+Q,P=F+F,W=$L($T(Q))
 S W=$E(W,Q),S='N_+N,W=W-F*S,L=$G(L),R=$C(Q_F_P),R(F)=$C(F+Q_F),R(P)=$C(W-F) W #
 S T=$E($T(Q+F),F,W\S)_$C(W+S+F) X T S B=$P(T,$C(P_P),F),C=B\(W*W),D=B-(C*W*W)\W
 F G=S-Q:F:S+F+Q S E=B-(C*W*W+(D*W)),H=$E($T(Q),G),@H=$S(@H<S:'Q,Q:N)_@H,T=C_D_E
 F A=Q:Q:W\S S J=$E(T,A),C(F)=$S(J>(F+Q)&(J<(S-F)):Q,Q:+N),C(P)=$S(J#F:Q,Q:+N) D
 .S C(Q)=$S(J<(S-F):+N,Q:Q),C(F+Q)=$S(J>Q&(J<(S-F))&(J'=(P+'L))&(J'=(P)):Q,Q:+N)
 .S H('L)=L F  S H(N?.E)=$O(C(H('$G(N)))) Q:H('+L)=L  S F(A,H('L))=C(H(W[(W\S)))
 F U=Q:Q:P W !,R F V=Q:Q:P+F W $S(F(V,U):'Q,Q:$C(P_(W\S))) W:'(V#F) $C('N_F_F+F)
 W !!,R(F)_C_R(P)_D_R(P)_E_R(F) X $RE($E($T(Q),Q+F,P+Q))_R(P)_'N W # G:N=L Q+F Q

look ma, no literals!

This outputs a binary clock:

:D Q^ROU


|..|..|..|
|..|..|.0|
|..|.0|0.|
|..|00|..|

 00:13:24

---

GitHub actually host many MUMPS software, but it unfortunatly get tagged as Objective-C or Matlab so it is not easy to search for MUMPS code over there. Here are some projects I know are done at least partially using MUMPS :

1. OSEHRA
2. Reynard GT.M Server
3. GT.M Term Size
4. GT.M POSIX Extension
5. Tetris in MUMPS
6. Juicy MUMPS Example
7. GT.M PCRE Extension
8. GT.M Digest Extension
9. DataBallet
10. Source KIDS
11. Software development tools for MUMPS

---

I don't think any of this will be enough for analysis purposes, but there are a lot of small examples at M[UMPS] by Example. There's also some lengthy samples on the MUMPS Wikipedia page. I don't know if they are stand alone or not. Haven't tested them myself.

---

VistA is an open source EMR for the Veteran's Administration written on MUMPS. You can download it off of the VistA wiki here: OpenVistA Download Page

I haven't tried to download it myself, so you may need to install MUMPS to get access to the source. Good Luck!

---

Look here:

http://www.faqs.org/faqs/m-technology-faq/part2/

Scroll down to (or search for) the section heading "Appendix 6" (without the double-quotes).

HTH Nathan

---

Here is the sample piece of code, to loop though a global, traverse it and print the data in the terminal.

TESTLOG
 S TC=""
 F  S TC=$O(^TCLOG(TC))  Q:TC=""  D
 . S LogDT=""
 . F  S LogDT=$O(^TCLOG(TC,LogDT))  Q:LogDT=""  D
 . . S Type=""
 . . F  S Type=$O(^TCLOG(TC,LogDT,Type))  Q:Type=""  D 
 . . . Q:Type'="UPDATE"
 . . . S LogData=$G(^TCLOG(TC,LogDT,"UPDATE"))
 . . . W !,LogData

 Q

And find the below link for some more reference http://www.vistapedia.com/index.php/MUMPS_Code_Examples

---

Here's "hello world": w "Hello world!",!

The w is an abbreviation of write - either is acceptable but the abbreviation is more idiomatic. The literal ! is a newline.

Here's a fibonacci implementation, first without abbreviations then with

innerFibonacci(value,cache)
  if $data(cache(value))=1 quit cache(value)
  set cache(value)=$$innerFibonacci(value-1,.cache)+$$innerFibonacci(value-2,.cache)
  quit cache(value) 
fibonacci(value)
  new cache
  set cache(0)=1
  set cache(1)=1
  quit $$innerFibonacci(value,.cache)

Here's the same thing with the more idiomatic abbreviations:

innerFibonacci(value,cache)
  i $d(cache(value))=1 q cache(value)
  s cache(value)=$$innerFibonacci(value-1,.cache)+$$innerFibonacci(value-2,.cache)
  q cache(value) 
fibonacci(value)
  n cache
  s cache(0)=1
  s cache(1)=1
  q $$innerFibonacci(value,.cache)

Now - recursion in MUMPS is a pretty dangerous thing to do because the MUMPS interpreter won't automatically convert tail recursions to iterations - so this could easily blow up for a large value.

Here's a little more "MUMPS-y" example, one that actually leverages MUMPS' single data structure, which is essentially a sorted array whose indices can be numbers or strings. Prefixing these arrays with ^ saves to disk. The $ things are functions built in to the language. The q: is a postcondition on the quit command, meaning 'quit if person is equal to ""'.

Here it is without abbreviations, then with:

peopleFoodCombinations(people,food)
  new person
  for  set person=$order(people(person)) quit:person=""  do
  . set ^PEOPLE(person,"favoriteFood")=$get(food(person))
  quit

Now with abbrevs:

peopleFoodCombinations(people,food)
  n person
  f  s person=$o(people(person)) q:person=""  d
  . s ^PEOPLE(person,"favoriteFood")=$g(food(person))
  q