- GMTSXAW3 ; SLC/KER - List Parameters/Allowable 2 ; 08/27/2002
- ;;2.7;Health Summary;**47,49,56**;Oct 20, 1995
- ;
- ; External References in GMTSXAW2
- ; DBIA 2051 FIND^DIC
- ; DBIA 2051 $$FIND1^DIC
- ; DBIA 2051 LIST^DIC
- ; DBIA 2056 $$GET1^DIQ
- ; DBIA 2541 $$KSP^XUPARAM
- ; DBIA 2324 $$CLNAME^USRLM
- ; DBIA 2324 WHATIS^USRLM
- ; DBIA 10112 $$PRIM^VASITE
- ; DBIA 10006 ^DIC
- ; DBIA 2054 $$CREF^DILF
- ; DBIA 10076 ^XUSEC("GMTSMGR")
- ; DBIA 10060 ^VA(200
- ; DBIA 10114 ^%ZIS(1,
- ; DBIA 10048 ^DIC(9.4,
- ; DBIA 10090 ^DIC(4,
- ; DBIA 10093 ^DIC(49,
- ; DBIA 3005 ^OR(100.21
- ; DBIA 1996 ^DIC(4.2,
- ; DBIA 2324 ^USR(8930.3,
- ; DBIA 2324 ^USR(8930,
- ; DBIA 3407 ^XTV(8989.51, Pending
- ; DBIA 3408 ^XTV(8989.518, Pending
- ; DBIA 10103 $$DT^XLFDT
- ;
- Q
- SET(GMTSA,GMTSP,GMTSN,GMTSALW,GMTSI,GMTSF) ; Create Array Entry
- ;
- ; GMTSA Identifier SYS USR Req
- ; GMTSP Variable Ptr 97;DIC(4.2, 1118;VA(200, Req
- ; GMTSN Name System User Req
- ; .GMTSALW Array Root GMTSALW( Req
- ; GMTSI Array IEN GMTSALW(GMTSI) Req
- ; GMTSF Value Flag Include only values Opt
- ;
- Q:'$L(GMTSA) Q:'$L(GMTSP) Q:'$L(GMTSN) I +($G(GMTSF))>0 D Q
- . N GMTSD S GMTSD=";"_$P(GMTSP,";",2)
- . S GMTSALW("CHK",GMTSP,GMTSD)="" Q:+($G(GMTSF))>1
- . S GMTSALW("ENT",GMTSA,GMTSP)=""
- . S GMTSALW("VAL",GMTSP,GMTSA)=""
- N GMTS2 S GMTSI=+($G(GMTSI)) Q:GMTSI=0
- S GMTS2=$O(GMTSALW(GMTSI,GMTSA," "),-1)+1
- S GMTSALW(GMTSI,GMTSA,GMTS2)=GMTSP_"^"_GMTSN
- S GMTSALW(GMTSI,GMTSA,"VAL",GMTSP,GMTS2)=""
- S GMTSALW("ENT",GMTSA,GMTSP,GMTSI,GMTS2)=""
- S GMTSALW("VAL",GMTSP,GMTSI,GMTS2)=GMTSA
- Q
- ; Lookups
- LST(X,Y) ; Default Entities 8989.513 Lookup .01, .02
- Q:+($G(X))'>0 N GMTSM,GMTSP S GMTSP=+($G(X)) Q:+($G(GMTSP))'>0
- D LIST^DIC(8989.513,(","_+GMTSP_","),".01;.02","I","*",,,,,.Y,.GMTSM)
- Q
- OTL(X,GMTSOTL) ; OR Team List 100.21 Lookup .01
- N GMTSNM S GMTSNM=$G(X) Q:'$L($G(GMTSNM)) N GMTSM
- D FIND^DIC(100.21,,".01",,GMTSNM,"*","C",,,"GMTSOTL","GMTSM")
- Q
- UCL(X,GMTS) ; User Classes 8930.3 Lookup .01, .02, .03, .04
- N USRT S X=+($G(X)) Q:X=0 D WHATIS^USRLM(X,"USRT")
- N GMTSNM,GMTSCT,GMTSI,GMTSIEN,GMTSC,GMTSCLS,GMTSEFF,GMTSEXP,GMTSCLN,GMTSU,GMTSUN
- S GMTSU=+($G(USRT(0))),GMTSUN=$P($G(USRT(0)),"^",2),GMTSC=$P($G(USRT(0)),"^",3)
- S GMTSC=0,GMTSI="" F S GMTSI=$O(USRT(GMTSI)) Q:GMTSI="" D
- . S GMTSIEN=$P($G(USRT(GMTSI)),"^",2) Q:+GMTSIEN=0 S GMTSCLS=$P($G(USRT(GMTSI)),"^",1),GMTSEFF=$P($G(USRT(GMTSI)),"^",4),GMTSEXP=$P($G(USRT(GMTSI)),"^",5),GMTSCLN=$P($G(USRT(GMTSI)),"^",3)
- . S GMTSC=GMTSC+1,GMTS("ID",GMTSC,.01)=GMTSUN,GMTS("ID",GMTSC,.01,"E")=GMTSU,GMTS("ID",GMTSC,.02)=GMTSCLS,GMTS("ID",GMTSC,.03)=GMTSEFF,GMTS("ID",GMTSC,.04)=GMTSEXP,GMTS("ID",GMTSC,"IEN")=GMTSIEN
- Q
- HSD(X) ; HS Definition
- S X=$$PDI("ORWRP HEALTH SUMMARY TYPE LIST") Q X
- SI(X) ; System Infor 4.2 Lookup
- Q $$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE"))
- ABR(X) ; Abbreviation 8989.518 .02
- N GMTS S X=$G(X) Q:'$L(X) "XXX"
- S:X[";" X=$P(X,";",2) S:X'["^" X="^"_X
- S:$E(X,$L(X))'="("&(X["(")&(X'[",") X=X_"," S X=X_"0"
- S GMTS=$$CREF^DILF(X) I X'=GMTS,GMTS["0" D Q X
- . S X=+($P($G(@GMTS),"^",2)) I +X'>0 S X="XXX" Q
- . S X=$$UP^GMTSXA($$GET1^DIQ(8989.518,(X_","),.02))
- . S:$L(X)'=3 X="XXX"
- Q "XXX"
- ETI(X) ; Entity IEN 8989.518 Lookup
- Q:$L($G(X))'=3 0 N GMTSM
- Q $$FIND1^DIC(8989.518,,"CO",$G(X),"C",,.GMTSM)
- EFN(X) ; Entity File # 8989.518 .001
- Q $$GET1^DIQ(8989.518,(+($G(X))_","),.001)
- ENM(X) ; Entity Name 8989.518 .01
- Q $$GET1^DIQ(8989.518,(+($G(X))_","),.01)
- EAB(X) ; Entity Abbrv 8989.518 .02
- Q $$GET1^DIQ(8989.518,(+($G(X))_","),.02)
- EMC(X) ; Entity Mix Case 8989.518 .03
- Q $$GET1^DIQ(8989.518,(+($G(X))_","),.03)
- PDI(X) ; Param Def IEN 8989.51 Lookup
- S X=$G(X) Q:'$L(X) "" N DIC,DTOUT,DUOUT,Y,GMTSM
- Q $$FIND1^DIC(8989.51,,"CO",$G(X),.GMTSM)
- PDN(X) ; Param Def Name 8989.51 .01
- Q $$GET1^DIQ(8989.51,(+($G(X))_","),.01)
- UVP(X) ; User Var Ptr 200
- N GMTS S GMTS=+($G(X)) Q:'$L($$UNM(GMTS)) ""
- S X=GMTS_";VA(200," Q X
- USR(X) ; Get User 200 Lookup
- N DIC,Y,DTOUT,DUOUT,GMTSN,GMTSP S GMTSN=$$UNM(+($G(DUZ))),GMTSP=$G(X),DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Select User: "
- S:$L(GMTSP) DIC("A")=GMTSP S DIC("S")="I $$ACTIVE^XUSER(+($G(Y)))>0" S:$L(GMTSN) DIC("B")=GMTSN D ^DIC S X=+Y
- Q X
- UNM(X) ; User Name 200 .01
- Q $$GET1^DIQ(200,(+($G(X))_","),.01)
- MGR(X) ; HS Manager
- Q $S(((+($G(DUZ))>0)&($D(^XUSEC("GMTSMGR",+($G(DUZ)))))):1,1:0)
- PK(X) ; Package 9.4 Lookup
- S X=$G(X) Q:'$L(X) "" N DIC,DTOUT,DUOUT,Y,GMTSM
- Q $$FIND1^DIC(9.4,,"CO",$G(X),"C",,.GMTSM)
- DEV(X) ; Device Name 3.5 .01
- Q $$GET1^DIQ(3.5,(+($G(X))_","),.01)
- DIV(X) ; Division Name 4 .01
- Q $$GET1^DIQ(4,(+($G(X))_","),.01)
- UD(X) ; User's Division 200.02 .01
- N GMTSINST,GMTSDIV,GMTSUSR,GMTSMD,GMTSKS,GMTSKSM,GMTSDS,GMTSDSM,GMTSDZ,GMTSDZM
- S:+($G(DT))'>0 DT=$$DT^XLFDT S U="^",GMTSUSR=+($G(X))
- S GMTSKS=$$KSP^XUPARAM("INST"),GMTSKSM=$$GET1^DIQ(4,(+GMTSKS_","),5,"I"),GMTSKSM=$S(GMTSKSM["Y":1,1:0)
- S GMTSDS=$O(^VA(200,GMTSUSR,2,"AX1",1,0)),GMTSDSM=$$GET1^DIQ(4,(+GMTSDS_","),5,"I"),GMTSDSM=$S(GMTSDSM["Y":1,1:0)
- S GMTSDZ=+($G(DUZ(2))),GMTSDZM=$$GET1^DIQ(4,(+GMTSDZ_","),5,"I"),GMTSDZM=$S(GMTSDZM["Y":1,1:0)
- S GMTSMD=GMTSDZM+GMTSDSM+GMTSKSM
- ; Not a Multi-Divisional Institution
- I +GMTSMD'>0&(+GMTSKS>0) S X=+GMTSKS_";DIC(4," Q X
- ; Login Division
- I +GMTSDZ>0,$D(^DIC(4,+GMTSDZ)) S X=+GMTSDZ_";DIC(4," Q X
- ; No Login Division
- I +GMTSDS'>0&(+GMTSDZ'>0)&(+GMTSKS>0) S X=+GMTSKS_";DIC(4," Q X
- ; Default Division
- I +GMTSDS>0 S X=+GMTSDS_";DIC(4," Q X
- Q ""
- DD(X) ; Division (Default) 200.02 .01
- Q:+($G(X))'>0 "" K ^TMP("DILIST",$J) D DS(+($G(X)),.Y)
- N GMTSDD,GMTSI S GMTSDD=""
- S GMTSI=0 F S GMTSI=$O(^TMP("DILIST",$J,"ID",GMTSI)) Q:+GMTSI=0!($L(GMTSDD)) D
- . I $G(^TMP("DILIST",$J,"ID",GMTSI,1))=1 S GMTSDD=$G(^TMP("DILIST",$J,"ID",GMTSI,.01))
- K ^TMP("DILIST",$J) S X=$G(GMTSDD) Q X
- DS(X,Y) ; Divisions 200.02 Lookup .01, 1
- Q:+($G(X))'>0 N GMTSM,GMTSP S GMTSP=+($G(X)) Q:+($G(GMTSP))'>0
- D LIST^DIC(200.02,(","_+GMTSP_","),".01;1","I","*",,,,,.Y,.GMTSM)
- Q
- DE(X) ; Division (Primary) 40.8 Lookup .07
- N PRIM S PRIM=$$PRIM^VASITE S X=$$GET1^DIQ(40.8,(PRIM_","),.07,"I")
- Q X
- SYS(X) ; System Name 4.2 .01
- Q $$GET1^DIQ(4.2,(+($G(X))_","),.01)
- PKG(X) ; Package Name 9.4 .01
- Q $$GET1^DIQ(9.4,(+($G(X))_","),.01)
- SRI(X) ; Service (I) 200 29
- Q $$GET1^DIQ(200,(+($G(X))_","),29,"I")
- SRV(X) ; Service Name 49 .01
- Q $$GET1^DIQ(49,(+($G(X))_","),.01)
- CLS(X) ; User Class Name 8930 .01
- Q $$UP^GMTSXA($$CLNAME^USRLM(+($G(X))))
- SYSV(X) ; System Var Ptr
- N GMTSYS S GMTSYS=$$KSP^XUPARAM("WHERE") I $L(GMTSYS) D Q:'$L(GMTSYS) ""
- . N DIC,DTOUT,DUOUT,X,Y S DIC="^DIC(4.2,",X=GMTSYS,DIC(0)="MXO"
- . D ^DIC S GMTSYS=+Y S:GMTSYS'>0 GMTSYS="" S GMTSYS=$S(+GMTSYS>0:(GMTSYS_";"_$P(DIC,"^",2)),1:"")
- S X=GMTSYS Q X
- USRV(X) ; User Var Ptr
- N GMTSU,GMTSUV S GMTSU=$G(X) I $L($$UNM(+($G(X)))) S X=+($G(X))_";VA(200," Q X
- N DIC,DTOUT,DUOUT,X,Y S DIC="^VA(200,",X=GMTSU,DIC(0)="MXO" D ^DIC S GMTSU=+Y,GMTSUV=""
- S:GMTSU'>0 GMTSUV="" S:GMTSU>0 GMTSUV=GMTSU_";"_$P(DIC,"^",2) S X=GMTSUV Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXAW3 7696 printed Feb 18, 2025@23:27:15 Page 2
- GMTSXAW3 ; SLC/KER - List Parameters/Allowable 2 ; 08/27/2002
- +1 ;;2.7;Health Summary;**47,49,56**;Oct 20, 1995
- +2 ;
- +3 ; External References in GMTSXAW2
- +4 ; DBIA 2051 FIND^DIC
- +5 ; DBIA 2051 $$FIND1^DIC
- +6 ; DBIA 2051 LIST^DIC
- +7 ; DBIA 2056 $$GET1^DIQ
- +8 ; DBIA 2541 $$KSP^XUPARAM
- +9 ; DBIA 2324 $$CLNAME^USRLM
- +10 ; DBIA 2324 WHATIS^USRLM
- +11 ; DBIA 10112 $$PRIM^VASITE
- +12 ; DBIA 10006 ^DIC
- +13 ; DBIA 2054 $$CREF^DILF
- +14 ; DBIA 10076 ^XUSEC("GMTSMGR")
- +15 ; DBIA 10060 ^VA(200
- +16 ; DBIA 10114 ^%ZIS(1,
- +17 ; DBIA 10048 ^DIC(9.4,
- +18 ; DBIA 10090 ^DIC(4,
- +19 ; DBIA 10093 ^DIC(49,
- +20 ; DBIA 3005 ^OR(100.21
- +21 ; DBIA 1996 ^DIC(4.2,
- +22 ; DBIA 2324 ^USR(8930.3,
- +23 ; DBIA 2324 ^USR(8930,
- +24 ; DBIA 3407 ^XTV(8989.51, Pending
- +25 ; DBIA 3408 ^XTV(8989.518, Pending
- +26 ; DBIA 10103 $$DT^XLFDT
- +27 ;
- +28 QUIT
- SET(GMTSA,GMTSP,GMTSN,GMTSALW,GMTSI,GMTSF) ; Create Array Entry
- +1 ;
- +2 ; GMTSA Identifier SYS USR Req
- +3 ; GMTSP Variable Ptr 97;DIC(4.2, 1118;VA(200, Req
- +4 ; GMTSN Name System User Req
- +5 ; .GMTSALW Array Root GMTSALW( Req
- +6 ; GMTSI Array IEN GMTSALW(GMTSI) Req
- +7 ; GMTSF Value Flag Include only values Opt
- +8 ;
- +9 if '$LENGTH(GMTSA)
- QUIT
- if '$LENGTH(GMTSP)
- QUIT
- if '$LENGTH(GMTSN)
- QUIT
- IF +($GET(GMTSF))>0
- Begin DoDot:1
- +10 NEW GMTSD
- SET GMTSD=";"_$PIECE(GMTSP,";",2)
- +11 SET GMTSALW("CHK",GMTSP,GMTSD)=""
- if +($GET(GMTSF))>1
- QUIT
- +12 SET GMTSALW("ENT",GMTSA,GMTSP)=""
- +13 SET GMTSALW("VAL",GMTSP,GMTSA)=""
- End DoDot:1
- QUIT
- +14 NEW GMTS2
- SET GMTSI=+($GET(GMTSI))
- if GMTSI=0
- QUIT
- +15 SET GMTS2=$ORDER(GMTSALW(GMTSI,GMTSA," "),-1)+1
- +16 SET GMTSALW(GMTSI,GMTSA,GMTS2)=GMTSP_"^"_GMTSN
- +17 SET GMTSALW(GMTSI,GMTSA,"VAL",GMTSP,GMTS2)=""
- +18 SET GMTSALW("ENT",GMTSA,GMTSP,GMTSI,GMTS2)=""
- +19 SET GMTSALW("VAL",GMTSP,GMTSI,GMTS2)=GMTSA
- +20 QUIT
- +21 ; Lookups
- LST(X,Y) ; Default Entities 8989.513 Lookup .01, .02
- +1 if +($GET(X))'>0
- QUIT
- NEW GMTSM,GMTSP
- SET GMTSP=+($GET(X))
- if +($GET(GMTSP))'>0
- QUIT
- +2 DO LIST^DIC(8989.513,(","_+GMTSP_","),".01;.02","I","*",,,,,.Y,.GMTSM)
- +3 QUIT
- OTL(X,GMTSOTL) ; OR Team List 100.21 Lookup .01
- +1 NEW GMTSNM
- SET GMTSNM=$GET(X)
- if '$LENGTH($GET(GMTSNM))
- QUIT
- NEW GMTSM
- +2 DO FIND^DIC(100.21,,".01",,GMTSNM,"*","C",,,"GMTSOTL","GMTSM")
- +3 QUIT
- UCL(X,GMTS) ; User Classes 8930.3 Lookup .01, .02, .03, .04
- +1 NEW USRT
- SET X=+($GET(X))
- if X=0
- QUIT
- DO WHATIS^USRLM(X,"USRT")
- +2 NEW GMTSNM,GMTSCT,GMTSI,GMTSIEN,GMTSC,GMTSCLS,GMTSEFF,GMTSEXP,GMTSCLN,GMTSU,GMTSUN
- +3 SET GMTSU=+($GET(USRT(0)))
- SET GMTSUN=$PIECE($GET(USRT(0)),"^",2)
- SET GMTSC=$PIECE($GET(USRT(0)),"^",3)
- +4 SET GMTSC=0
- SET GMTSI=""
- FOR
- SET GMTSI=$ORDER(USRT(GMTSI))
- if GMTSI=""
- QUIT
- Begin DoDot:1
- +5 SET GMTSIEN=$PIECE($GET(USRT(GMTSI)),"^",2)
- if +GMTSIEN=0
- QUIT
- SET GMTSCLS=$PIECE($GET(USRT(GMTSI)),"^",1)
- SET GMTSEFF=$PIECE($GET(USRT(GMTSI)),"^",4)
- SET GMTSEXP=$PIECE($GET(USRT(GMTSI)),"^",5)
- SET GMTSCLN=$PIECE($GET(USRT(GMTSI)),"^",3)
- +6 SET GMTSC=GMTSC+1
- SET GMTS("ID",GMTSC,.01)=GMTSUN
- SET GMTS("ID",GMTSC,.01,"E")=GMTSU
- SET GMTS("ID",GMTSC,.02)=GMTSCLS
- SET GMTS("ID",GMTSC,.03)=GMTSEFF
- SET GMTS("ID",GMTSC,.04)=GMTSEXP
- SET GMTS("ID",GMTSC,"IEN")=GMTSIEN
- End DoDot:1
- +7 QUIT
- HSD(X) ; HS Definition
- +1 SET X=$$PDI("ORWRP HEALTH SUMMARY TYPE LIST")
- QUIT X
- SI(X) ; System Infor 4.2 Lookup
- +1 QUIT $$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE"))
- ABR(X) ; Abbreviation 8989.518 .02
- +1 NEW GMTS
- SET X=$GET(X)
- if '$LENGTH(X)
- QUIT "XXX"
- +2 if X[";"
- SET X=$PIECE(X,";",2)
- if X'["^"
- SET X="^"_X
- +3 if $EXTRACT(X,$LENGTH(X))'="("&(X["(")&(X'[",")
- SET X=X_","
- SET X=X_"0"
- +4 SET GMTS=$$CREF^DILF(X)
- IF X'=GMTS
- IF GMTS["0"
- Begin DoDot:1
- +5 SET X=+($PIECE($GET(@GMTS),"^",2))
- IF +X'>0
- SET X="XXX"
- QUIT
- +6 SET X=$$UP^GMTSXA($$GET1^DIQ(8989.518,(X_","),.02))
- +7 if $LENGTH(X)'=3
- SET X="XXX"
- End DoDot:1
- QUIT X
- +8 QUIT "XXX"
- ETI(X) ; Entity IEN 8989.518 Lookup
- +1 if $LENGTH($GET(X))'=3
- QUIT 0
- NEW GMTSM
- +2 QUIT $$FIND1^DIC(8989.518,,"CO",$GET(X),"C",,.GMTSM)
- EFN(X) ; Entity File # 8989.518 .001
- +1 QUIT $$GET1^DIQ(8989.518,(+($GET(X))_","),.001)
- ENM(X) ; Entity Name 8989.518 .01
- +1 QUIT $$GET1^DIQ(8989.518,(+($GET(X))_","),.01)
- EAB(X) ; Entity Abbrv 8989.518 .02
- +1 QUIT $$GET1^DIQ(8989.518,(+($GET(X))_","),.02)
- EMC(X) ; Entity Mix Case 8989.518 .03
- +1 QUIT $$GET1^DIQ(8989.518,(+($GET(X))_","),.03)
- PDI(X) ; Param Def IEN 8989.51 Lookup
- +1 SET X=$GET(X)
- if '$LENGTH(X)
- QUIT ""
- NEW DIC,DTOUT,DUOUT,Y,GMTSM
- +2 QUIT $$FIND1^DIC(8989.51,,"CO",$GET(X),.GMTSM)
- PDN(X) ; Param Def Name 8989.51 .01
- +1 QUIT $$GET1^DIQ(8989.51,(+($GET(X))_","),.01)
- UVP(X) ; User Var Ptr 200
- +1 NEW GMTS
- SET GMTS=+($GET(X))
- if '$LENGTH($$UNM(GMTS))
- QUIT ""
- +2 SET X=GMTS_";VA(200,"
- QUIT X
- USR(X) ; Get User 200 Lookup
- +1 NEW DIC,Y,DTOUT,DUOUT,GMTSN,GMTSP
- SET GMTSN=$$UNM(+($GET(DUZ)))
- SET GMTSP=$GET(X)
- SET DIC="^VA(200,"
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select User: "
- +2 if $LENGTH(GMTSP)
- SET DIC("A")=GMTSP
- SET DIC("S")="I $$ACTIVE^XUSER(+($G(Y)))>0"
- if $LENGTH(GMTSN)
- SET DIC("B")=GMTSN
- DO ^DIC
- SET X=+Y
- +3 QUIT X
- UNM(X) ; User Name 200 .01
- +1 QUIT $$GET1^DIQ(200,(+($GET(X))_","),.01)
- MGR(X) ; HS Manager
- +1 QUIT $SELECT(((+($GET(DUZ))>0)&($DATA(^XUSEC("GMTSMGR",+($GET(DUZ)))))):1,1:0)
- PK(X) ; Package 9.4 Lookup
- +1 SET X=$GET(X)
- if '$LENGTH(X)
- QUIT ""
- NEW DIC,DTOUT,DUOUT,Y,GMTSM
- +2 QUIT $$FIND1^DIC(9.4,,"CO",$GET(X),"C",,.GMTSM)
- DEV(X) ; Device Name 3.5 .01
- +1 QUIT $$GET1^DIQ(3.5,(+($GET(X))_","),.01)
- DIV(X) ; Division Name 4 .01
- +1 QUIT $$GET1^DIQ(4,(+($GET(X))_","),.01)
- UD(X) ; User's Division 200.02 .01
- +1 NEW GMTSINST,GMTSDIV,GMTSUSR,GMTSMD,GMTSKS,GMTSKSM,GMTSDS,GMTSDSM,GMTSDZ,GMTSDZM
- +2 if +($GET(DT))'>0
- SET DT=$$DT^XLFDT
- SET U="^"
- SET GMTSUSR=+($GET(X))
- +3 SET GMTSKS=$$KSP^XUPARAM("INST")
- SET GMTSKSM=$$GET1^DIQ(4,(+GMTSKS_","),5,"I")
- SET GMTSKSM=$SELECT(GMTSKSM["Y":1,1:0)
- +4 SET GMTSDS=$ORDER(^VA(200,GMTSUSR,2,"AX1",1,0))
- SET GMTSDSM=$$GET1^DIQ(4,(+GMTSDS_","),5,"I")
- SET GMTSDSM=$SELECT(GMTSDSM["Y":1,1:0)
- +5 SET GMTSDZ=+($GET(DUZ(2)))
- SET GMTSDZM=$$GET1^DIQ(4,(+GMTSDZ_","),5,"I")
- SET GMTSDZM=$SELECT(GMTSDZM["Y":1,1:0)
- +6 SET GMTSMD=GMTSDZM+GMTSDSM+GMTSKSM
- +7 ; Not a Multi-Divisional Institution
- +8 IF +GMTSMD'>0&(+GMTSKS>0)
- SET X=+GMTSKS_";DIC(4,"
- QUIT X
- +9 ; Login Division
- +10 IF +GMTSDZ>0
- IF $DATA(^DIC(4,+GMTSDZ))
- SET X=+GMTSDZ_";DIC(4,"
- QUIT X
- +11 ; No Login Division
- +12 IF +GMTSDS'>0&(+GMTSDZ'>0)&(+GMTSKS>0)
- SET X=+GMTSKS_";DIC(4,"
- QUIT X
- +13 ; Default Division
- +14 IF +GMTSDS>0
- SET X=+GMTSDS_";DIC(4,"
- QUIT X
- +15 QUIT ""
- DD(X) ; Division (Default) 200.02 .01
- +1 if +($GET(X))'>0
- QUIT ""
- KILL ^TMP("DILIST",$JOB)
- DO DS(+($GET(X)),.Y)
- +2 NEW GMTSDD,GMTSI
- SET GMTSDD=""
- +3 SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(^TMP("DILIST",$JOB,"ID",GMTSI))
- if +GMTSI=0!($LENGTH(GMTSDD))
- QUIT
- Begin DoDot:1
- +4 IF $GET(^TMP("DILIST",$JOB,"ID",GMTSI,1))=1
- SET GMTSDD=$GET(^TMP("DILIST",$JOB,"ID",GMTSI,.01))
- End DoDot:1
- +5 KILL ^TMP("DILIST",$JOB)
- SET X=$GET(GMTSDD)
- QUIT X
- DS(X,Y) ; Divisions 200.02 Lookup .01, 1
- +1 if +($GET(X))'>0
- QUIT
- NEW GMTSM,GMTSP
- SET GMTSP=+($GET(X))
- if +($GET(GMTSP))'>0
- QUIT
- +2 DO LIST^DIC(200.02,(","_+GMTSP_","),".01;1","I","*",,,,,.Y,.GMTSM)
- +3 QUIT
- DE(X) ; Division (Primary) 40.8 Lookup .07
- +1 NEW PRIM
- SET PRIM=$$PRIM^VASITE
- SET X=$$GET1^DIQ(40.8,(PRIM_","),.07,"I")
- +2 QUIT X
- SYS(X) ; System Name 4.2 .01
- +1 QUIT $$GET1^DIQ(4.2,(+($GET(X))_","),.01)
- PKG(X) ; Package Name 9.4 .01
- +1 QUIT $$GET1^DIQ(9.4,(+($GET(X))_","),.01)
- SRI(X) ; Service (I) 200 29
- +1 QUIT $$GET1^DIQ(200,(+($GET(X))_","),29,"I")
- SRV(X) ; Service Name 49 .01
- +1 QUIT $$GET1^DIQ(49,(+($GET(X))_","),.01)
- CLS(X) ; User Class Name 8930 .01
- +1 QUIT $$UP^GMTSXA($$CLNAME^USRLM(+($GET(X))))
- SYSV(X) ; System Var Ptr
- +1 NEW GMTSYS
- SET GMTSYS=$$KSP^XUPARAM("WHERE")
- IF $LENGTH(GMTSYS)
- Begin DoDot:1
- +2 NEW DIC,DTOUT,DUOUT,X,Y
- SET DIC="^DIC(4.2,"
- SET X=GMTSYS
- SET DIC(0)="MXO"
- +3 DO ^DIC
- SET GMTSYS=+Y
- if GMTSYS'>0
- SET GMTSYS=""
- SET GMTSYS=$SELECT(+GMTSYS>0:(GMTSYS_";"_$PIECE(DIC,"^",2)),1:"")
- End DoDot:1
- if '$LENGTH(GMTSYS)
- QUIT ""
- +4 SET X=GMTSYS
- QUIT X
- USRV(X) ; User Var Ptr
- +1 NEW GMTSU,GMTSUV
- SET GMTSU=$GET(X)
- IF $LENGTH($$UNM(+($GET(X))))
- SET X=+($GET(X))_";VA(200,"
- QUIT X
- +2 NEW DIC,DTOUT,DUOUT,X,Y
- SET DIC="^VA(200,"
- SET X=GMTSU
- SET DIC(0)="MXO"
- DO ^DIC
- SET GMTSU=+Y
- SET GMTSUV=""
- +3 if GMTSU'>0
- SET GMTSUV=""
- if GMTSU>0
- SET GMTSUV=GMTSU_";"_$PIECE(DIC,"^",2)
- SET X=GMTSUV
- QUIT X