| 1 | GMTSULT ; SLC/KER - HS Type Lookup ; 01/06/2003
|
|---|
| 2 | ;;2.7;Health Summary;**30,35,29,47,58**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10060 ^VA(200
|
|---|
| 6 | ; DBIA 2056 $$GET1^DIQ (file 200)
|
|---|
| 7 | ; DBIA 2055 RECALL^DILFD
|
|---|
| 8 | ; DBIA 10103 $$NOW^XLFDT
|
|---|
| 9 | ; DBIA 10011 ^DIWP
|
|---|
| 10 | ; DBIA 10029 ^DIWW
|
|---|
| 11 | ; DBIA 10026 ^DIR
|
|---|
| 12 | ; DBIA 10016 ^DIM
|
|---|
| 13 | ; DBIA 10076 ^XUSEC(
|
|---|
| 14 | ; DBIA 1131 ^XMB("NETNAME")
|
|---|
| 15 | ; DBIA 2198 $$BROKER^XWBLIB
|
|---|
| 16 | ; DBIA 10006 ^DIC (file #142)
|
|---|
| 17 | ; DBIA 10096 ^%ZOSF("TEST")
|
|---|
| 18 | ;
|
|---|
| 19 | N DIC,DTOUT,DUOUT,DIRUT D DICHK S DIC(0)="AEMQZ" S Y=$$TYPE^GMTSULT Q
|
|---|
| 20 | EN ; Lookup (general)
|
|---|
| 21 | Q:$G(DIC(0))["I"
|
|---|
| 22 | K DTOUT,DUOUT N GMTSDICW,GMTSDICS,GMTSDIC,GMTSLGO,GMTSDIC0,GMTSDICB,GMTSDEF,GMTSWY,GMTSDISV,GMTSDICA,GMTSLERR,GMTSE,GMTSQ,GMTSX,DIR,DIRUT,DIROUT,GMTS
|
|---|
| 23 | S GMTSE=$$ECHO D LD S U="^"
|
|---|
| 24 | S (GMTSDEF,GMTSQ)=0,GMTSX=$G(X) S:$L(GMTSDIC0)&(GMTSDIC0'["A") GMTSQ=1 K Y
|
|---|
| 25 | ; Get X
|
|---|
| 26 | ; Ask the entry DIC(0)["A" (INPUT^GMTSULT5)
|
|---|
| 27 | S:GMTSDIC0'["A"&($L(GMTSX)) X=GMTSX
|
|---|
| 28 | K GMTSLERR S:GMTSDIC0["A"!('$L(GMTSX)) X=$$INPUT^GMTSULT5
|
|---|
| 29 | I $D(DTOUT)!($D(DUOUT)) S Y=-1 S:$D(DTOUT) DTOUT=1 S:$D(DUOUT) DUOUT=1 Q
|
|---|
| 30 | ; Is X an IEN From Spacebar-Return
|
|---|
| 31 | I +($$XIEN(X))>0 D Q
|
|---|
| 32 | . K Y S Y=+($$XIEN(X))
|
|---|
| 33 | . D Y^GMTSULT6(+Y),RD,CLR
|
|---|
| 34 | . I ($G(GMTSDIC0)["Q"!($G(DIC(0))["Q")),+($G(Y))<0 W " ??"
|
|---|
| 35 | ; No Input or Error X="" or X["^" or '$D(X)
|
|---|
| 36 | I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!($G(X)="")!($G(X)["^") D Q
|
|---|
| 37 | . K Y W !!,?5 W:'$L($G(GMTSLERR)) "No Health Summary Type selected"
|
|---|
| 38 | . W:$L($G(GMTSLERR)) GMTSLERR W ! S Y=-1 D RD,CLR
|
|---|
| 39 | ; Exact Match Required DIC(0)["X"
|
|---|
| 40 | I GMTSDIC0["X",$L(X) D Q
|
|---|
| 41 | . K Y S Y=-1,GMTSX=$$EM^GMTSULT2(X) D:+GMTSX>0 Y^GMTSULT6(+GMTSX) D RD,CLR
|
|---|
| 42 | ; Select
|
|---|
| 43 | ; Get Selection List
|
|---|
| 44 | D LIST^GMTSULT2(X)
|
|---|
| 45 | ; Select from multiple entries
|
|---|
| 46 | D:+($G(^TMP("GMTSULT",$J,0)))>1 MULTI^GMTSULT6
|
|---|
| 47 | ; Select from one entry
|
|---|
| 48 | D:+($G(^TMP("GMTSULT",$J,0)))=1 ONE^GMTSULT6
|
|---|
| 49 | S:'$D(Y)!(+($G(Y))'>0) Y=-1
|
|---|
| 50 | ;
|
|---|
| 51 | ; DLAYGO allowed
|
|---|
| 52 | ; Add entry
|
|---|
| 53 | I $L(X),Y=-1,$G(GMTSDIC0)["L",+($G(GMTSLGO))=142 D
|
|---|
| 54 | . Q:$L(X)<3!($L(X)>30) K Y(0) N DLAYGO,GMTSOD0,GMTSOX S GMTSOD0=DIC(0),GMTSOX=X
|
|---|
| 55 | . N X,DA,DIC,DIK S DIC(0)="LM",(DIK,DIC)="^GMT(142,",DLAYGO=142,X=GMTSOX
|
|---|
| 56 | . L +^GMT(142):2 W:'$T !," Can not add Health Summary Type, the file is in ",!," use by another user. Please try again later."
|
|---|
| 57 | . D:$T ADD L -^GMT(142) S (GMTSDIC0,DIC(0))=GMTSOD0
|
|---|
| 58 | D RD,CLR
|
|---|
| 59 | Q
|
|---|
| 60 | ADD ; Add Health Summary Type
|
|---|
| 61 | N GMTSOK,GMTSU,GMTSD,GMTSM S GMTSM=$$MSG
|
|---|
| 62 | S GMTSU=$$GET1^DIQ(200,+($G(DUZ)),.01) I '$L(GMTSU) D S Y=-1 Q
|
|---|
| 63 | . W !!," Undefined/Invalid User",!
|
|---|
| 64 | S GMTSU=+($$GET1^DIQ(200,+($G(DUZ)),9.2,"I")),GMTSD=$$NOW^XLFDT
|
|---|
| 65 | I GMTSU>0&(GMTSU<GMTSD) D S Y=-1 Q
|
|---|
| 66 | . W !!," Terminated Users may not add a Health Summary",!
|
|---|
| 67 | S GMTSOK=+($$ASKA(X)) Q:'GMTSOK
|
|---|
| 68 | S DA=$$DA I DA'>0!($D(^GMT(142,DA))) S Y=-1 Q
|
|---|
| 69 | S $P(^GMT(142,DA,0),"^",1)=X,$P(^GMT(142,DA,0),"^",3)=+($G(DUZ))
|
|---|
| 70 | D SI I '$D(^GMT(142,"B",$E(X,1,30),DA)) D KI K ^GMT(142,DA) S Y=-1 Q
|
|---|
| 71 | S Y=DA_"^"_X_"^1"
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | DA(X) ; Get IEN
|
|---|
| 75 | S X=$O(^GMT(142,"4999999"),-1) F Q:'$D(^GMT(142,X)) S X=X+1
|
|---|
| 76 | Q:X<5000000 X Q:X>5000999 X
|
|---|
| 77 | S X=$O(^GMT(142,"!"),-1) F Q:'$D(^GMT(142,X)) S X=X+1
|
|---|
| 78 | S:X>4999999&(X<6000000) X=6000000 Q X
|
|---|
| 79 | ET(T) ; Error Text
|
|---|
| 80 | I $D(DIEV0) D Q:+($G(DIQUIET))>0
|
|---|
| 81 | . N I,E,A S I=+($G(DIERR)) S:I=0 I=1 S A=$G(GMTSM) S:A="" A="GMTSE" S E=$O(@(A_"(""GMTSERR"","_I_","" "")"),-1)+1,@(A_"(""GMTSERR"","_I_","_+E_")")=$G(T),@(A_"(""GMTSENV"")")=1
|
|---|
| 82 | Q:$D(GMTSETQ) N %,X,Y,Z,I,DIW,DIWF,DIWL,DIWR,DIWT,DN S X=T,DIWL=6,DIWR=78,DIWF="W" D ^DIWP D:$D(^UTILITY($J)) ^DIWW W ?5 Q
|
|---|
| 83 | BL ; Blank Line
|
|---|
| 84 | Q:+($G(DIQUIET))>0 Q:$D(GMTSETQ) W !,?5 Q
|
|---|
| 85 | MSG() ; Message
|
|---|
| 86 | Q:$L($G(DIMSG)) $G(DIMSG) Q:$L($G(DIMSGA)) $G(DIMSGA) Q:$L($G(DIOUTAR)) $G(DIOUTAR) Q:$L($G(DIEFOUT)) $G(DIEFOUT) Q:$L($G(GMTSMS)) $G(GMTSMS)
|
|---|
| 87 | Q "TMP"
|
|---|
| 88 | ASKA(X) ; Ask if adding
|
|---|
| 89 | N GMTSN,GMTSN,GMTSX S GMTSN=$G(X) Q:'$L(X) 0 Q:+($$DUP^GMTSULT7(X))>0 0
|
|---|
| 90 | N DIR,DTOUT,DIROUT,DIRUT,DUOUT S GMTSX=+($$N)+1,GMTSX=$S(GMTSX=0:"",GMTSX=1:(GMTSX_"st"),GMTSX=2:(GMTSX_"nd"),GMTSX=3:(GMTSX_"rd"),1:(GMTSX_"th"))
|
|---|
| 91 | S DIR(0)="YAO",DIR("A",1)="Are you adding '"_GMTSN_"' as ",DIR("A")=" a new HEALTH SUMMARY TYPE"_$S($L(GMTSX):(" (the "_GMTSX_")"),1:"")_"? ",DIR("B")="No"
|
|---|
| 92 | W ! D ^DIR S:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) X="^" S:X["^" X="^" Q:X="^" 0
|
|---|
| 93 | S X=+($G(Y)) S:+X'>0 X=0 Q X
|
|---|
| 94 | N(X) ; Number of Types
|
|---|
| 95 | N I S (I,X)=0 F S I=$O(^GMT(142,I)) Q:+I=0 S X=X+1
|
|---|
| 96 | Q X
|
|---|
| 97 | SI ; Set Indexes
|
|---|
| 98 | D MS N GMTS,GMTSX,GMTSO,GMTSC S GMTS=+($G(DA)),GMTSO=$G(X) Q:GMTS'>0 Q:'$D(^GMT(142,GMTS,0)) Q:'$L(X) N X,DA
|
|---|
| 99 | S DA=GMTS,GMTSX=0 F S GMTSX=$O(^TMP($J,142,.01,1,GMTSX)) Q:+GMTSX=0 D
|
|---|
| 100 | . S X=$G(^TMP($J,142,.01,1,GMTSX,1)) D ^DIM Q:'$D(X) S GMTSC=X,X=GMTSO,DA=GMTS X GMTSC
|
|---|
| 101 | D MK Q
|
|---|
| 102 | KI ; Kill Indexes
|
|---|
| 103 | D MS N GMTS,GMTSX,GMTSO,GMTSC S GMTS=+($G(DA)),GMTSO=$G(X) N X,DA
|
|---|
| 104 | S DA=GMTS,GMTSX=0 F S GMTSX=$O(^TMP($J,142,.01,1,GMTSX)) Q:+GMTSX=0 D
|
|---|
| 105 | . S X=$G(^TMP($J,142,.01,1,GMTSX,2)) D ^DIM Q:'$D(X)
|
|---|
| 106 | . S GMTSC=X,X=GMTSO W !,GMTSC,?60,X,?70,DA
|
|---|
| 107 | D MK Q
|
|---|
| 108 | MS ; Merge Set
|
|---|
| 109 | M ^TMP($J,142,.01,1)=@("^DD("_142_",.01,1)") Q
|
|---|
| 110 | MK ; Merge Kill
|
|---|
| 111 | K ^TMP($J,142,.01,1) Q
|
|---|
| 112 | TYPE(GMTSI) ; Get Health Summary Type
|
|---|
| 113 | ; Needs DIC(0)
|
|---|
| 114 | K Y S:$L($G(X)) X=$G(X)
|
|---|
| 115 | D EN^GMTSULT S GMTSI=-1 S:+($G(Y))>0&($D(^GMT(142,+($G(Y)),0))) GMTSI=$G(Y) Q GMTSI
|
|---|
| 116 | XIEN(X) ; Is X in a Y or `IEN format Quit +IEN
|
|---|
| 117 | N GMTSX,GMTSL,GMTSI,GMTSN,GMTSY,GMTSOK
|
|---|
| 118 | S GMTSX=$G(X),GMTSL=$E(GMTSX,1),GMTSI=$E(GMTSX,2,$L(GMTSX))
|
|---|
| 119 | S GMTSOK=$$DICS^GMTSULT2($G(GMTSDICS),$P($G(^GMT(142,+GMTSI,0)),"^",1),+GMTSI) Q:'GMTSOK -1
|
|---|
| 120 | I GMTSL="`",+GMTSI>0,+GMTSI=GMTSI,$D(^GMT(142,+GMTSI,0)),$L($P($G(^GMT(142,+GMTSI,0)),"^",1)) S X=GMTSI Q X
|
|---|
| 121 | S GMTSI=$S($D(^GMT(142,+GMTSX,0)):+X,1:-1)
|
|---|
| 122 | S GMTSN=$P($G(^GMT(142,+GMTSX,0)),"^",1)
|
|---|
| 123 | I GMTSI=+GMTSX&(GMTSN=$P(GMTSX,"^",2)) S X=GMTSI Q X
|
|---|
| 124 | Q 0
|
|---|
| 125 | LD ; Load DIC Variables
|
|---|
| 126 | D DICHK S (DIC,GMTSDIC)="^GMT(142,",GMTSDIC0="AEM" S:$L($G(DLAYGO)) GMTSLGO=$G(DLAYGO) S GMTSDICA="Select HEALTH SUMMARY TYPE: " K Y
|
|---|
| 127 | S:$L($G(DIC("W"))) GMTSDICW=DIC("W") S:$L($G(DIC("S"))) GMTSDICS=DIC("S") S:$L($G(DIC("A"))) GMTSDICA=DIC("A") S:$L($G(DIC("B"))) GMTSDICB=DIC("B") S:$L($G(DIC(0))) GMTSDIC0=DIC(0)
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | ; Lookup Screens - DIC("S")="I +$$..
|
|---|
| 131 | EOK(X) ; Edit OK
|
|---|
| 132 | N OK,GMTS S X=+($G(X)),OK=1 S:'$D(^GMT(142,+X,0)) OK=0 S:$P($G(^GMT(142,+X,"VA")),U)=2 OK=0 S X=OK Q X
|
|---|
| 133 | EST(X) ; Edit Health Summary Type (other than Adhoc)
|
|---|
| 134 | N GMTSI,GMTSO,GMTS S X=+($G(X))
|
|---|
| 135 | Q:'$L($P($G(^VA(200,+($G(DUZ)),0)),U)) 0 Q:+($G(DUZ(2)))=0 0
|
|---|
| 136 | S GMTSI=$P($G(^GMT(142,+X,0)),U) Q:GMTSI="GMTS HS ADHOC OPTION"!(GMTSI="GMTS HS REMOTE ADHOC OPTION") 0
|
|---|
| 137 | S GMTSI=+($P($G(^GMT(142,+X,"VA")),U)),GMTSO=$G(^XMB("NETNAME")) Q:GMTSI=2&'(GMTSO["ISC-SLC"&(+($G(DUZ(2)))=5000)) 0 Q:GMTSI=2&(GMTSO["ISC-SLC"&(+($G(DUZ(2)))=5000)) 1
|
|---|
| 138 | S GMTSI=+($P($G(^GMT(142,+X,0)),U,3)) Q:GMTSI>0&(GMTSI=+($G(DUZ))) 1
|
|---|
| 139 | S GMTSI=$P($G(^GMT(142,+X,0)),U,2),GMTSO=0 S:$L(GMTSI) GMTSO=$S(((+($G(DUZ))>0)&('$D(^XUSEC(GMTSI,+($G(DUZ)))))):1,1:0) Q:GMTSO=1 0
|
|---|
| 140 | S GMTSI=+($P($G(^GMT(142,+X,0)),U,3)),GMTSO=$D(^GMT(142,+X,2,"B",+($G(DUZ)))) Q:GMTSI>0&(+($G(DUZ))>0)&(GMTSI'=+($G(DUZ)))&(+GMTSO>0) 1
|
|---|
| 141 | S GMTSI=+($P($G(^GMT(142,+X,0)),U,3)) Q:GMTSI>0&(GMTSI'=+($G(DUZ))) 0
|
|---|
| 142 | S GMTSI=$P($G(^GMT(142,+X,0)),U,2),GMTSO=0 S:$L(GMTSI) GMTSO=$S(((+($G(DUZ))>0)&($D(^XUSEC(GMTSI,+($G(DUZ)))))):1,1:0) Q:GMTSO=1 1
|
|---|
| 143 | Q 1
|
|---|
| 144 | HST(X) ; Health Summary Type
|
|---|
| 145 | N GMTS S X=+($G(X)),GMTS=1 S:$P($G(^GMT(142,+X,0)),U)="GMTS HS ADHOC OPTION" GMTS=0 S:$P($G(^GMT(142,+X,0)),U)="GMTS HS REMOTE ADHOC OPTION" GMTS=0 S:+($G(^GMT(142,+X,"VA")))>0 GMTS=0
|
|---|
| 146 | S X=GMTS Q X
|
|---|
| 147 | DHST(X) ; Delete Health Summary Type
|
|---|
| 148 | N GMTS S X=+($G(X)),GMTS=1
|
|---|
| 149 | S:$P($G(^GMT(142,+X,0)),U)="GMTS HS ADHOC OPTION" GMTS=0 S:$P($G(^GMT(142,+X,0)),U)="GMTS HS REMOTE ADHOC OPTION" GMTS=0
|
|---|
| 150 | S:+($G(^GMT(142,+X,"VA")))>0 GMTS=0 S:$D(^GMT(142.5,"AC",+X)) GMTS=0
|
|---|
| 151 | S X=GMTS Q X
|
|---|
| 152 | AHST(X) ; Add Health Summary Type
|
|---|
| 153 | N GMTS S X=+($G(X)),GMTS=1 S:$P($G(^GMT(142,+X,0)),U)="GMTS HS ADHOC OPTION" GMTS=0 S:$P($G(^GMT(142,+X,0)),U)="GMTS HS REMOTE ADHOC OPTION" GMTS=0
|
|---|
| 154 | S:((+X>4999999)&(+X<6000000)) GMTS=0 S:+($G(^GMT(142,+X,"VA")))>0 GMTS=0
|
|---|
| 155 | S X=GMTS Q X
|
|---|
| 156 | ADH(X) ; Adhoc
|
|---|
| 157 | N GMTS S X=+($G(X)),GMTS=1 S:$P($G(^GMT(142,+X,0)),U)'="GMTS HS ADHOC OPTION" GMTS=0 S X=GMTS Q X
|
|---|
| 158 | REM(X) ; Remote Adhoc
|
|---|
| 159 | N GMTS S X=+($G(X)),GMTS=1 S:$P($G(^GMT(142,+X,0)),U)'="GMTS HS REMOTE ADHOC OPTION" GMTS=0 S X=GMTS Q X
|
|---|
| 160 | Q
|
|---|
| 161 | ;
|
|---|
| 162 | DICHK ; Check DIC variables
|
|---|
| 163 | K DIC("DR"),DIC("P"),DIC("V"),DINUM,DTOUT,DUOUT
|
|---|
| 164 | S:'$L($G(DIC(0))) DIC(0)="AEMZB" S:'$L($G(DIC)) DIC="^GMT(142,"
|
|---|
| 165 | I +($G(GMTSE))=0 F Q:DIC(0)'["E" S DIC(0)=$P(DIC(0),"E",1)_$P(DIC(0),"E",2)
|
|---|
| 166 | S:'$L($G(DIC("A"))) DIC("A")="Select HEALTH SUMMARY TYPE: "
|
|---|
| 167 | Q
|
|---|
| 168 | RD ; Restore DIC Variables
|
|---|
| 169 | S:$L($G(GMTSDIC)) DIC=GMTSDIC S:$L($G(GMTSDICS)) DIC("S")=GMTSDICS
|
|---|
| 170 | S:$L($G(GMTSDICW)) DIC("W")=GMTSDICW S:$L($G(GMTSDICA)) DIC("A")=GMTSDICA
|
|---|
| 171 | S:$L($G(GMTSDICB)) DIC("B")=GMTSDICB S:$L($G(GMTSDIC0)) DIC(0)=GMTSDIC0
|
|---|
| 172 | I $L($G(X)),X["`" D
|
|---|
| 173 | . N GMTSI,GMTSL S GMTSL=$E(X,1),GMTSI=$E(X,2,$L(X))
|
|---|
| 174 | . I GMTSL="`",+GMTSI>0,$D(^GMT(142,+GMTSI,0)),$L($P($G(^GMT(142,+GMTSI,0)),"^",1)) S X=$P($G(^GMT(142,+GMTSI,0)),"^",1)
|
|---|
| 175 | K GMTSDICS,GMTSDIC,GMTSDIC0,GMTSDICB,GMTS,GMTSDISV,GMTSDICA Q
|
|---|
| 176 | ECHO(X) ; Echo Results (writes/reads)
|
|---|
| 177 | S X=$$ROK("XWBLIB") Q:'X 1 S X=$$BROKER^XWBLIB Q:X 0 Q 1
|
|---|
| 178 | SDISV(Y) ; Set DISV (IEN)
|
|---|
| 179 | Q:+($G(DUZ))=0!(+($G(Y))=0)
|
|---|
| 180 | D RECALL^DILFD(142,+($G(Y))_",",+($G(DUZ))) Q
|
|---|
| 181 | RDISV(X) ; Read DISV
|
|---|
| 182 | Q:+($G(DUZ))=0 ""
|
|---|
| 183 | N DIC,Y S DIC=142,DIC(0)="Z",X=" " D ^DIC S X=$S(+Y>0:Y,1:"") Q X
|
|---|
| 184 | ROK(X) ; Routine OK
|
|---|
| 185 | S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1 Q 0
|
|---|
| 186 | CLR ; Kill ^TMP("GMTS*
|
|---|
| 187 | K ^TMP("GMTSULT",$J),^TMP("GMTSULT2",$J) Q
|
|---|
| 188 | CLEAN ; Kill ^TMP("GMTSULT2")
|
|---|
| 189 | K ^TMP("GMTSULT2",$J) Q
|
|---|
