| [613] | 1 | GMTSXAW3 ; SLC/KER - List Parameters/Allowable 2 ; 08/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**47,49,56**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References in GMTSXAW2
|
|---|
| 5 | ; DBIA 2051 FIND^DIC
|
|---|
| 6 | ; DBIA 2051 $$FIND1^DIC
|
|---|
| 7 | ; DBIA 2051 LIST^DIC
|
|---|
| 8 | ; DBIA 2056 $$GET1^DIQ
|
|---|
| 9 | ; DBIA 2541 $$KSP^XUPARAM
|
|---|
| 10 | ; DBIA 2324 $$CLNAME^USRLM
|
|---|
| 11 | ; DBIA 2324 WHATIS^USRLM
|
|---|
| 12 | ; DBIA 10112 $$PRIM^VASITE
|
|---|
| 13 | ; DBIA 10006 ^DIC
|
|---|
| 14 | ; DBIA 2054 $$CREF^DILF
|
|---|
| 15 | ; DBIA 10076 ^XUSEC("GMTSMGR")
|
|---|
| 16 | ; DBIA 10060 ^VA(200
|
|---|
| 17 | ; DBIA 10114 ^%ZIS(1,
|
|---|
| 18 | ; DBIA 10048 ^DIC(9.4,
|
|---|
| 19 | ; DBIA 10090 ^DIC(4,
|
|---|
| 20 | ; DBIA 10093 ^DIC(49,
|
|---|
| 21 | ; DBIA 3005 ^OR(100.21
|
|---|
| 22 | ; DBIA 1996 ^DIC(4.2,
|
|---|
| 23 | ; DBIA 2324 ^USR(8930.3,
|
|---|
| 24 | ; DBIA 2324 ^USR(8930,
|
|---|
| 25 | ; DBIA 3407 ^XTV(8989.51, Pending
|
|---|
| 26 | ; DBIA 3408 ^XTV(8989.518, Pending
|
|---|
| 27 | ; DBIA 10103 $$DT^XLFDT
|
|---|
| 28 | ;
|
|---|
| 29 | Q
|
|---|
| 30 | SET(GMTSA,GMTSP,GMTSN,GMTSALW,GMTSI,GMTSF) ; Create Array Entry
|
|---|
| 31 | ;
|
|---|
| 32 | ; GMTSA Identifier SYS USR Req
|
|---|
| 33 | ; GMTSP Variable Ptr 97;DIC(4.2, 1118;VA(200, Req
|
|---|
| 34 | ; GMTSN Name System User Req
|
|---|
| 35 | ; .GMTSALW Array Root GMTSALW( Req
|
|---|
| 36 | ; GMTSI Array IEN GMTSALW(GMTSI) Req
|
|---|
| 37 | ; GMTSF Value Flag Include only values Opt
|
|---|
| 38 | ;
|
|---|
| 39 | Q:'$L(GMTSA) Q:'$L(GMTSP) Q:'$L(GMTSN) I +($G(GMTSF))>0 D Q
|
|---|
| 40 | . N GMTSD S GMTSD=";"_$P(GMTSP,";",2)
|
|---|
| 41 | . S GMTSALW("CHK",GMTSP,GMTSD)="" Q:+($G(GMTSF))>1
|
|---|
| 42 | . S GMTSALW("ENT",GMTSA,GMTSP)=""
|
|---|
| 43 | . S GMTSALW("VAL",GMTSP,GMTSA)=""
|
|---|
| 44 | N GMTS2 S GMTSI=+($G(GMTSI)) Q:GMTSI=0
|
|---|
| 45 | S GMTS2=$O(GMTSALW(GMTSI,GMTSA," "),-1)+1
|
|---|
| 46 | S GMTSALW(GMTSI,GMTSA,GMTS2)=GMTSP_"^"_GMTSN
|
|---|
| 47 | S GMTSALW(GMTSI,GMTSA,"VAL",GMTSP,GMTS2)=""
|
|---|
| 48 | S GMTSALW("ENT",GMTSA,GMTSP,GMTSI,GMTS2)=""
|
|---|
| 49 | S GMTSALW("VAL",GMTSP,GMTSI,GMTS2)=GMTSA
|
|---|
| 50 | Q
|
|---|
| 51 | ; Lookups
|
|---|
| 52 | LST(X,Y) ; Default Entities 8989.513 Lookup .01, .02
|
|---|
| 53 | Q:+($G(X))'>0 N GMTSM,GMTSP S GMTSP=+($G(X)) Q:+($G(GMTSP))'>0
|
|---|
| 54 | D LIST^DIC(8989.513,(","_+GMTSP_","),".01;.02","I","*",,,,,.Y,.GMTSM)
|
|---|
| 55 | Q
|
|---|
| 56 | OTL(X,GMTSOTL) ; OR Team List 100.21 Lookup .01
|
|---|
| 57 | N GMTSNM S GMTSNM=$G(X) Q:'$L($G(GMTSNM)) N GMTSM
|
|---|
| 58 | D FIND^DIC(100.21,,".01",,GMTSNM,"*","C",,,"GMTSOTL","GMTSM")
|
|---|
| 59 | Q
|
|---|
| 60 | UCL(X,GMTS) ; User Classes 8930.3 Lookup .01, .02, .03, .04
|
|---|
| 61 | N USRT S X=+($G(X)) Q:X=0 D WHATIS^USRLM(X,"USRT")
|
|---|
| 62 | N GMTSNM,GMTSCT,GMTSI,GMTSIEN,GMTSC,GMTSCLS,GMTSEFF,GMTSEXP,GMTSCLN,GMTSU,GMTSUN
|
|---|
| 63 | S GMTSU=+($G(USRT(0))),GMTSUN=$P($G(USRT(0)),"^",2),GMTSC=$P($G(USRT(0)),"^",3)
|
|---|
| 64 | S GMTSC=0,GMTSI="" F S GMTSI=$O(USRT(GMTSI)) Q:GMTSI="" D
|
|---|
| 65 | . 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)
|
|---|
| 66 | . 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
|
|---|
| 67 | Q
|
|---|
| 68 | HSD(X) ; HS Definition
|
|---|
| 69 | S X=$$PDI("ORWRP HEALTH SUMMARY TYPE LIST") Q X
|
|---|
| 70 | SI(X) ; System Infor 4.2 Lookup
|
|---|
| 71 | Q $$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE"))
|
|---|
| 72 | ABR(X) ; Abbreviation 8989.518 .02
|
|---|
| 73 | N GMTS S X=$G(X) Q:'$L(X) "XXX"
|
|---|
| 74 | S:X[";" X=$P(X,";",2) S:X'["^" X="^"_X
|
|---|
| 75 | S:$E(X,$L(X))'="("&(X["(")&(X'[",") X=X_"," S X=X_"0"
|
|---|
| 76 | S GMTS=$$CREF^DILF(X) I X'=GMTS,GMTS["0" D Q X
|
|---|
| 77 | . S X=+($P($G(@GMTS),"^",2)) I +X'>0 S X="XXX" Q
|
|---|
| 78 | . S X=$$UP^GMTSXA($$GET1^DIQ(8989.518,(X_","),.02))
|
|---|
| 79 | . S:$L(X)'=3 X="XXX"
|
|---|
| 80 | Q "XXX"
|
|---|
| 81 | ETI(X) ; Entity IEN 8989.518 Lookup
|
|---|
| 82 | Q:$L($G(X))'=3 0 N GMTSM
|
|---|
| 83 | Q $$FIND1^DIC(8989.518,,"CO",$G(X),"C",,.GMTSM)
|
|---|
| 84 | EFN(X) ; Entity File # 8989.518 .001
|
|---|
| 85 | Q $$GET1^DIQ(8989.518,(+($G(X))_","),.001)
|
|---|
| 86 | ENM(X) ; Entity Name 8989.518 .01
|
|---|
| 87 | Q $$GET1^DIQ(8989.518,(+($G(X))_","),.01)
|
|---|
| 88 | EAB(X) ; Entity Abbrv 8989.518 .02
|
|---|
| 89 | Q $$GET1^DIQ(8989.518,(+($G(X))_","),.02)
|
|---|
| 90 | EMC(X) ; Entity Mix Case 8989.518 .03
|
|---|
| 91 | Q $$GET1^DIQ(8989.518,(+($G(X))_","),.03)
|
|---|
| 92 | PDI(X) ; Param Def IEN 8989.51 Lookup
|
|---|
| 93 | S X=$G(X) Q:'$L(X) "" N DIC,DTOUT,DUOUT,Y,GMTSM
|
|---|
| 94 | Q $$FIND1^DIC(8989.51,,"CO",$G(X),.GMTSM)
|
|---|
| 95 | PDN(X) ; Param Def Name 8989.51 .01
|
|---|
| 96 | Q $$GET1^DIQ(8989.51,(+($G(X))_","),.01)
|
|---|
| 97 | UVP(X) ; User Var Ptr 200
|
|---|
| 98 | N GMTS S GMTS=+($G(X)) Q:'$L($$UNM(GMTS)) ""
|
|---|
| 99 | S X=GMTS_";VA(200," Q X
|
|---|
| 100 | USR(X) ; Get User 200 Lookup
|
|---|
| 101 | 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: "
|
|---|
| 102 | 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
|
|---|
| 103 | Q X
|
|---|
| 104 | UNM(X) ; User Name 200 .01
|
|---|
| 105 | Q $$GET1^DIQ(200,(+($G(X))_","),.01)
|
|---|
| 106 | MGR(X) ; HS Manager
|
|---|
| 107 | Q $S(((+($G(DUZ))>0)&($D(^XUSEC("GMTSMGR",+($G(DUZ)))))):1,1:0)
|
|---|
| 108 | PK(X) ; Package 9.4 Lookup
|
|---|
| 109 | S X=$G(X) Q:'$L(X) "" N DIC,DTOUT,DUOUT,Y,GMTSM
|
|---|
| 110 | Q $$FIND1^DIC(9.4,,"CO",$G(X),"C",,.GMTSM)
|
|---|
| 111 | DEV(X) ; Device Name 3.5 .01
|
|---|
| 112 | Q $$GET1^DIQ(3.5,(+($G(X))_","),.01)
|
|---|
| 113 | DIV(X) ; Division Name 4 .01
|
|---|
| 114 | Q $$GET1^DIQ(4,(+($G(X))_","),.01)
|
|---|
| 115 | UD(X) ; User's Division 200.02 .01
|
|---|
| 116 | N GMTSINST,GMTSDIV,GMTSUSR,GMTSMD,GMTSKS,GMTSKSM,GMTSDS,GMTSDSM,GMTSDZ,GMTSDZM
|
|---|
| 117 | S:+($G(DT))'>0 DT=$$DT^XLFDT S U="^",GMTSUSR=+($G(X))
|
|---|
| 118 | S GMTSKS=$$KSP^XUPARAM("INST"),GMTSKSM=$$GET1^DIQ(4,(+GMTSKS_","),5,"I"),GMTSKSM=$S(GMTSKSM["Y":1,1:0)
|
|---|
| 119 | S GMTSDS=$O(^VA(200,GMTSUSR,2,"AX1",1,0)),GMTSDSM=$$GET1^DIQ(4,(+GMTSDS_","),5,"I"),GMTSDSM=$S(GMTSDSM["Y":1,1:0)
|
|---|
| 120 | S GMTSDZ=+($G(DUZ(2))),GMTSDZM=$$GET1^DIQ(4,(+GMTSDZ_","),5,"I"),GMTSDZM=$S(GMTSDZM["Y":1,1:0)
|
|---|
| 121 | S GMTSMD=GMTSDZM+GMTSDSM+GMTSKSM
|
|---|
| 122 | ; Not a Multi-Divisional Institution
|
|---|
| 123 | I +GMTSMD'>0&(+GMTSKS>0) S X=+GMTSKS_";DIC(4," Q X
|
|---|
| 124 | ; Login Division
|
|---|
| 125 | I +GMTSDZ>0,$D(^DIC(4,+GMTSDZ)) S X=+GMTSDZ_";DIC(4," Q X
|
|---|
| 126 | ; No Login Division
|
|---|
| 127 | I +GMTSDS'>0&(+GMTSDZ'>0)&(+GMTSKS>0) S X=+GMTSKS_";DIC(4," Q X
|
|---|
| 128 | ; Default Division
|
|---|
| 129 | I +GMTSDS>0 S X=+GMTSDS_";DIC(4," Q X
|
|---|
| 130 | Q ""
|
|---|
| 131 | DD(X) ; Division (Default) 200.02 .01
|
|---|
| 132 | Q:+($G(X))'>0 "" K ^TMP("DILIST",$J) D DS(+($G(X)),.Y)
|
|---|
| 133 | N GMTSDD,GMTSI S GMTSDD=""
|
|---|
| 134 | S GMTSI=0 F S GMTSI=$O(^TMP("DILIST",$J,"ID",GMTSI)) Q:+GMTSI=0!($L(GMTSDD)) D
|
|---|
| 135 | . I $G(^TMP("DILIST",$J,"ID",GMTSI,1))=1 S GMTSDD=$G(^TMP("DILIST",$J,"ID",GMTSI,.01))
|
|---|
| 136 | K ^TMP("DILIST",$J) S X=$G(GMTSDD) Q X
|
|---|
| 137 | DS(X,Y) ; Divisions 200.02 Lookup .01, 1
|
|---|
| 138 | Q:+($G(X))'>0 N GMTSM,GMTSP S GMTSP=+($G(X)) Q:+($G(GMTSP))'>0
|
|---|
| 139 | D LIST^DIC(200.02,(","_+GMTSP_","),".01;1","I","*",,,,,.Y,.GMTSM)
|
|---|
| 140 | Q
|
|---|
| 141 | DE(X) ; Division (Primary) 40.8 Lookup .07
|
|---|
| 142 | N PRIM S PRIM=$$PRIM^VASITE S X=$$GET1^DIQ(40.8,(PRIM_","),.07,"I")
|
|---|
| 143 | Q X
|
|---|
| 144 | SYS(X) ; System Name 4.2 .01
|
|---|
| 145 | Q $$GET1^DIQ(4.2,(+($G(X))_","),.01)
|
|---|
| 146 | PKG(X) ; Package Name 9.4 .01
|
|---|
| 147 | Q $$GET1^DIQ(9.4,(+($G(X))_","),.01)
|
|---|
| 148 | SRI(X) ; Service (I) 200 29
|
|---|
| 149 | Q $$GET1^DIQ(200,(+($G(X))_","),29,"I")
|
|---|
| 150 | SRV(X) ; Service Name 49 .01
|
|---|
| 151 | Q $$GET1^DIQ(49,(+($G(X))_","),.01)
|
|---|
| 152 | CLS(X) ; User Class Name 8930 .01
|
|---|
| 153 | Q $$UP^GMTSXA($$CLNAME^USRLM(+($G(X))))
|
|---|
| 154 | SYSV(X) ; System Var Ptr
|
|---|
| 155 | N GMTSYS S GMTSYS=$$KSP^XUPARAM("WHERE") I $L(GMTSYS) D Q:'$L(GMTSYS) ""
|
|---|
| 156 | . N DIC,DTOUT,DUOUT,X,Y S DIC="^DIC(4.2,",X=GMTSYS,DIC(0)="MXO"
|
|---|
| 157 | . D ^DIC S GMTSYS=+Y S:GMTSYS'>0 GMTSYS="" S GMTSYS=$S(+GMTSYS>0:(GMTSYS_";"_$P(DIC,"^",2)),1:"")
|
|---|
| 158 | S X=GMTSYS Q X
|
|---|
| 159 | USRV(X) ; User Var Ptr
|
|---|
| 160 | N GMTSU,GMTSUV S GMTSU=$G(X) I $L($$UNM(+($G(X)))) S X=+($G(X))_";VA(200," Q X
|
|---|
| 161 | N DIC,DTOUT,DUOUT,X,Y S DIC="^VA(200,",X=GMTSU,DIC(0)="MXO" D ^DIC S GMTSU=+Y,GMTSUV=""
|
|---|
| 162 | S:GMTSU'>0 GMTSUV="" S:GMTSU>0 GMTSUV=GMTSU_";"_$P(DIC,"^",2) S X=GMTSUV Q X
|
|---|
