source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSXAC.m@ 1073

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1GMTSXAC ; SLC/KER - List Parameters/Compile Method ; 02/27/2002
2 ;;2.7;Health Summary;**47,49**;Oct 20, 1995
3 Q
4 ;
5 ; External References
6 ;
7 ; None
8 ;
9 ; This routine expects:
10 ;
11 ; GMTSUSR Pointer to User
12 ;
13EN ; Main Entry
14 N GMTSG D CPL,SH Q
15EN1 ; Display Compile Method - Single ? Help
16 N GMTSG S GMTSG=1 D CPLH Q
17EN2 ; Display Compile Method - Double ?? Help
18 N GMTSG S GMTSG=1 D CPL Q
19EN3 ; Display Preferred Compile Method
20 N GMTSG D CPL Q
21 ;
22CPL ; Compile Method
23 N GMTSPRE,GMTSCPL,GMTSCPA,GMTSCPI,GMTSM,GMTSALW,GMTSU,GMTSO D EN^GMTSXAW
24 S (GMTSO,GMTSU)=+($G(GMTSUSR)) S:+GMTSU=0 GMTSU=+($G(DUZ)) N GMTSUSR S GMTSUSR=GMTSU
25 S GMTSPRE=$$PRE^GMTSXAL(+($G(GMTSUSR))),GMTSM=$L(GMTSPRE,";") Q:'$L(GMTSPRE)
26 S GMTSCPL=$$CPL^GMTSXAL(+($G(GMTSUSR)))
27 S:(+($G(GMTSO))=.5)&('$L(GMTSCPL)) GMTSCPL=1
28 I +($G(GMTSG))'>0 D:+GMTSCPL>0 CPLA D:+GMTSCPL'>0 CPLO D BL
29 I +($G(GMTSG))>0 D CPLH,BL,CPLA,BL,TL(" OR ---"),BL,CPLO
30 Q
31CPLH ; Compile Help - Header
32 D TL(" Health Summary Types may be added to CPRS reports tab by either appending")
33 D TL(" them to the list or by overwriting existing Health Summaries on the list.") Q
34CPLA ; Compile = Append
35 N GMTSI,GMTSC,GMTSH,GMTSN,GMTSE,GMTSA,GMTST,GMTSP,GMTSL,GMTSM
36 S GMTSP=$G(GMTSPRE) Q:$L(GMTSP,";")'>1 S (GMTSC,GMTSL)=0,GMTSM="A"
37 S:+($G(GMTSO))=.5 GMTSP=$$DEF^GMTSXAW
38 F GMTSI=1:1 S GMTST=$P($G(GMTSP),";",GMTSI) Q:'$L(GMTST) D
39 . S:$P($G(GMTSP),";",(GMTSI+1))="" GMTSL=1
40 . I GMTST="NAT" S GMTSC=GMTSC+1,GMTSN="National",GMTSA=GMTST D:GMTSC=1&(+($G(GMTSG))'>0) CPLT D CPLP Q
41 . S GMTSE=+($O(GMTSALW("B",GMTST,0))) Q:+GMTSE=0 S GMTSE=$G(GMTSALW(+GMTSE))
42 . S GMTSA=$P(GMTSE,"^",1) Q:'$L(GMTSA) S GMTSN=$P(GMTSE,"^",4) Q:'$L(GMTSN) S GMTSC=GMTSC+1 D:GMTSC=1&(+($G(GMTSG))'>0) CPLT D CPLP
43 Q
44CPLO ; Compile = Overwrite
45 N GMTSI,GMTSC,GMTSH,GMTSN,GMTSE,GMTSA,GMTST,GMTSP,GMTSL,GMTSM,GMTSNAT S GMTSP=$G(GMTSPRE) Q:$L(GMTSP,";")'>1 S (GMTSNAT,GMTSL,GMTSC)=0,GMTSM="O"
46 S:+($G(GMTSO))=.5 GMTSP=$$DEF^GMTSXAW
47 F GMTSI=$L(GMTSP,";"):-1 S GMTST=$P($G(GMTSP),";",GMTSI) Q:'$L(GMTST) Q:GMTSI=0 D
48 . S:$P($G(GMTSP),";",(GMTSI-1))="" GMTSL=1 S:GMTSI-1=0 GMTSL=1 I GMTST="NAT" S GMTSNAT=1 Q
49 . S GMTSE=+($O(GMTSALW("B",GMTST,0))) Q:+GMTSE=0 S GMTSE=$G(GMTSALW(+GMTSE))
50 . S GMTSA=$P(GMTSE,"^",1) Q:'$L(GMTSA) S GMTSN=$P(GMTSE,"^",4) Q:'$L(GMTSN)
51 . S GMTSC=GMTSC+1 D:GMTSC=1&(+($G(GMTSG))'>0) CPLT D CPLP
52 I +GMTSNAT>0 S GMTSC=+($G(GMTSC))+1,GMTSN="National",(GMTSA,GMTST)="NAT" D:GMTSC=1&(+($G(GMTSG))'>0) CPLT D CPLP
53 D:$G(GMTSP)["NAT" INDP
54 Q
55CPLP ; Compile Parameter
56 Q:'$L($G(GMTST)) Q:'$L($G(GMTSN)) Q:'$L($G(GMTSA)) Q:'$L(GMTSM)
57 N GMTSP S:GMTSM="A" GMTSH=$S(+($G(GMTSC))=1:"Add",1:"Append with") S:GMTSM="O" GMTSH=$S(+($G(GMTSC))=1:"Add",1:"Overwrite with")
58 S GMTSL=+($G(GMTSL)) S:GMTST="NAT"&(GMTSC>1) GMTSH="Add" S:GMTST'="NAT" GMTSP=" "_GMTSH_" "_GMTSN_" Defined Summary Types" S:GMTST="NAT" GMTSP=" "_GMTSH_" National Defined Summary Types"
59 S:+($G(GMTSC))>1 GMTSP=GMTSP_" (if found)" S:+($G(GMTSC))=1 GMTSP=GMTSP_" to the list" S:+GMTSL'>0 GMTSP=GMTSP_", then" D TL(GMTSP)
60 Q
61CPLT ; Compile Title
62 D BL,TL(" Method for building the List: "),AL(($S(+($G(GMTSCPL))'>0:"Overwrite",1:"Append"))),BL Q
63INDP ; Independent Types
64 N GMTSI,GMTSPA,GMTSPT,GMTSPI,GMTSPE,GMTSMSG,GMTSX,GMTST,GMTSL,GMTSR,GMTSS,GMTSN
65 S GMTSN=" ",GMTSPT=$$DEF^GMTSXAW
66 F GMTSI=1:1 S GMTSPA=$P(GMTSPT,";",GMTSI) Q:'$L(GMTSPA) D
67 . S GMTSPI=$$ETI^GMTSXAW3(GMTSPA),GMTSPE=$$EMC^GMTSXAW3(+($G(GMTSPI))),GMTSX=$G(GMTSX)_", "_GMTSPE
68 S:$E(GMTSX,1,2)=", " GMTSX=$E(GMTSX,3,$L(GMTSX)) S:$L(GMTSX,", ")>1 GMTSX=$P(GMTSX,", ",1,($L(GMTSX,", ")-1))_" and "_$P(GMTSX,", ",$L(GMTSX,", "))
69 S GMTST="National Health Summary Types are added to the list",GMTSL=$L(GMTST),GMTST="Note: "_GMTST,GMTST=GMTSN_GMTST D BL,TL(GMTST)
70 S GMTSN=GMTSN_" ",GMTST="independently of "_$S($L(GMTSX):GMTSX,1:"other")_" defined types, and placed on the list in the order specified by the precedence."
71 D INDPT
72 Q
73INDPT ; Independent Types (text)
74 I $L(GMTST)'>GMTSL S GMTST=GMTSN_GMTST D TL(GMTST) Q
75 F Q:'$L(GMTST) D INDPL
76 Q
77INDPL ; Independent Types (long text)
78 I $L(GMTST)'>GMTSL D TL((GMTSN_GMTST)) S GMTST="" Q
79 N GMTSREM,GMTSSTO,GMTSI F GMTSI=1:1 Q:$L($P(GMTST," ",1,GMTSI))>GMTSL Q:'$L($P(GMTST," ",GMTSI))
80 S GMTSSTO=$$TRIM^GMTSXA($P(GMTST," ",1,(GMTSI-1))," "),GMTSREM=$$TRIM^GMTSXA($P(GMTST," ",GMTSI,299)," ")
81 D:$L(GMTSSTO) TL((GMTSN_GMTSSTO)) S GMTST=GMTSREM
82 Q
83 ;
84 ; Miscellaneous
85SH ; Show ^TMP Global
86 N GMTSN,GMTSC,GMTSW S GMTSN="^TMP(""GMTSXAD"","_$J_",0)",GMTSC="^TMP(""GMTSXAD"","_$J_",",GMTSW="^TMP(""GMTSXAD"","_$J_",0)"
87 F S GMTSN=$Q(@GMTSN) Q:GMTSN=""!(GMTSN'[GMTSC) W:GMTSN'[GMTSW !,@GMTSN
88 K ^TMP("GMTSXAD",$J)
89 Q
90BL ; Blank Line
91 D TL("") Q
92TL(X) ; Text Line
93 I +($G(GMTSG))>0 W !,$G(X) Q
94 N GMTSC S X=$G(X),GMTSC=+($G(^TMP("GMTSXAD",$J,0))),GMTSC=GMTSC+1,^TMP("GMTSXAD",$J,GMTSC,0)=X,^TMP("GMTSXAD",$J,0)=GMTSC Q
95AL(X) ; Append Line
96 I +($G(GMTSG))>0 W $G(X) Q
97 N GMTSC S X=$G(X),GMTSC=+($G(^TMP("GMTSXAD",$J,0))),^TMP("GMTSXAD",$J,GMTSC,0)=$G(^TMP("GMTSXAD",$J,GMTSC,0))_X,^TMP("GMTSXAD",$J,0)=GMTSC Q
Note: See TracBrowser for help on using the repository browser.