- 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
- 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
