source: FOIAVistA/tag/r/HEALTH_SUMMARY-GMTS/GMTSXAW2.m@ 628

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