| 1 | ECED3 ;BIR/MAM,JPW-Enter Event Capture Data (cont'd) ;7 May 96
|
|---|
| 2 | ;;2.0; EVENT CAPTURE ;**1,4,5,7,10,13,18,23,29,32,47,72**;8 May 96
|
|---|
| 3 | EDIT ; enter or edit procedure
|
|---|
| 4 | W !!,"Edit or Delete this Procedure: EDIT// " R X:DTIME I '$T!(X["^") S ECOUT=1 Q
|
|---|
| 5 | S X=$E(X) S:X="" X="E" I "EeDd"'[X W !!,"Press <RET> to edit the selected procedure, or enter D to delete",!,"the procedure.",! G EDIT
|
|---|
| 6 | I "Dd"[X D DEL Q
|
|---|
| 7 | D SETE^ECEDU
|
|---|
| 8 | ASK ;edit cat
|
|---|
| 9 | S (ECFLG,ECOLD,ECOLDN,EC1,OK)=0
|
|---|
| 10 | I '$D(ECC(1)) G P
|
|---|
| 11 | I '$D(ECC(2)) G P
|
|---|
| 12 | W !!,"Category: "_ECCN_"// " R X:DTIME I '$T!(X["^") S ECOUT=1 Q
|
|---|
| 13 | I X="" G P
|
|---|
| 14 | I "?"[X G NEWC
|
|---|
| 15 | NEW ; create new procedure
|
|---|
| 16 | S MM="" F S MM=$O(ECC(MM)) Q:(MM="")!($D(ECHOICE)) I $D(ECC(MM)),$P(ECC(MM),"^",2)=X S ECHOICE=MM
|
|---|
| 17 | I $D(ECHOICE) S ECOLD=ECC,ECOLDN=ECCN,ECC=+ECC(ECHOICE),ECCN=$P(ECC(ECHOICE),"^",2)
|
|---|
| 18 | I $D(ECHOICE),ECC=ECOLD K ECOLD,ECOLDN W !,"CATEGORY: "_ECCN K ECHOICE G P
|
|---|
| 19 | I $D(ECHOICE) G P
|
|---|
| 20 | NEWC S X="",(CNT,ECOLD)=0
|
|---|
| 21 | LIST W !,"Categories within "_ECDN_": ",! S EC1=0 F I=0:0 S CNT=$O(ECC(CNT)) Q:'CNT!$D(ECHOICE) D:($Y+5>IOSL) SELC Q:$D(ECHOICE) I X="" W !,CNT_". ",?5,$P(ECC(CNT),"^",2)
|
|---|
| 22 | I '$D(ECSTOP),$D(ECHOICE) G P
|
|---|
| 23 | PICK W !!,"Select Number: " R X:DTIME I '$T!("^"[X) S ECOUT=1 Q
|
|---|
| 24 | I '$D(ECC(X)) W !!,"Select the number corresponding to the procedure category, or ^ to quit.",!!,"Press <RET> to continue ",! R X:DTIME K ECHOICE,ECSTOP S CNT=CNT-5,X="" D HDR^ECEDU G LIST
|
|---|
| 25 | S ECOLD=ECC,ECOLDN=ECCN,ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) I ECC=ECOLD K ECOLD,ECOLDN
|
|---|
| 26 | P ; get procedure
|
|---|
| 27 | S EC1=1 D PROS^ECHECK1
|
|---|
| 28 | I '$O(^TMP("ECPRO",$J,0)) D Q:ECOUT
|
|---|
| 29 | .W !!,"Within the ",ECLN," location there are no procedures defined",!
|
|---|
| 30 | .W "for the DSS Unit ",ECDN,". Please select another DSS Unit.",!!
|
|---|
| 31 | .W "Press <RET> to continue " R X:DTIME S ECOUT=2 Q
|
|---|
| 32 | P1 ;
|
|---|
| 33 | I '$D(^TMP("ECPRO",$J,2)) S CNT=1 D SETP W !,"Procedure: " D G DIE
|
|---|
| 34 | . W $S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
|
|---|
| 35 | . W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
|
|---|
| 36 | ;
|
|---|
| 37 | NEWP S ECX="",(ECPCNT,CNT,OK)=0,EC1=1 K ECHOICE,ECSTOP
|
|---|
| 38 | I $G(ECPN)]"" S DIR("B")=ECPN
|
|---|
| 39 | S DIR("?")="^D PROS^ECED3"
|
|---|
| 40 | S ECX=$$GETPRO^ECDSUTIL
|
|---|
| 41 | I +$G(ECX)=-1 D KILLV^ECDSUTIL S ECOUT=1 Q
|
|---|
| 42 | ;
|
|---|
| 43 | I +$G(ECX),($G(ECPROCED)=$G(ECPN)) D KILLV^ECDSUTIL G DIE
|
|---|
| 44 | ;
|
|---|
| 45 | P2 ;ask mul proc
|
|---|
| 46 | I +$G(ECX)=1 D SRCHTM^ECDSUTIL(ECX)
|
|---|
| 47 | S ECPCNT=+$G(ECPCNT)
|
|---|
| 48 | I ECPCNT=-1!(ECPCNT=-2) D G NEWP
|
|---|
| 49 | . D @($S(ECPCNT=-1:"ERRMSG^ECDSUTIL",ECPCNT=-2:"ERRMSG2^ECDSUTIL"))
|
|---|
| 50 | . D KILLV^ECDSUTIL
|
|---|
| 51 | I ECPCNT>0 D G DIE
|
|---|
| 52 | . S CNT=ECPCNT
|
|---|
| 53 | . D SETP
|
|---|
| 54 | . S OK=1
|
|---|
| 55 | . D KILLV^ECDSUTIL
|
|---|
| 56 | I 'ECPCNT,$D(ECPNAME) S CNT=$$PRLST^ECDSUTIL
|
|---|
| 57 | I CNT=-1 D MSG^ECEDU,KILLV^ECDSUTIL Q
|
|---|
| 58 | I CNT>0 D G DIE
|
|---|
| 59 | . D SETP
|
|---|
| 60 | . S OK=1
|
|---|
| 61 | . D KILLV^ECDSUTIL
|
|---|
| 62 | Q
|
|---|
| 63 | PROS ;
|
|---|
| 64 | S X="",CNT=0 K ECHOICE,ECSTOP
|
|---|
| 65 | LISTP D HDR1^ECEDU S JJ=1 W !,"Available Procedures within "_ECDN_": ",!
|
|---|
| 66 | W ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
|
|---|
| 67 | S EC1=1
|
|---|
| 68 | F S CNT=$O(^TMP("ECPRO",$J,CNT)) Q:'CNT!$D(ECHOICE) D:($Y+5>IOSL) SELC Q:$D(ECHOICE) I X="" W !,CNT_".",?5,$E($P(^TMP("ECPRO",$J,CNT),"^",4),1,30),?38,$E($P(^(CNT),"^",3),1,30),?72,$P(^(CNT),"^",5)
|
|---|
| 69 | I X="" D
|
|---|
| 70 | .W !!?5,"Select by number, CPT or national code, procedure name, or synonym."
|
|---|
| 71 | .W !?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
|
|---|
| 72 | .W ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | SETP ;set proc info
|
|---|
| 76 | S ECP=$P(^TMP("ECPRO",$J,CNT),"^"),ECPN=$P(^(CNT),"^",4),NATN=$P(^(CNT),"^",5),SYN=$P(^(CNT),"^",3),ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
|
|---|
| 77 | S ECPTCD="" I ECCPT'="" D
|
|---|
| 78 | . S ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT) I +ECPTCD>0 S ECPTCD=$P(ECPTCD,U,2)
|
|---|
| 79 | W " "_$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
|
|---|
| 80 | W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
|
|---|
| 81 | S EC4=$P(^TMP("ECPRO",$J,CNT),"^",2),EC4=$P($G(^ECJ(+EC4,"PRO")),"^",4)
|
|---|
| 82 | S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"")
|
|---|
| 83 | S ECID=$P($G(^SC(+EC4,0)),"^",7)
|
|---|
| 84 | S ^TMP("ECLKUP",$J,"LAST")=CNT
|
|---|
| 85 | Q
|
|---|
| 86 | DIE ;edit record
|
|---|
| 87 | I $D(^ECH(DA,0)) S ECPO=$P(^(0),"^",9),$P(^(0),"^",8)=+ECC,$P(^(0),"^",9)=ECP,ECINP=$P(^(0),"^",22),ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP),$P(^ECH(DA,"P"),"^")=ECCPT,ECPR=$P(^(0),"^",3),ECFN=DA,ECDX1=$P($G(^ECH(DA,"P")),U,2) D
|
|---|
| 88 | . Q:ECPO=ECP
|
|---|
| 89 | . W !,?8,"** Procedure code replaced, all modifiers deleted **"
|
|---|
| 90 | . S (ECDA,DA(1))=DA,DIK="^ECH("_DA(1)_",""MOD"",",DA=0
|
|---|
| 91 | . F S DA=$O(^ECH(ECDA,"MOD",DA)) Q:'DA D ^DIK
|
|---|
| 92 | . K DA S DA=ECDA K ECPO,ECDA,DIK,^ECH(DA,"MOD")
|
|---|
| 93 | K DIE,DR S DIE("NO^")="OUTOK",DIE="^ECH("
|
|---|
| 94 | ;
|
|---|
| 95 | S DR=$S($G(ECCPT)'="":"36;",1:"")
|
|---|
| 96 | S DR=DR_"9;11//"_ECMN
|
|---|
| 97 | D ^DIE K DR
|
|---|
| 98 | I $D(DTOUT)!($D(Y)'=0) K DIE S ECOUT=1 Q
|
|---|
| 99 | ;
|
|---|
| 100 | ;- Don't allow future dates for procedure date/time
|
|---|
| 101 | I +$G(ECPR) S Y=ECPR D DD^%DT
|
|---|
| 102 | S %DT="EAXR",%DT("A")="DATE/TIME OF PROCEDURE: ",%DT("B")=$S($G(ECPR)&($G(Y)]""):Y,1:""),%DT(0)="-NOW" K Y
|
|---|
| 103 | D ^%DT K %DT
|
|---|
| 104 | I $D(DTOUT)!($G(Y)=-1) K DTOUT,Y S ECOUT=1 Q
|
|---|
| 105 | S DR="2////"_Y,ECNEWDT=Y
|
|---|
| 106 | D ^DIE K DR,Y
|
|---|
| 107 | ;
|
|---|
| 108 | ;- Get inpatient/outpatient status and file in #721
|
|---|
| 109 | S ECPTSTAT=$$INOUTPT^ECUTL0(+$G(ECDFN),+$G(ECNEWDT))
|
|---|
| 110 | I ECPTSTAT="" D INOUTERR^ECUTL0 Q
|
|---|
| 111 | S DR="29////"_ECPTSTAT
|
|---|
| 112 | D ^DIE
|
|---|
| 113 | K DR
|
|---|
| 114 | ;
|
|---|
| 115 | ;- Get associated clinic
|
|---|
| 116 | I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D Q:+$G(ECOUT)
|
|---|
| 117 | . S DR=$S(EC4N]"":"26//"_EC4N,1:"26")
|
|---|
| 118 | . D ^DIE
|
|---|
| 119 | . K DR
|
|---|
| 120 | . I $D(DTOUT)!($D(Y)'=0) K DIE S ECOUT=1
|
|---|
| 121 | ;
|
|---|
| 122 | ; - Edit Primary and multiple secondary dx codes
|
|---|
| 123 | I $P(ECPCE,"~",2)'="N" D DXEDT^ECEDU I ECOUT Q
|
|---|
| 124 | ;
|
|---|
| 125 | ;- Determine patient eligibility
|
|---|
| 126 | I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D
|
|---|
| 127 | . I '$$MULTELG^ECUTL0(+$G(ECDFN)) S ECELIG=+$G(VAEL(1))
|
|---|
| 128 | . E D
|
|---|
| 129 | .. S ECELCOD=+$P($G(^ECH(DA,"PCE")),"~",17)
|
|---|
| 130 | .. S ECELDSP=$S(ECELCOD:$P($G(^DIC(8,ECELCOD,0)),"^"),1:"NO ELIGIBILITY ON FILE")
|
|---|
| 131 | .. S ECELANS=$$ASKIF^ECUTL0(ECELDSP)
|
|---|
| 132 | .. I (ECELANS<1) D
|
|---|
| 133 | ... I ECELDSP="NO ELIGIBILITY ON FILE" D ELIGERR^ECUTL0
|
|---|
| 134 | ... S ECELIG=$S(ECELDSP="NO ELIGIBILITY ON FILE":+$G(VAEL(1)),1:ECELCOD)
|
|---|
| 135 | .. I (ECELANS>0) S ECELIG=+$$ELGLST^ECUTL0
|
|---|
| 136 | K ECELANS,ECELCOD,ECELDSP,VAEL,ECNEWDT,ECDX1
|
|---|
| 137 | ;
|
|---|
| 138 | ;- Display inpatient/outpatient status message
|
|---|
| 139 | D DSPSTAT^ECUTL0(ECPTSTAT)
|
|---|
| 140 | ;
|
|---|
| 141 | ;- Ask classification questions applicable to patient and file in #721
|
|---|
| 142 | I $$ASKCLASS^ECUTL1(+$G(ECDFN),.ECCLFLDS,.ECOUT,ECPCE,ECPTSTAT,DA),($O(ECCLFLDS(""))]"") D EDCLASS^ECUTL1(DA,.ECCLFLDS)
|
|---|
| 143 | Q:+$G(ECOUT)
|
|---|
| 144 | K ECCLFLDS
|
|---|
| 145 | ;
|
|---|
| 146 | ;- Get provider(s) with active person class
|
|---|
| 147 | I '$G(ECOUT) D ASKPRV^ECPRVMUT(DA,ECDT,.ECPRVARY,.ECOUT)
|
|---|
| 148 | I '$G(ECOUT) S ECFIL=$$FILPRV^ECPRVMUT(DA,.ECPRVARY,.ECOUT)
|
|---|
| 149 | K ECFIL,ECPRVARY,ECPRV,ECPRVN
|
|---|
| 150 | I $G(ECOUT)!$D(DTOUT) K DIE S ECOUT=1 Q
|
|---|
| 151 | ;
|
|---|
| 152 | ;- File assoc clinic from event code screen if null
|
|---|
| 153 | I $P($G(^ECH(DA,0)),"^",19)="" D
|
|---|
| 154 | . I $G(EC4)="" D GETCLN
|
|---|
| 155 | . S EC4=+$G(EC4)
|
|---|
| 156 | . I EC4>0 D
|
|---|
| 157 | .. S DR="26////^S X=EC4"
|
|---|
| 158 | .. D ^DIE K DR
|
|---|
| 159 | ;
|
|---|
| 160 | ;- Procedure Reason(s)
|
|---|
| 161 | I $G(ECP)]"" S ECSCR=+$O(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
|
|---|
| 162 | I ECSCR>0,($P($G(^ECJ(ECSCR,"PRO")),"^",5)=1),(+$O(^ECL("AD",ECSCR,0))) D Q:+$G(ECOUT)
|
|---|
| 163 | . S DIE="^ECH(",DR="34" D ^DIE K DR,DIE
|
|---|
| 164 | . I $D(DTOUT)!($D(Y)'=0) K ECSCR S ECOUT=1 Q
|
|---|
| 165 | ;
|
|---|
| 166 | K DIE,ECSCR S EC(0)=^ECH(+EC(EC),0),ECFN=+EC(0)
|
|---|
| 167 | S ECZZ=$G(^ECH(ECFN,"P")),ECDX=+$P(ECZZ,"^",2),ECCPT=+$P(ECZZ,"^"),ECINP=$P(EC(0),"^",22) K ECZZ
|
|---|
| 168 | S EC4=$P(EC(0),"^",19),ECID=$P($G(^SC(+EC4,0)),"^",7),$P(^ECH(ECFN,0),"^",20)=ECID
|
|---|
| 169 | I $P(ECPCE,"~",2)="N" G SET
|
|---|
| 170 | I ($P(ECPCE,"~",2)="O")&(ECINP'="O") G SET
|
|---|
| 171 | D CLIN^ECEDF I 'ECPCL W !!,"You should edit this patient procedure and enter an active clinic.",!!
|
|---|
| 172 | W !!,"Press <RET> to continue " R X:DTIME
|
|---|
| 173 | SET ; sets data
|
|---|
| 174 | S $P(^ECH(DA,0),"^",14)="",$P(^ECH(DA,0),"^",16)="",$P(^ECH(DA,0),"^",18)=""
|
|---|
| 175 | S $P(^ECH(DA,0),"^",13)=DUZ,ECU=$P(^(0),"^",11) K DA
|
|---|
| 176 | Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q
|
|---|
| 177 | D PCEE^ECBEN2U
|
|---|
| 178 | Q
|
|---|
| 179 | DEL ; delete existing procedure
|
|---|
| 180 | W !!,"Are you sure that you want to delete this entire procedure from",!,"your records ? NO// " R X:DTIME I '$T!(X["^") S ECOUT=1 Q
|
|---|
| 181 | S X=$E(X) S:X="" X="N" I "NnYy"'[X W !!,"Enter YES to delete this procedure, or <RET> to quit this option." G DEL
|
|---|
| 182 | I "Nn"[X Q
|
|---|
| 183 | S ECCH=$G(^ECH(+EC(EC),0)),ECVST=+$P(ECCH,"^",21) I 'ECVST G DELP
|
|---|
| 184 | ;
|
|---|
| 185 | ;* Prepare all EC records with same Visit file entry to resend to PCE
|
|---|
| 186 | ;* Remove Visit entry from ^ECH( so DELVFILE will complete cleanup
|
|---|
| 187 | N ECVAR1 S ECVAR1=$$FNDVST^ECUTL(ECVST) K ECVAR1 ;* 2nd Param not sent
|
|---|
| 188 | ;
|
|---|
| 189 | ;- Set VALQUIET to stop Amb Care validator from broadcasting to screen
|
|---|
| 190 | S VALQUIET=1,ECVV=$$DELVFILE^PXAPI("ALL",ECVST) K ECVST,VALQUIET
|
|---|
| 191 | DELP S DA=+EC(EC),DIK="^ECH(" W !!,"Deleting Procedure... " D ^DIK K DA,DIK,ECVV
|
|---|
| 192 | ;S ECOUT=99 ;JAM/9/28/01 remove to allow redisplay of screen
|
|---|
| 193 | W !!,"Press <RET> to continue " R X:DTIME
|
|---|
| 194 | Q
|
|---|
| 195 | SELC ; select category
|
|---|
| 196 | W !!,$S(EC1:"Press",1:"Select Number, or press")_" <RET> to continue listing "_$S(EC1:"procedures",1:"categories")_" or '^' to stop: " R X:DTIME I '$T!(X="^") S (ECSTOP,ECHOICE)=1 Q
|
|---|
| 197 | I X="" W @IOF,!,$S(EC1:"Available Procedures",1:"Categories")_" within ",ECDN," : ",! Q
|
|---|
| 198 | I 'EC1,'$D(ECC(X)) D MSGC^ECEDU Q
|
|---|
| 199 | I EC1,'$D(^TMP("ECPRO",$J,X)) D MSGC^ECEDU Q
|
|---|
| 200 | S ECHOICE=1
|
|---|
| 201 | I 'EC1 S ECC=+$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) Q
|
|---|
| 202 | Q
|
|---|
| 203 | ;
|
|---|
| 204 | GETCLN ;- Get assoc clinic from event code screen
|
|---|
| 205 | N ECI
|
|---|
| 206 | I $G(EC4)="",($G(ECP)]"") D
|
|---|
| 207 | . S ECI=+$O(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0)),EC4=+$P($G(^ECJ(+ECI,"PRO")),"^",4)
|
|---|
| 208 | . S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"")
|
|---|
| 209 | Q
|
|---|
