| [613] | 1 | ECMUTL ;ALB/ESD - Utilities for Multiple Dates/Mult Procs ;20 AUG 1997 13:56
|
|---|
| 2 | ;;2.0; EVENT CAPTURE ;**5,10,18,33,47,63**;8 May 96
|
|---|
| 3 | ;
|
|---|
| 4 | ASKLOC() ; Get Location
|
|---|
| 5 | ; Input: None
|
|---|
| 6 | ;
|
|---|
| 7 | ; Output: ECL = Location (Division file pointer) ien
|
|---|
| 8 | ; ECLN = Location name
|
|---|
| 9 | ;
|
|---|
| 10 | D ^ECL
|
|---|
| 11 | K ECOUT,LOC
|
|---|
| 12 | Q $S($D(ECL):1,1:0)
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | ASKPRDT(DSSU,ONE) ; Get Procedure Start Date/Time
|
|---|
| 16 | ; Input: ECD = DSS Unit ien
|
|---|
| 17 | ; ONE = Ask procedure start date/time once
|
|---|
| 18 | ;
|
|---|
| 19 | ; Output: ^TMP("ECPRDT",$J) = procedure date/time array
|
|---|
| 20 | ;
|
|---|
| 21 | N DTOUT,DUOUT,ECCNT,ECDUP,ECERR
|
|---|
| 22 | S (ECCNT,ECDUP,ECERR)=0
|
|---|
| 23 | I '$G(DSSU) G ASKPRDTQ
|
|---|
| 24 | I $P($G(^ECD(DSSU,0)),"^",12)="N" S DIR("B")="NOW"
|
|---|
| 25 | AGAIN N DIRUT,Y
|
|---|
| 26 | S DIR("A")="Select "_$S(+ECDUP:"Another Procedure Date and Time",1:"Procedure Date and Time")
|
|---|
| 27 | S DIR("?")="Enter both date AND time procedure was performed. Future dates are not allowed."
|
|---|
| 28 | S DIR(0)="DO^:NOW:EXR"
|
|---|
| 29 | D ^DIR K DIR
|
|---|
| 30 | I $D(DTOUT)!($D(DUOUT)) S ECERR=1
|
|---|
| 31 | I +Y S ECDUP=1,^TMP("ECPRDT",$J,Y)="" G @($S('$G(ONE):"AGAIN",1:"ASKPRDTQ"))
|
|---|
| 32 | ;
|
|---|
| 33 | ASKPRDTQ Q $S(ECERR:0,(+$G(ONE)&(+Y)):1,('$G(ONE))&($D(^TMP("ECPRDT",$J))):1,1:0)
|
|---|
| 34 | ;
|
|---|
| 35 | ;
|
|---|
| 36 | ASKCAT(ECL,ECD) ; Get category
|
|---|
| 37 | ; Input: ECL = Location ien
|
|---|
| 38 | ; ECD = DSS Unit ien
|
|---|
| 39 | ;
|
|---|
| 40 | ; Output: ECATEG = Category ien (may be 0 if no categories)
|
|---|
| 41 | ;
|
|---|
| 42 | N CATS,DIRUT,ECATEG,ECMAX,X
|
|---|
| 43 | S ECATEG=0_"^No Categories",(ECMAX,X)=0
|
|---|
| 44 | I '$G(ECL)!('$G(ECD)) G ASKCATQ
|
|---|
| 45 | D CATS^ECHECK1
|
|---|
| 46 | I $O(ECC(0))']"" G ASKCATQ
|
|---|
| 47 | W !!,"Categories within "_$P($G(^ECD(+ECD,0)),"^")_":",!
|
|---|
| 48 | F S X=$O(ECC(X)) Q:'X W !?5,X_". ",$P(ECC(X),"^",2) S ECMAX=X
|
|---|
| 49 | W ! S DIR(0)="NA^1:"_ECMAX,DIR("A")="Select Number: "
|
|---|
| 50 | D ^DIR K DIR
|
|---|
| 51 | I 'Y!($D(DIRUT)) K ECATEG G ASKCATQ
|
|---|
| 52 | I +Y S ECATEG=$G(ECC(Y))
|
|---|
| 53 | ASKCATQ K CNT,ECAT,ECC
|
|---|
| 54 | Q $G(ECATEG)
|
|---|
| 55 | ;
|
|---|
| 56 | ;
|
|---|
| 57 | ASKPRO(ECL,ECD,ECC,NUM) ; Ask procedures
|
|---|
| 58 | ; Input: ECL = Location ien
|
|---|
| 59 | ; ECD = DSS Unit ien
|
|---|
| 60 | ; ECC = Category ien
|
|---|
| 61 | ; NUM = Only ask procedure once
|
|---|
| 62 | ;
|
|---|
| 63 | ; Output: ^TMP("ECPROC",$J) = procedure array
|
|---|
| 64 | ;
|
|---|
| 65 | N CNT,ECERR,ECOUNT,ECOUT,ECPCNT,ECP,ECPNM,ECPREV,ECREAS,ECVOLU,ECEXIT
|
|---|
| 66 | N ECX,ECMOD,ECMODS,ECCPT,ECDT
|
|---|
| 67 | I '$D(ECL)!('$D(ECD)) G ASKPROQ
|
|---|
| 68 | S ECC=+$G(ECC)
|
|---|
| 69 | S ECOUNT=0
|
|---|
| 70 | S ECDT=$O(^TMP("ECPRDT",$J,0))
|
|---|
| 71 | D PROS^ECHECK1
|
|---|
| 72 | I '$O(^TMP("ECPRO",$J,0)) D G ASKPROQ
|
|---|
| 73 | . W !!,"Within the ",ECLN," location there are no procedures defined",!
|
|---|
| 74 | . W "for the DSS Unit ",$P(ECDSSU,"^",2),".",!
|
|---|
| 75 | . S DIR(0)="E" D ^DIR K DIR,Y
|
|---|
| 76 | ;
|
|---|
| 77 | SEL ;
|
|---|
| 78 | K ECPNAME,ECMOD
|
|---|
| 79 | S (ECPNM,ECPREV,ECREAS,ECX)="",(CNT,ECPCNT,ECP,ECVOLU,ECEXIT)=0
|
|---|
| 80 | S DIR("?")="^D LISTPR^ECMUTL"
|
|---|
| 81 | W ! S ECX=$$GETPRO^ECDSUTIL
|
|---|
| 82 | I +$G(ECX)=-1,('ECOUNT) D MSG^ECBEN2U,KILLV^ECDSUTIL G ASKPROQ
|
|---|
| 83 | I +$G(ECX)=-1,ECOUNT G ASKPROQ
|
|---|
| 84 | I +$G(ECX)=1 S ECPREV=$P(ECX,"^",2) D SRCHTM^ECDSUTIL(ECX)
|
|---|
| 85 | S ECPCNT=+$G(ECPCNT)
|
|---|
| 86 | I ECPCNT=-1!(ECPCNT=-2) D G SEL
|
|---|
| 87 | . D @($S(ECPCNT=-1:"ERRMSG^ECDSUTIL",ECPCNT=-2:"ERRMSG2^ECDSUTIL"))
|
|---|
| 88 | . D KILLV^ECDSUTIL
|
|---|
| 89 | I ECPCNT>0 D D CONTINU G:$G(ECERR) ASKPROQ
|
|---|
| 90 | . S CNT=ECPCNT
|
|---|
| 91 | . I ECPREV="L" W $P($G(^TMP("ECPRO",$J,+$G(^TMP("ECLKUP",$J,"LAST")))),"^",4)
|
|---|
| 92 | . I ECPREV="X"!(ECPREV="N") W " "_$P($G(^TMP("ECPRO",$J,+CNT)),"^",4)
|
|---|
| 93 | I 'ECPCNT,$D(ECPNAME) D G:CNT=-1!($G(ECERR)) ASKPROQ
|
|---|
| 94 | . S CNT=$$PRLST^ECDSUTIL
|
|---|
| 95 | . I CNT=-1 D MSG^ECBEN2U,KILLV^ECDSUTIL Q
|
|---|
| 96 | . I CNT>0 D
|
|---|
| 97 | .. W " "_$S(ECPREV="S":$P($G(^TMP("ECPRO",$J,+CNT)),"^",3),1:$P($G(^TMP("ECPRO",$J,+CNT)),"^",4))
|
|---|
| 98 | .. D CONTINU
|
|---|
| 99 | ;
|
|---|
| 100 | I CNT>0,($G(ECP)'=""),(ECVOLU>0) D
|
|---|
| 101 | . S ECOUNT=$S(+$G(NUM)=-99:1,+$G(NUM)>0:NUM,1:(ECOUNT+1))
|
|---|
| 102 | . S ^TMP("ECPROC",$J,(ECOUNT))=ECP_"^"_ECPNM_"^"_+ECREAS_"^"_$S(+ECREAS:$P($G(^ECR($P($G(^ECL(+ECREAS,0)),"^"),0)),"^"),1:"Reason Not Defined")_"^"_ECVOLU
|
|---|
| 103 | . S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
|
|---|
| 104 | . I ECCPT'="",$O(ECMOD(ECCPT,""))'="" D
|
|---|
| 105 | . . M ^TMP("ECPROC",$J,ECOUNT,"MOD")=ECMOD(ECCPT)
|
|---|
| 106 | I '$G(NUM) G SEL
|
|---|
| 107 | ASKPROQ K ^TMP("ECPRO",$J),^TMP("ECLKUP",$J),JJ,OK
|
|---|
| 108 | D KILLV^ECDSUTIL
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | CONTINU ;
|
|---|
| 112 | D SETP
|
|---|
| 113 | S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
|
|---|
| 114 | I ECCPT'="" D I $G(ECERR) G CONTINUQ
|
|---|
| 115 | . S ECMODS=$G(ECMODS)
|
|---|
| 116 | . S ECMODF=$$ASKMOD^ECUTL(ECCPT,ECMODS,ECDT,.ECMOD,.ECERR)
|
|---|
| 117 | . K ECMODF,ECMODS
|
|---|
| 118 | S ECREAS=$$ASKREAS(ECL,ECD,ECC,ECP,.ECERR)
|
|---|
| 119 | G:$G(ECERR) CONTINUQ
|
|---|
| 120 | S ECVOLU=$$ASKVOL(ECL,ECD,ECC,ECP,.ECERR)
|
|---|
| 121 | CONTINUQ Q
|
|---|
| 122 | ;
|
|---|
| 123 | SETP ;
|
|---|
| 124 | S ^TMP("ECLKUP",$J,"LAST")=CNT
|
|---|
| 125 | S ECP=$P($G(^TMP("ECPRO",$J,CNT)),"^"),ECPNM=$P($G(^TMP("ECPRO",$J,CNT)),"^",4)
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
| 128 | LISTPR ;- List available procedures
|
|---|
| 129 | ; Input: None
|
|---|
| 130 | ;
|
|---|
| 131 | ; Output: None (display on screen)
|
|---|
| 132 | ;
|
|---|
| 133 | N DIR,DIRUT,ECI,Y
|
|---|
| 134 | S ECI=0
|
|---|
| 135 | D PROCHDR
|
|---|
| 136 | F S ECI=$O(^TMP("ECPRO",$J,ECI)) Q:'ECI!(ECEXIT) D
|
|---|
| 137 | . I ($Y+5>IOSL) S DIR(0)="E" D ^DIR S:'Y!$D(DIRUT) ECEXIT=1 I +Y D PROCHDR
|
|---|
| 138 | . Q:ECEXIT
|
|---|
| 139 | . W !,ECI_".",?5,$E($P(^TMP("ECPRO",$J,ECI),"^",4),1,30),?38,$E($P(^(ECI),"^",3),1,30),?72,$P(^(ECI),"^",5)
|
|---|
| 140 | Q:ECEXIT
|
|---|
| 141 | W !!?5,"Select by number, CPT or national code, procedure name, or synonym.",!?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
|
|---|
| 142 | W ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
|
|---|
| 143 | LISTPRQ Q
|
|---|
| 144 | ;
|
|---|
| 145 | PROCHDR ;- Procedure display header
|
|---|
| 146 | ;
|
|---|
| 147 | W @IOF
|
|---|
| 148 | W !,"Available Procedures within "_$P(ECDSSU,"^",2)_": ",!
|
|---|
| 149 | W ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
|
|---|
| 150 | Q
|
|---|
| 151 | ;
|
|---|
| 152 | ;
|
|---|
| 153 | ASKREAS(ECL,ECD,ECC,ECP,ECOUT) ;-Ask procedure reason
|
|---|
| 154 | ; Input: ECL = Location ien
|
|---|
| 155 | ; ECD = DSS Unit ien
|
|---|
| 156 | ; ECC = Category ien
|
|---|
| 157 | ; ECP = Procedure ien
|
|---|
| 158 | ;
|
|---|
| 159 | ; Output: ECPRPTR = Link file ien (from file #720.5)
|
|---|
| 160 | ; ECOUT = 0 if successful
|
|---|
| 161 | ; 1 if uparrowed or timed out
|
|---|
| 162 | ; (passed by reference)
|
|---|
| 163 | ;
|
|---|
| 164 | N DTOUT,DUOUT,ECPRPTR,ECSCR
|
|---|
| 165 | S (ECOUT,ECPRPTR,ECSCR)=0
|
|---|
| 166 | S ECC=+$G(ECC)
|
|---|
| 167 | I '$D(ECL)!('$D(ECD))!('$D(ECP)) G ASKREASQ
|
|---|
| 168 | I $G(ECP)]"" S ECSCR=+$O(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
|
|---|
| 169 | I ECSCR>0,(+$P($G(^ECJ(ECSCR,"PRO")),"^",5)),(+$O(^ECL("AD",ECSCR,0))) D
|
|---|
| 170 | . S DIC="^ECL(",DIC(0)="QEAM"
|
|---|
| 171 | . S DIC("A")="Procedure Reason: ",DIC("S")="I $P(^(0),U,2)=ECSCR"
|
|---|
| 172 | . D ^DIC K DIC
|
|---|
| 173 | . I +Y>0 S ECPRPTR=+Y
|
|---|
| 174 | . I $D(DTOUT)!($D(DUOUT)) S ECOUT=1
|
|---|
| 175 | ASKREASQ Q +ECPRPTR
|
|---|
| 176 | ;
|
|---|
| 177 | ;
|
|---|
| 178 | ASKVOL(ECL,ECD,ECC,ECP,ECOUT) ;- Ask procedure volume
|
|---|
| 179 | ; Input: ECL = Location ien
|
|---|
| 180 | ; ECD = DSS Unit ien
|
|---|
| 181 | ; ECC = Category ien
|
|---|
| 182 | ; ECP = Procedure ien
|
|---|
| 183 | ;
|
|---|
| 184 | ; Output: ECVOL = volume
|
|---|
| 185 | ; ECOUT = 0 if successful
|
|---|
| 186 | ; 1 if uparrowed or timed out
|
|---|
| 187 | ; (passed by reference)
|
|---|
| 188 | ;
|
|---|
| 189 | N DIR,DIRUT,DTOUT,DUOUT,ECSCR,ECVOL
|
|---|
| 190 | S (ECOUT,ECSCR,ECVOL)=0
|
|---|
| 191 | S ECC=+$G(ECC)
|
|---|
| 192 | I '$D(ECL)!('$D(ECD))!('$D(ECP)) G ASKVOLQ
|
|---|
| 193 | I $G(ECP)]"" S ECSCR=+$O(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
|
|---|
| 194 | S DIR(0)="N^^K:(X<1)!(X>99) X",DIR("A")="Volume"
|
|---|
| 195 | S DIR("?")="Type a Number between 1 and 99, 0 Decimal Digits"
|
|---|
| 196 | S DIR("B")=$S($P($G(^ECJ(ECSCR,"PRO")),"^",3):$P($G(^ECJ(ECSCR,"PRO")),"^",3),1:1)
|
|---|
| 197 | D ^DIR
|
|---|
| 198 | I +Y S ECVOL=Y
|
|---|
| 199 | I $D(DIRUT) S ECOUT=1
|
|---|
| 200 | ASKVOLQ Q +ECVOL
|
|---|
| 201 | ;
|
|---|
| 202 | ;
|
|---|
| 203 | PROV(ECDT,ECPROVS) ;get providers - new providers function
|
|---|
| 204 | ;- This is the same function as PROV^ECPRVUTL
|
|---|
| 205 | ;- Select provider(s) with active person class
|
|---|
| 206 | ;- No updating of file #721 record is done here
|
|---|
| 207 | ;
|
|---|
| 208 | ; input
|
|---|
| 209 | ; ECDT = date/time of procedure (required)
|
|---|
| 210 | ; ECPROVS = local array, passed by reference (required)
|
|---|
| 211 | ;
|
|---|
| 212 | ; output
|
|---|
| 213 | ; ECU(1) = provider #1 (mandatory) ien^provider #1 name^person class
|
|---|
| 214 | ; ECU(2) = provider #2 (optional) ien^provider #2 name^person class
|
|---|
| 215 | ; ECU(3) = provider #3 (optional) ien^provider #3 name^person class
|
|---|
| 216 | ;
|
|---|
| 217 | ; returns
|
|---|
| 218 | ; 0 ==> prov selection successful; at least prov #1 selected
|
|---|
| 219 | ; 1 ==> selection unsuccessful or user timed-out
|
|---|
| 220 | ; 2 ==> selection unsuccessful or user entered "^"
|
|---|
| 221 | ;
|
|---|
| 222 | N ECU,ECU2,ECU3,ECDA
|
|---|
| 223 | D GET^ECPRVUTL("",ECDT,.ECU,.ECU2,.ECU3,.ECOUT)
|
|---|
| 224 | S ECPROVS(1)=ECU,ECPROVS(2)=ECU2,ECPROVS(3)=ECU3
|
|---|
| 225 | Q ECOUT
|
|---|
| 226 | ;
|
|---|
| 227 | ONEUNIT(ECDSSU) ;- Create ECDSSU containing DSS Unit
|
|---|
| 228 | ; Checks for validity and access to Unit
|
|---|
| 229 | ;
|
|---|
| 230 | ; input
|
|---|
| 231 | ; ECDSSU = passed by reference
|
|---|
| 232 | ;
|
|---|
| 233 | ; output
|
|---|
| 234 | ; ECDDSU = ien in file #724^name of DSS unit OR
|
|---|
| 235 | ; undefined
|
|---|
| 236 | ;
|
|---|
| 237 | ; returns ECOUT = 0 if unit selection sucessful OR
|
|---|
| 238 | ; 1 if user times out; selection unsuccessful
|
|---|
| 239 | ; 2 if user up-arrows out; selection unsuccessful
|
|---|
| 240 | ; Note: if selection is unsuccessful, variable ECDSSU will be undefined.
|
|---|
| 241 | ;
|
|---|
| 242 | N Y,DIRUT,DUOUT,ECKEY,ECOUT
|
|---|
| 243 | S ECKEY=$S($D(^XUSEC("ECALLU",DUZ)):1,1:0)
|
|---|
| 244 | F S ECOUT=0 D Q:$G(ECOUT) Q:$G(ECDSSU)
|
|---|
| 245 | .K DUOUT,DTOUT,DIRUT,Y
|
|---|
| 246 | .W !
|
|---|
| 247 | .S DIC=724,DIC("A")="Select DSS Unit: ",DIC(0)="QEAMZ"
|
|---|
| 248 | .S DIC("S")="I ECKEY!($D(^VA(200,DUZ,""EC"",+Y)))"
|
|---|
| 249 | .D ^DIC K DIC
|
|---|
| 250 | .S:$D(DTOUT) ECOUT=1 S:$D(DUOUT) ECOUT=2
|
|---|
| 251 | .Q:$G(ECOUT)
|
|---|
| 252 | .I +Y>0 D Q
|
|---|
| 253 | .. I $$VALID(+Y) S ECDSSU=Y
|
|---|
| 254 | .. I '$$VALID(+Y) D
|
|---|
| 255 | ...S Y=-1
|
|---|
| 256 | ...W !!,?5,"This DSS Unit is either inactive or cannot be used"
|
|---|
| 257 | ...W !,?5,"in Event Capture. Please select a different DSS Unit.",!
|
|---|
| 258 | .I +Y<0 D Q
|
|---|
| 259 | ..W !!,?5,"A response is required...try again."
|
|---|
| 260 | ..W !,?5,"You must enter an ""^"" to exit."
|
|---|
| 261 | .K DIR,DUOUT,DTOUT,DIRUT
|
|---|
| 262 | .W ! S DIR(0)="YA",DIR("A")="Is this correct? ",DIR("B")="YES"
|
|---|
| 263 | .S DIR("?")="Answer YES to accept the unit, NO to start over."
|
|---|
| 264 | .D ^DIR K DIR
|
|---|
| 265 | .I $D(DIRUT) S:$D(DTOUT) ECOUT=1 S:$D(DUOUT) ECOUT=2 K ECDSSU Q
|
|---|
| 266 | .I '$G(Y) K ECDSSU
|
|---|
| 267 | Q ECOUT
|
|---|
| 268 | ;
|
|---|
| 269 | VALID(IEN) ;- Check DSS Unit for use by Event Capture
|
|---|
| 270 | ;
|
|---|
| 271 | N NODE,NO,YES,VAL
|
|---|
| 272 | S NODE=$G(^ECD(IEN,0))
|
|---|
| 273 | ;piece 6 is 'inactive'; piece 8 is 'use with EC'
|
|---|
| 274 | S NO=$P(NODE,"^",6),YES=$P(NODE,"^",8)
|
|---|
| 275 | ;start out with 'valid'
|
|---|
| 276 | S VAL=1 D
|
|---|
| 277 | .;if 'inactive', then 'not valid'
|
|---|
| 278 | .I NO S VAL=0 Q
|
|---|
| 279 | .;if not 'use with EC', then 'not valid'
|
|---|
| 280 | .I 'YES S VAL=0
|
|---|
| 281 | Q VAL
|
|---|
