GMTSXAW2 ; SLC/KER - List Parameters/Entities ; 02/27/2002
;;2.7;Health Summary;**47,49**;Oct 20, 1995
Q
;
; External References
; DBIA 10112 $$SITE^VASITE
;
DEV ; Device
K GMTSPV N GMTSE,GMTSA,GMTSEN,GMTSIE,GMTSVP,GMTSNM
S GMTSE=+($$ETI^GMTSXAW3("DEV")) Q:+GMTSE=0
S GMTSA=$$EAB^GMTSXAW3(GMTSE)
S GMTSEN=$$EMC^GMTSXAW3(GMTSE) Q:$L(GMTSA)'=3 Q:'$L(GMTSEN)
S GMTSIE=+($G(IO("HOME"))) Q:+GMTSIE'>0 S GMTSVP=+GMTSIE_";%ZIS(1,"
S GMTSNM=$$DEV^GMTSXAW3(+($G(GMTSIE)))
S GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN D OTH Q
Q
DIV ; Division Needs GMTSUSR
K GMTSPV N GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
S GMTSE=+($$ETI^GMTSXAW3("DIV")) Q:+GMTSE=0 S GMTSA=$$EAB^GMTSXAW3(GMTSE)
S GMTSEN=$$EMC^GMTSXAW3(GMTSE) Q:$L(GMTSA)'=3 Q:'$L(GMTSEN)
S GMTSVP=$$UD^GMTSXAW3(+($G(GMTSUSR))),GMTSNM=$$DIV^GMTSXAW3(+($G(GMTSVP)))
S GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN D OTH Q
SYS ; System
K GMTSPV N GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
; Entity Lookup
S GMTSE=+($$ETI^GMTSXAW3("SYS")) Q:+GMTSE=0
; Entity Abbrv
S GMTSA=$$EAB^GMTSXAW3(GMTSE)
; Entity Mixed Case
S GMTSEN=$$EMC^GMTSXAW3(GMTSE) Q:$L(GMTSA)'=3 Q:'$L(GMTSEN)
; System IEN
S GMTSIE=$$SI^GMTSXAW3 Q:+GMTSIE'>0
; System Variable Pointer/Domain Name
S GMTSVP=+GMTSIE_";DIC(4.2,",GMTSNM=$$SYS^GMTSXAW3(+($G(GMTSIE)))
S GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN D OTH Q
PKG ; Package Needs GMTSPKG
K GMTSPV Q:'$L($G(GMTSPKG))
N GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
S GMTSE=+($$ETI^GMTSXAW3("PKG")) Q:+GMTSE=0
S GMTSA=$$EAB^GMTSXAW3(GMTSE),GMTSEN=$$EMC^GMTSXAW3(GMTSE) Q:$L(GMTSA)'=3 Q:'$L(GMTSEN)
S GMTSIE=$$PK^GMTSXAW3(GMTSPKG) Q:+GMTSIE'>0 S GMTSVP=+GMTSIE_";DIC(9.4,"
S GMTSNM=$$PKG^GMTSXAW3(+($G(GMTSIE)))
S GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN D OTH Q
LOC ; Hospital Location <none>
K GMTSPV Q
SRV ; Service Needs GMTSUSR
K GMTSPV N GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
S GMTSE=+($$ETI^GMTSXAW3("SRV")) Q:+GMTSE=0 S GMTSA=$$EAB^GMTSXAW3(GMTSE)
S GMTSEN=$$EMC^GMTSXAW3(GMTSE) Q:$L(GMTSA)'=3 Q:'$L(GMTSEN)
S GMTSIE=$$SRI^GMTSXAW3(+($G(GMTSUSR))) Q:+GMTSIE'>0
S GMTSVP=+GMTSIE_";DIC(49,",GMTSNM=$$SRV^GMTSXAW3(+GMTSIE)
S GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN D OTH Q
OTL ; OERR Team List Needs GMTSUSR
K GMTSPV N GMTSE,GMTSA,GMTSEN,GMTSNM,GMTSPVC,GMTSI,GMTSIE,GMTSVP,GMTSOTL
S GMTSE=+($$ETI^GMTSXAW3("OTL")) Q:+GMTSE=0 S GMTSA=$$EAB^GMTSXAW3(GMTSE)
S GMTSEN=$$EMC^GMTSXAW3(GMTSE) Q:$L(GMTSA)'=3 Q:'$L(GMTSEN)
S GMTSNM=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(GMTSNM)
D OTL^GMTSXAW3(GMTSNM,.GMTSOTL) S (GMTSPVC,GMTSI)=0
F S GMTSI=$O(GMTSOTL("DILIST",2,GMTSI)) Q:+GMTSI=0 D
. S GMTSIE=$G(GMTSOTL("DILIST",2,GMTSI)) Q:+GMTSIE=0
. S GMTSVP=+GMTSIE_";OR(100.21,",GMTSNM=$G(GMTSOTL("DILIST",1,GMTSI))
. Q:'$L(GMTSNM) S GMTSPVC=+($G(GMTSPVC))+1
. S GMTSPV(GMTSPVC)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN D OTH
Q
USR ; User Needs GMTSUSR
K GMTSPV N GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
S GMTSE=+($$ETI^GMTSXAW3("USR")) Q:+GMTSE=0 S GMTSA=$$EAB^GMTSXAW3(GMTSE)
S GMTSEN=$$EMC^GMTSXAW3(GMTSE) Q:$L(GMTSA)'=3 Q:'$L(GMTSEN)
S GMTSIE=+($G(GMTSUSR)) Q:+GMTSIE'>0 S GMTSVP=$$UVP^GMTSXAW3(+GMTSIE)
S GMTSNM=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(GMTSNM)
S GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN D OTH Q
TEA ; Team <none>
K GMTSPV Q
BED ; Room/Bed <none>
K GMTSPV Q
CLS ; User Class Needs GMTSUSR
K GMTSPV N GMTSIE,GMTSNM,GMTSE,GMTSA,GMTSEN,GMTSPVC,GMTSCD,GMTSED,GMTSCLS,GMTSMEM,GMTSMSG,GMTSI,GMTSU,GMTSIE
S GMTSE=+($$ETI^GMTSXAW3("CLS")) Q:+GMTSE=0 S GMTSA=$$EAB^GMTSXAW3(GMTSE),GMTSEN=$$EMC^GMTSXAW3(GMTSE) Q:$L(GMTSA)'=3 Q:'$L(GMTSEN)
S GMTSNM=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(GMTSNM) S GMTSCD=DT,GMTSU=0 D UCL^GMTSXAW3(GMTSUSR,.GMTSMEM)
F S GMTSU=$O(GMTSMEM("ID",GMTSU)) Q:+GMTSU=0 D
. S GMTSED=+($G(GMTSMEM("ID",GMTSU,.03))),GMTSED=+($P(GMTSED,".",1)) Q:+GMTSED=0 Q:+GMTSED>+GMTSCD
. S GMTSED=+($G(GMTSMEM("ID",GMTSU,.04))) Q:+GMTSED>0&(+GMTSCD>+GMTSED)
. I +($G(GMTSMEM("ID",GMTSU,.02)))>0 D
. . S GMTSIE=+($G(GMTSMEM("ID",GMTSU,.02))),GMTSVP=GMTSIE_";USR(8930,",GMTSNM=$$CLS^GMTSXAW3(+GMTSIE)
. . Q:'$L(GMTSNM) S GMTSPVC=+($G(GMTSPVC))+1,GMTSPV(GMTSPVC)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN D OTH
Q
OTH ; Other Elements
S:$L($G(GMTSVP)) GMTSPV("VP",$G(GMTSVP))=""
S:$L($P($G(GMTSVP),";",2)) GMTSPV("GL",$P($G(GMTSVP),";",2))=""
S:$L($G(GMTSA)) GMTSPV("AB",$G(GMTSA))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXAW2 4651 printed Dec 13, 2024@02:00:53 Page 2
GMTSXAW2 ; SLC/KER - List Parameters/Entities ; 02/27/2002
+1 ;;2.7;Health Summary;**47,49**;Oct 20, 1995
+2 QUIT
+3 ;
+4 ; External References
+5 ; DBIA 10112 $$SITE^VASITE
+6 ;
DEV ; Device
+1 KILL GMTSPV
NEW GMTSE,GMTSA,GMTSEN,GMTSIE,GMTSVP,GMTSNM
+2 SET GMTSE=+($$ETI^GMTSXAW3("DEV"))
if +GMTSE=0
QUIT
+3 SET GMTSA=$$EAB^GMTSXAW3(GMTSE)
+4 SET GMTSEN=$$EMC^GMTSXAW3(GMTSE)
if $LENGTH(GMTSA)'=3
QUIT
if '$LENGTH(GMTSEN)
QUIT
+5 SET GMTSIE=+($GET(IO("HOME")))
if +GMTSIE'>0
QUIT
SET GMTSVP=+GMTSIE_";%ZIS(1,"
+6 SET GMTSNM=$$DEV^GMTSXAW3(+($GET(GMTSIE)))
+7 SET GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN
DO OTH
QUIT
+8 QUIT
DIV ; Division Needs GMTSUSR
+1 KILL GMTSPV
NEW GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
+2 SET GMTSE=+($$ETI^GMTSXAW3("DIV"))
if +GMTSE=0
QUIT
SET GMTSA=$$EAB^GMTSXAW3(GMTSE)
+3 SET GMTSEN=$$EMC^GMTSXAW3(GMTSE)
if $LENGTH(GMTSA)'=3
QUIT
if '$LENGTH(GMTSEN)
QUIT
+4 SET GMTSVP=$$UD^GMTSXAW3(+($GET(GMTSUSR)))
SET GMTSNM=$$DIV^GMTSXAW3(+($GET(GMTSVP)))
+5 SET GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN
DO OTH
QUIT
SYS ; System
+1 KILL GMTSPV
NEW GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
+2 ; Entity Lookup
+3 SET GMTSE=+($$ETI^GMTSXAW3("SYS"))
if +GMTSE=0
QUIT
+4 ; Entity Abbrv
+5 SET GMTSA=$$EAB^GMTSXAW3(GMTSE)
+6 ; Entity Mixed Case
+7 SET GMTSEN=$$EMC^GMTSXAW3(GMTSE)
if $LENGTH(GMTSA)'=3
QUIT
if '$LENGTH(GMTSEN)
QUIT
+8 ; System IEN
+9 SET GMTSIE=$$SI^GMTSXAW3
if +GMTSIE'>0
QUIT
+10 ; System Variable Pointer/Domain Name
+11 SET GMTSVP=+GMTSIE_";DIC(4.2,"
SET GMTSNM=$$SYS^GMTSXAW3(+($GET(GMTSIE)))
+12 SET GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN
DO OTH
QUIT
PKG ; Package Needs GMTSPKG
+1 KILL GMTSPV
if '$LENGTH($GET(GMTSPKG))
QUIT
+2 NEW GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
+3 SET GMTSE=+($$ETI^GMTSXAW3("PKG"))
if +GMTSE=0
QUIT
+4 SET GMTSA=$$EAB^GMTSXAW3(GMTSE)
SET GMTSEN=$$EMC^GMTSXAW3(GMTSE)
if $LENGTH(GMTSA)'=3
QUIT
if '$LENGTH(GMTSEN)
QUIT
+5 SET GMTSIE=$$PK^GMTSXAW3(GMTSPKG)
if +GMTSIE'>0
QUIT
SET GMTSVP=+GMTSIE_";DIC(9.4,"
+6 SET GMTSNM=$$PKG^GMTSXAW3(+($GET(GMTSIE)))
+7 SET GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN
DO OTH
QUIT
LOC ; Hospital Location <none>
+1 KILL GMTSPV
QUIT
SRV ; Service Needs GMTSUSR
+1 KILL GMTSPV
NEW GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
+2 SET GMTSE=+($$ETI^GMTSXAW3("SRV"))
if +GMTSE=0
QUIT
SET GMTSA=$$EAB^GMTSXAW3(GMTSE)
+3 SET GMTSEN=$$EMC^GMTSXAW3(GMTSE)
if $LENGTH(GMTSA)'=3
QUIT
if '$LENGTH(GMTSEN)
QUIT
+4 SET GMTSIE=$$SRI^GMTSXAW3(+($GET(GMTSUSR)))
if +GMTSIE'>0
QUIT
+5 SET GMTSVP=+GMTSIE_";DIC(49,"
SET GMTSNM=$$SRV^GMTSXAW3(+GMTSIE)
+6 SET GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN
DO OTH
QUIT
OTL ; OERR Team List Needs GMTSUSR
+1 KILL GMTSPV
NEW GMTSE,GMTSA,GMTSEN,GMTSNM,GMTSPVC,GMTSI,GMTSIE,GMTSVP,GMTSOTL
+2 SET GMTSE=+($$ETI^GMTSXAW3("OTL"))
if +GMTSE=0
QUIT
SET GMTSA=$$EAB^GMTSXAW3(GMTSE)
+3 SET GMTSEN=$$EMC^GMTSXAW3(GMTSE)
if $LENGTH(GMTSA)'=3
QUIT
if '$LENGTH(GMTSEN)
QUIT
+4 SET GMTSNM=$$UNM^GMTSXAW3(+($GET(GMTSUSR)))
if '$LENGTH(GMTSNM)
QUIT
+5 DO OTL^GMTSXAW3(GMTSNM,.GMTSOTL)
SET (GMTSPVC,GMTSI)=0
+6 FOR
SET GMTSI=$ORDER(GMTSOTL("DILIST",2,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+7 SET GMTSIE=$GET(GMTSOTL("DILIST",2,GMTSI))
if +GMTSIE=0
QUIT
+8 SET GMTSVP=+GMTSIE_";OR(100.21,"
SET GMTSNM=$GET(GMTSOTL("DILIST",1,GMTSI))
+9 if '$LENGTH(GMTSNM)
QUIT
SET GMTSPVC=+($GET(GMTSPVC))+1
+10 SET GMTSPV(GMTSPVC)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN
DO OTH
End DoDot:1
+11 QUIT
USR ; User Needs GMTSUSR
+1 KILL GMTSPV
NEW GMTSIE,GMTSVP,GMTSNM,GMTSE,GMTSA,GMTSEN
+2 SET GMTSE=+($$ETI^GMTSXAW3("USR"))
if +GMTSE=0
QUIT
SET GMTSA=$$EAB^GMTSXAW3(GMTSE)
+3 SET GMTSEN=$$EMC^GMTSXAW3(GMTSE)
if $LENGTH(GMTSA)'=3
QUIT
if '$LENGTH(GMTSEN)
QUIT
+4 SET GMTSIE=+($GET(GMTSUSR))
if +GMTSIE'>0
QUIT
SET GMTSVP=$$UVP^GMTSXAW3(+GMTSIE)
+5 SET GMTSNM=$$UNM^GMTSXAW3(+($GET(GMTSUSR)))
if '$LENGTH(GMTSNM)
QUIT
+6 SET GMTSPV(1)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN
DO OTH
QUIT
TEA ; Team <none>
+1 KILL GMTSPV
QUIT
BED ; Room/Bed <none>
+1 KILL GMTSPV
QUIT
CLS ; User Class Needs GMTSUSR
+1 KILL GMTSPV
NEW GMTSIE,GMTSNM,GMTSE,GMTSA,GMTSEN,GMTSPVC,GMTSCD,GMTSED,GMTSCLS,GMTSMEM,GMTSMSG,GMTSI,GMTSU,GMTSIE
+2 SET GMTSE=+($$ETI^GMTSXAW3("CLS"))
if +GMTSE=0
QUIT
SET GMTSA=$$EAB^GMTSXAW3(GMTSE)
SET GMTSEN=$$EMC^GMTSXAW3(GMTSE)
if $LENGTH(GMTSA)'=3
QUIT
if '$LENGTH(GMTSEN)
QUIT
+3 SET GMTSNM=$$UNM^GMTSXAW3(+($GET(GMTSUSR)))
if '$LENGTH(GMTSNM)
QUIT
SET GMTSCD=DT
SET GMTSU=0
DO UCL^GMTSXAW3(GMTSUSR,.GMTSMEM)
+4 FOR
SET GMTSU=$ORDER(GMTSMEM("ID",GMTSU))
if +GMTSU=0
QUIT
Begin DoDot:1
+5 SET GMTSED=+($GET(GMTSMEM("ID",GMTSU,.03)))
SET GMTSED=+($PIECE(GMTSED,".",1))
if +GMTSED=0
QUIT
if +GMTSED>+GMTSCD
QUIT
+6 SET GMTSED=+($GET(GMTSMEM("ID",GMTSU,.04)))
if +GMTSED>0&(+GMTSCD>+GMTSED)
QUIT
+7 IF +($GET(GMTSMEM("ID",GMTSU,.02)))>0
Begin DoDot:2
+8 SET GMTSIE=+($GET(GMTSMEM("ID",GMTSU,.02)))
SET GMTSVP=GMTSIE_";USR(8930,"
SET GMTSNM=$$CLS^GMTSXAW3(+GMTSIE)
+9 if '$LENGTH(GMTSNM)
QUIT
SET GMTSPVC=+($GET(GMTSPVC))+1
SET GMTSPV(GMTSPVC)=GMTSA_"^"_GMTSVP_"^"_GMTSNM_"^"_GMTSEN
DO OTH
End DoDot:2
End DoDot:1
+10 QUIT
OTH ; Other Elements
+1 if $LENGTH($GET(GMTSVP))
SET GMTSPV("VP",$GET(GMTSVP))=""
+2 if $LENGTH($PIECE($GET(GMTSVP),";",2))
SET GMTSPV("GL",$PIECE($GET(GMTSVP),";",2))=""
+3 if $LENGTH($GET(GMTSA))
SET GMTSPV("AB",$GET(GMTSA))=""
+4 QUIT
