| 1 | SPNAHOCX ;HISC/DAD-AD HOC REPORTS: INTERFACE COMPILER ; [ 02/23/95  5:49 PM ]
 | 
|---|
| 2 |  ;;2.0;Spinal Cord Dysfunction;;01/02/1997
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | BUILD ; *** Build the Ad Hoc Report interface routine(s)
 | 
|---|
| 5 |  K ^TMP($J,"SPNROU") S (SPNLEN,SPNRTNNO,SPNTAB,SPNLN)=0
 | 
|---|
| 6 |  F  S SPNLN=$O(^TMP($J,"SPNTXT",SPNLN)) Q:SPNLN'>0  D
 | 
|---|
| 7 |  . S X=^TMP($J,"SPNTXT",SPNLN,0),^TMP($J,"SPNROU",SPNLN,0)=X
 | 
|---|
| 8 |  . S SPNLEN=SPNLEN+$L(X)+2,SPNDONE='$O(^TMP($J,"SPNTXT",SPNLN))
 | 
|---|
| 9 |  . I SPNLEN'<3600!SPNDONE D
 | 
|---|
| 10 |  .. S SPNRTN=$S(SPNRTNNO=0:SPNPROG,1:$E(SPNPROG,1,8-$L(SPNRTNNO))_SPNRTNNO)
 | 
|---|
| 11 |  .. S SPNRTNXT=$S(SPNDONE:"",1:$E(SPNPROG,1,8-$L(SPNRTNNO+1))_(SPNRTNNO+1))
 | 
|---|
| 12 |  .. F SP=1:1 S X=$P($T(PROG+SP),";",3,99) Q:X=""  I @$P(X,U) D
 | 
|---|
| 13 |  ... S X="S Y="_$P(X,U,2,99) X X S ^TMP($J,"SPNROU",SP,0)=Y
 | 
|---|
| 14 |  ... Q
 | 
|---|
| 15 |  .. S DIE="^TMP($J,""SPNROU"",",XCN=0,X=SPNRTN X ^%ZOSF("SAVE")
 | 
|---|
| 16 |  .. K ^TMP($J,"SPNROU") S SPNLEN=0,SPNRTNNO=SPNRTNNO+1
 | 
|---|
| 17 |  .. W:SPNTAB=0 ! W ?SPNTAB,SPNRTN S SPNTAB=SPNTAB+$S(SPNTAB=70:-70,1:10)
 | 
|---|
| 18 |  .. Q
 | 
|---|
| 19 |  . Q
 | 
|---|
| 20 |  Q
 | 
|---|
| 21 | PROG ;;Include this code? (boolean) ^ Generic Ad Hoc report interface code
 | 
|---|
| 22 |  ;;1^SPNRTN_" ;HISC/DAD-AD HOC REPORTS: INTERFACE FOR THE "_SPNFILE(0)_" FILE (#"_SPNFILE_") ;"_SPNTODAY
 | 
|---|
| 23 |  ;;1^" ;;0.0;Package Name;;Mmm DD, YYYY"
 | 
|---|
| 24 |  ;;1^" ;;"_$P($T(SPNAHOCX+1),";",3,4)_";;"_$P($T(SPNAHOCX+1),";",6)
 | 
|---|
| 25 |  ;;'SPNRTNNO^" ; *** Set up required and optional variables and call Ad Hoc Rpt Gen"
 | 
|---|
| 26 |  ;;'SPNRTNNO^" S SPNMRTN=""MENU^"_SPNRTN_""",SPNORTN=""OTHER^"_SPNRTN_""",SPNDIC="_SPNFILE
 | 
|---|
| 27 |  ;;('SPNRTNNO)&(SPNMHDR]"")^" S SPNMHDR="""_SPNMHDR_""""
 | 
|---|
| 28 |  ;;'SPNRTNNO^" D ^SPNAHOC0"
 | 
|---|
| 29 |  ;;'SPNRTNNO^" Q"
 | 
|---|
| 30 |  ;;1^"MENU ; *** Build the menu array"
 | 
|---|
| 31 |  ;;'SPNRTNNO^" S SPNMENU=1"
 | 
|---|
| 32 |  ;;1^" F SP=1:1 S X=$P($T(TEXT+SP),"";"",3,99) Q:X=""""  D"
 | 
|---|
| 33 |  ;;1^" . S SPNMENU(SPNMENU)=X,SPNMENU=SPNMENU+1"
 | 
|---|
| 34 |  ;;1^" . Q"
 | 
|---|
| 35 |  ;;1^$S(SPNRTNXT="":" Q",1:" G MENU^"_SPNRTNXT)
 | 
|---|
| 36 |  ;;'SPNRTNNO^"OTHER ; *** Set up other (optional) EN1^DIP variables"
 | 
|---|
| 37 |  ;;'SPNRTNNO^" S DISUPNO="_'SPNNODAT
 | 
|---|
| 38 |  ;;'SPNRTNNO^" Q"
 | 
|---|
| 39 |  ;;'SPNRTNNO^"MACRO ; *** Check/update macro checksums"
 | 
|---|
| 40 |  ;;'SPNRTNNO^" S SPNMRTN=""MENU^"_SPNRTN_""",SPNDIC="_SPNFILE
 | 
|---|
| 41 |  ;;'SPNRTNNO^" D MACCHK^SPNAHOC5"
 | 
|---|
| 42 |  ;;'SPNRTNNO^" Q"
 | 
|---|
| 43 |  ;;1^"TEXT ;;*** Sort Yes/No ^ Menu Text ^ ~Field # ^ DIR(0)"
 | 
|---|