source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNAHOCX.m@ 1801

Last change on this file since 1801 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1SPNAHOCX ;HISC/DAD-AD HOC REPORTS: INTERFACE COMPILER ; [ 02/23/95 5:49 PM ]
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;
4BUILD ; *** 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
21PROG ;;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)"
Note: See TracBrowser for help on using the repository browser.