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)"
|
---|