GMTSXAB ; SLC/KER - List Parameters/Build List ; 01/06/2003
;;2.7;Health Summary;**47,49,58,66,105**;Oct 20, 1995;Build 5
Q
;
; External References
;
; None
;
; This routine expects:
;
; GMTSCPL Compile Method 1 = Append 0 = Overwrite
; GMTSPRE Precedence i.e., USR;SYS;NAT
; ^TMP($J,"GMTSTYP", List Input Array
; ROOT( List Output Array
;
BUILD ; Build list of User/System Parameters and National Types
N GMTSC,GMTSOK,GMTSI,GMTSID,GMTSE,GMTSEI,GMTSV,GMTSVI,GMTSVN,GMTSAT,GMTSOVR
S GMTSOVR=$S(+($G(GMTSCPL))'>0:1,1:0),GMTSOK=0
S GMTSC=+($O(@ROOT@(" "),-1))
F GMTSEI=1:1 Q:$P($G(GMTSPRE),";",GMTSEI)="" S GMTSE=$P($G(GMTSPRE),";",GMTSEI) D
. Q:'$L(GMTSE) I GMTSE="NAT" D NAT Q
. Q:+GMTSOK>0 S GMTSID="" D ADH,ENT
Q
NAT ; Add National Health Summary Types to the List
Q:+($G(GMTSCPL))>1 N GMTSC,GMTSI,GMTSID,GMTSVI,GMTSVN,GMTSV
S GMTSI=0,GMTSID=""
S GMTSC=+($O(@ROOT@(" "),-1))
F S GMTSID=$O(^TMP($J,"GMTSTYP","NAT","B",GMTSID)) Q:GMTSID="" D
. S GMTSI=0 F S GMTSI=$O(^TMP($J,"GMTSTYP","NAT","B",GMTSID,GMTSI)) Q:+GMTSI=0 D
. . S GMTSV=$$VAL($G(^TMP($J,"GMTSTYP","NAT",GMTSI)))
. . Q:'$L(GMTSV) Q:+GMTSV=0 Q:'$L($$TRIM^GMTSXA($P(GMTSV,"^",2)," "))
. . Q:$D(@ROOT@("B",GMTSV))
. . S GMTSC=GMTSC+1
. . S @ROOT@(GMTSC)=GMTSV,@ROOT@("B",GMTSV,GMTSC)=""
. . S @ROOT@("C",GMTSC)="NAT"
K ^TMP($J,"GMTSTYP","NAT")
Q
ADH ; Add Adhoc Health Summary Types to the List
N GMTSC S GMTSC=+($O(@ROOT@(" "),-1)) F GMTSAT="ADH","RAD" S GMTSI=0 D
. F S GMTSI=$O(^TMP($J,"GMTSTYP",GMTSE,GMTSAT,GMTSI)) Q:+GMTSI=0 D
. . S GMTSV=$$VAL($G(^TMP($J,"GMTSTYP",GMTSE,GMTSAT,GMTSI))) Q:'$L(GMTSV)
. . Q:+GMTSV=0 Q:'$L($$TRIM^GMTSXA($P(GMTSV,"^",2)," "))
. . Q:$D(@ROOT@("B",GMTSV)) S GMTSC=GMTSC+1,@ROOT@(GMTSC)=GMTSV,@ROOT@("B",GMTSV,GMTSC)="",@ROOT@("C",GMTSC)=$G(GMTSE)
Q
ENT ; Add Entity Parameters (System/User) to the List
N GMTSC S GMTSC=+($O(@ROOT@(" "),-1)) F S GMTSID=$O(^TMP($J,"GMTSTYP",GMTSE,"B",GMTSID)) Q:GMTSID="" D
. Q:'$L(GMTSID) S GMTSI=0 F S GMTSI=$O(^TMP($J,"GMTSTYP",GMTSE,"B",GMTSID,GMTSI)) Q:+GMTSI=0 D
. . S GMTSV=$$VAL($G(^TMP($J,"GMTSTYP",GMTSE,GMTSI))) Q:'$L(GMTSV) Q:+GMTSV=0
. . Q:'$L($$TRIM^GMTSXA($P(GMTSV,"^",2)," ")) K:$D(@ROOT@("B",GMTSV)) ^TMP($J,"GMTSTYP",GMTSE,GMTSI)
S GMTSI=0 F S GMTSI=$O(^TMP($J,"GMTSTYP",GMTSE,GMTSI)) Q:+GMTSI=0 D
. S GMTSV=$$VAL($G(^TMP($J,"GMTSTYP",GMTSE,GMTSI))) Q:'$L(GMTSV)
. Q:+GMTSV=0 Q:'$L($$TRIM^GMTSXA($P(GMTSV,"^",2)," "))
. Q:$D(@ROOT@("B",GMTSV))
. S GMTSC=GMTSC+1,@ROOT@(GMTSC)=GMTSV,@ROOT@("B",GMTSV,GMTSC)="",@ROOT@("C",GMTSC)=$G(GMTSE)
. S:+($G(GMTSOVR))>0 GMTSOK=1
S:+($G(GMTSOVR))>0&($D(@ROOT@("B"))) GMTSOK=1
K ^TMP($J,"GMTSTYP",GMTSE)
Q
VAL(GMTSV) ; Value
S GMTSV=$G(GMTSV) N GMTST,GMTSI,GMTSVA,GMTSN,GMTSAD,GMTSNM S GMTSI=+GMTSV Q:+GMTSI=0 GMTSV
S GMTST=$G(^GMT(142,+GMTSI,"T")),GMTSNM=$P($G(^GMT(142,+GMTSI,0)),"^",1)
S GMTSVA=+($G(^GMT(142,+GMTSI,"VA"))) I +GMTSVA>0,$L(GMTSNM) S GMTSV=+GMTSI_"^"_$S($L(GMTST):GMTST,1:GMTSNM) Q GMTSV
S GMTSN=$P(GMTSV,"^",2) S:$L(GMTST) GMTSN=GMTST
S GMTSV=+GMTSI_"^"_GMTSN,GMTSAD=$P($G(^GMT(142,+GMTSI,0)),"^",1)
S:GMTSAD="GMTS HS ADHOC OPTION" GMTSV=+GMTSI_"^"_GMTSAD
Q GMTSV
UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXAB 3524 printed Oct 16, 2024@18:01:31 Page 2
GMTSXAB ; SLC/KER - List Parameters/Build List ; 01/06/2003
+1 ;;2.7;Health Summary;**47,49,58,66,105**;Oct 20, 1995;Build 5
+2 QUIT
+3 ;
+4 ; External References
+5 ;
+6 ; None
+7 ;
+8 ; This routine expects:
+9 ;
+10 ; GMTSCPL Compile Method 1 = Append 0 = Overwrite
+11 ; GMTSPRE Precedence i.e., USR;SYS;NAT
+12 ; ^TMP($J,"GMTSTYP", List Input Array
+13 ; ROOT( List Output Array
+14 ;
BUILD ; Build list of User/System Parameters and National Types
+1 NEW GMTSC,GMTSOK,GMTSI,GMTSID,GMTSE,GMTSEI,GMTSV,GMTSVI,GMTSVN,GMTSAT,GMTSOVR
+2 SET GMTSOVR=$SELECT(+($GET(GMTSCPL))'>0:1,1:0)
SET GMTSOK=0
+3 SET GMTSC=+($ORDER(@ROOT@(" "),-1))
+4 FOR GMTSEI=1:1
if $PIECE($GET(GMTSPRE),";",GMTSEI)=""
QUIT
SET GMTSE=$PIECE($GET(GMTSPRE),";",GMTSEI)
Begin DoDot:1
+5 if '$LENGTH(GMTSE)
QUIT
IF GMTSE="NAT"
DO NAT
QUIT
+6 if +GMTSOK>0
QUIT
SET GMTSID=""
DO ADH
DO ENT
End DoDot:1
+7 QUIT
NAT ; Add National Health Summary Types to the List
+1 if +($GET(GMTSCPL))>1
QUIT
NEW GMTSC,GMTSI,GMTSID,GMTSVI,GMTSVN,GMTSV
+2 SET GMTSI=0
SET GMTSID=""
+3 SET GMTSC=+($ORDER(@ROOT@(" "),-1))
+4 FOR
SET GMTSID=$ORDER(^TMP($JOB,"GMTSTYP","NAT","B",GMTSID))
if GMTSID=""
QUIT
Begin DoDot:1
+5 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^TMP($JOB,"GMTSTYP","NAT","B",GMTSID,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:2
+6 SET GMTSV=$$VAL($GET(^TMP($JOB,"GMTSTYP","NAT",GMTSI)))
+7 if '$LENGTH(GMTSV)
QUIT
if +GMTSV=0
QUIT
if '$LENGTH($$TRIM^GMTSXA($PIECE(GMTSV,"^",2)," "))
QUIT
+8 if $DATA(@ROOT@("B",GMTSV))
QUIT
+9 SET GMTSC=GMTSC+1
+10 SET @ROOT@(GMTSC)=GMTSV
SET @ROOT@("B",GMTSV,GMTSC)=""
+11 SET @ROOT@("C",GMTSC)="NAT"
End DoDot:2
End DoDot:1
+12 KILL ^TMP($JOB,"GMTSTYP","NAT")
+13 QUIT
ADH ; Add Adhoc Health Summary Types to the List
+1 NEW GMTSC
SET GMTSC=+($ORDER(@ROOT@(" "),-1))
FOR GMTSAT="ADH","RAD"
SET GMTSI=0
Begin DoDot:1
+2 FOR
SET GMTSI=$ORDER(^TMP($JOB,"GMTSTYP",GMTSE,GMTSAT,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:2
+3 SET GMTSV=$$VAL($GET(^TMP($JOB,"GMTSTYP",GMTSE,GMTSAT,GMTSI)))
if '$LENGTH(GMTSV)
QUIT
+4 if +GMTSV=0
QUIT
if '$LENGTH($$TRIM^GMTSXA($PIECE(GMTSV,"^",2)," "))
QUIT
+5 if $DATA(@ROOT@("B",GMTSV))
QUIT
SET GMTSC=GMTSC+1
SET @ROOT@(GMTSC)=GMTSV
SET @ROOT@("B",GMTSV,GMTSC)=""
SET @ROOT@("C",GMTSC)=$GET(GMTSE)
End DoDot:2
End DoDot:1
+6 QUIT
ENT ; Add Entity Parameters (System/User) to the List
+1 NEW GMTSC
SET GMTSC=+($ORDER(@ROOT@(" "),-1))
FOR
SET GMTSID=$ORDER(^TMP($JOB,"GMTSTYP",GMTSE,"B",GMTSID))
if GMTSID=""
QUIT
Begin DoDot:1
+2 if '$LENGTH(GMTSID)
QUIT
SET GMTSI=0
FOR
SET GMTSI=$ORDER(^TMP($JOB,"GMTSTYP",GMTSE,"B",GMTSID,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:2
+3 SET GMTSV=$$VAL($GET(^TMP($JOB,"GMTSTYP",GMTSE,GMTSI)))
if '$LENGTH(GMTSV)
QUIT
if +GMTSV=0
QUIT
+4 if '$LENGTH($$TRIM^GMTSXA($PIECE(GMTSV,"^",2)," "))
QUIT
if $DATA(@ROOT@("B",GMTSV))
KILL ^TMP($JOB,"GMTSTYP",GMTSE,GMTSI)
End DoDot:2
End DoDot:1
+5 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^TMP($JOB,"GMTSTYP",GMTSE,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+6 SET GMTSV=$$VAL($GET(^TMP($JOB,"GMTSTYP",GMTSE,GMTSI)))
if '$LENGTH(GMTSV)
QUIT
+7 if +GMTSV=0
QUIT
if '$LENGTH($$TRIM^GMTSXA($PIECE(GMTSV,"^",2)," "))
QUIT
+8 if $DATA(@ROOT@("B",GMTSV))
QUIT
+9 SET GMTSC=GMTSC+1
SET @ROOT@(GMTSC)=GMTSV
SET @ROOT@("B",GMTSV,GMTSC)=""
SET @ROOT@("C",GMTSC)=$GET(GMTSE)
+10 if +($GET(GMTSOVR))>0
SET GMTSOK=1
End DoDot:1
+11 if +($GET(GMTSOVR))>0&($DATA(@ROOT@("B")))
SET GMTSOK=1
+12 KILL ^TMP($JOB,"GMTSTYP",GMTSE)
+13 QUIT
VAL(GMTSV) ; Value
+1 SET GMTSV=$GET(GMTSV)
NEW GMTST,GMTSI,GMTSVA,GMTSN,GMTSAD,GMTSNM
SET GMTSI=+GMTSV
if +GMTSI=0
QUIT GMTSV
+2 SET GMTST=$GET(^GMT(142,+GMTSI,"T"))
SET GMTSNM=$PIECE($GET(^GMT(142,+GMTSI,0)),"^",1)
+3 SET GMTSVA=+($GET(^GMT(142,+GMTSI,"VA")))
IF +GMTSVA>0
IF $LENGTH(GMTSNM)
SET GMTSV=+GMTSI_"^"_$SELECT($LENGTH(GMTST):GMTST,1:GMTSNM)
QUIT GMTSV
+4 SET GMTSN=$PIECE(GMTSV,"^",2)
if $LENGTH(GMTST)
SET GMTSN=GMTST
+5 SET GMTSV=+GMTSI_"^"_GMTSN
SET GMTSAD=$PIECE($GET(^GMT(142,+GMTSI,0)),"^",1)
+6 if GMTSAD="GMTS HS ADHOC OPTION"
SET GMTSV=+GMTSI_"^"_GMTSAD
+7 QUIT GMTSV
UP(X) QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
