source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSXAB.m@ 811

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1GMTSXAB ; SLC/KER - List Parameters/Build List ; 01/06/2003
2 ;;2.7;Health Summary;**47,49,58,66**;Oct 20, 1995
3 Q
4 ;
5 ; External References
6 ;
7 ; None
8 ;
9 ; This routine expects:
10 ;
11 ; GMTSCPL Compile Method 1 = Append 0 = Overwrite
12 ; GMTSPRE Precedence i.e., USR;SYS;NAT
13 ; ^TMP($J,"GMTSTYP", List Input Array
14 ; ROOT( List Output Array
15 ;
16BUILD ; Build list of User/System Parameters and National Types
17 N GMTSC,GMTSOK,GMTSI,GMTSID,GMTSE,GMTSEI,GMTSV,GMTSVI,GMTSVN,GMTSAT,GMTSOVR
18 S GMTSOVR=$S(+($G(GMTSCPL))'>0:1,1:0),GMTSOK=0
19 S GMTSC=+($O(@ROOT@(" "),-1))
20 F GMTSEI=1:1 Q:$P($G(GMTSPRE),";",GMTSEI)="" S GMTSE=$P($G(GMTSPRE),";",GMTSEI) D
21 . Q:'$L(GMTSE) I GMTSE="NAT" D NAT Q
22 . Q:+GMTSOK>0 S GMTSID="" D ADH,ENT
23 Q
24NAT ; Add National Health Summary Types to the List
25 Q:+($G(GMTSCPL))>1 N GMTSC,GMTSI,GMTSID,GMTSVI,GMTSVN,GMTSV
26 S GMTSI=0,GMTSID=""
27 S GMTSC=+($O(@ROOT@(" "),-1))
28 F S GMTSID=$O(^TMP($J,"GMTSTYP","NAT","B",GMTSID)) Q:GMTSID="" D
29 . S GMTSI=0 F S GMTSI=$O(^TMP($J,"GMTSTYP","NAT","B",GMTSID,GMTSI)) Q:+GMTSI=0 D
30 . . S GMTSV=$$VAL($G(^TMP($J,"GMTSTYP","NAT",GMTSI)))
31 . . Q:'$L(GMTSV) Q:+GMTSV=0 Q:'$L($$TRIM^GMTSXA($P(GMTSV,"^",2)," "))
32 . . Q:$D(@ROOT@("B",GMTSV))
33 . . S GMTSC=GMTSC+1
34 . . S @ROOT@(GMTSC)=GMTSV,@ROOT@("B",GMTSV,GMTSC)=""
35 . . S @ROOT@("C",GMTSC)="NAT"
36 K ^TMP($J,"GMTSTYP","NAT")
37 Q
38ADH ; Add Adhoc Health Summary Types to the List
39 N GMTSC S GMTSC=+($O(@ROOT@(" "),-1)) F GMTSAT="ADH","RAD" S GMTSI=0 D
40 . F S GMTSI=$O(^TMP($J,"GMTSTYP",GMTSE,GMTSAT,GMTSI)) Q:+GMTSI=0 D
41 . . S GMTSV=$$VAL($G(^TMP($J,"GMTSTYP",GMTSE,GMTSAT,GMTSI))) Q:'$L(GMTSV)
42 . . Q:+GMTSV=0 Q:'$L($$TRIM^GMTSXA($P(GMTSV,"^",2)," "))
43 . . Q:$D(@ROOT@("B",GMTSV)) S GMTSC=GMTSC+1,@ROOT@(GMTSC)=GMTSV,@ROOT@("B",GMTSV,GMTSC)="",@ROOT@("C",GMTSC)=$G(GMTSE)
44 Q
45ENT ; Add Entity Parameters (System/User) to the List
46 N GMTSC S GMTSC=+($O(@ROOT@(" "),-1)) F S GMTSID=$O(^TMP($J,"GMTSTYP",GMTSE,"B",GMTSID)) Q:GMTSID="" D
47 . Q:'$L(GMTSID) S GMTSI=0 F S GMTSI=$O(^TMP($J,"GMTSTYP",GMTSE,"B",GMTSID,GMTSI)) Q:+GMTSI=0 D
48 . . S GMTSV=$$VAL($G(^TMP($J,"GMTSTYP",GMTSE,GMTSI))) Q:'$L(GMTSV) Q:+GMTSV=0
49 . . Q:'$L($$TRIM^GMTSXA($P(GMTSV,"^",2)," ")) K:$D(@ROOT@("B",GMTSV)) ^TMP($J,"GMTSTYP",GMTSE,GMTSI)
50 S GMTSI=0 F S GMTSI=$O(^TMP($J,"GMTSTYP",GMTSE,GMTSI)) Q:+GMTSI=0 D
51 . S GMTSV=$$VAL($G(^TMP($J,"GMTSTYP",GMTSE,GMTSI))) Q:'$L(GMTSV)
52 . Q:+GMTSV=0 Q:'$L($$TRIM^GMTSXA($P(GMTSV,"^",2)," "))
53 . Q:$D(@ROOT@("B",GMTSV))
54 . S GMTSC=GMTSC+1,@ROOT@(GMTSC)=GMTSV,@ROOT@("B",GMTSV,GMTSC)="",@ROOT@("C",GMTSC)=$G(GMTSE)
55 . S:+($G(GMTSOVR))>0 GMTSOK=1
56 S:+($G(GMTSOVR))>0&($D(@ROOT@("B"))) GMTSOK=1
57 K ^TMP($J,"GMTSTYP",GMTSE)
58 Q
59VAL(GMTSV) ; Value
60 S GMTSV=$G(GMTSV) N GMTST,GMTSI,GMTSVA,GMTSN,GMTSAD,GMTSNM S GMTSI=+GMTSV Q:+GMTSI=0 GMTSV
61 S GMTST=$G(^GMT(142,+GMTSI,"T")),GMTSNM=$P($G(^GMT(142,+GMTSI,0)),"^",1)
62 S GMTSVA=+($G(^GMT(142,+GMTSI,"VA"))) I +GMTSVA>0,$L(GMTSNM) S GMTSV=+GMTSI_"^"_GMTSNM Q GMTSV
63 S GMTSN=$P(GMTSV,"^",2) S:$L(GMTST) GMTSN=GMTST
64 S GMTSV=+GMTSI_"^"_GMTSN,GMTSAD=$P($G(^GMT(142,+GMTSI,0)),"^",1)
65 S:GMTSAD="GMTS HS ADHOC OPTION" GMTSV=+GMTSI_"^"_GMTSAD
66 Q GMTSV
67UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Note: See TracBrowser for help on using the repository browser.