[613] | 1 | GMTSXAB ; 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 | ;
|
---|
| 16 | BUILD ; 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
|
---|
| 24 | NAT ; 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
|
---|
| 38 | ADH ; 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
|
---|
| 45 | ENT ; 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
|
---|
| 59 | VAL(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
|
---|
| 67 | UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
---|