- GMTSXAB ; SLC/KER - List Parameters/Build List ; 01/06/2003
- ;;2.7;Health Summary;**47,49,58,66**;Oct 20, 1995
- 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_"^"_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")
- GMTSXAB ; SLC/KER - List Parameters/Build List ; 01/06/2003
- +1 ;;2.7;Health Summary;**47,49,58,66**;Oct 20, 1995
- +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_"^"_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")
