ECED3 ;BIR/MAM,JPW-Enter Event Capture Data (cont'd) ;7 May 96
;;2.0; EVENT CAPTURE ;**1,4,5,7,10,13,18,23,29,32,47,72**;8 May 96
EDIT ; enter or edit procedure
W !!,"Edit or Delete this Procedure: EDIT// " R X:DTIME I '$T!(X["^") S ECOUT=1 Q
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
I "Dd"[X D DEL Q
D SETE^ECEDU
ASK ;edit cat
S (ECFLG,ECOLD,ECOLDN,EC1,OK)=0
I '$D(ECC(1)) G P
I '$D(ECC(2)) G P
W !!,"Category: "_ECCN_"// " R X:DTIME I '$T!(X["^") S ECOUT=1 Q
I X="" G P
I "?"[X G NEWC
NEW ; create new procedure
S MM="" F S MM=$O(ECC(MM)) Q:(MM="")!($D(ECHOICE)) I $D(ECC(MM)),$P(ECC(MM),"^",2)=X S ECHOICE=MM
I $D(ECHOICE) S ECOLD=ECC,ECOLDN=ECCN,ECC=+ECC(ECHOICE),ECCN=$P(ECC(ECHOICE),"^",2)
I $D(ECHOICE),ECC=ECOLD K ECOLD,ECOLDN W !,"CATEGORY: "_ECCN K ECHOICE G P
I $D(ECHOICE) G P
NEWC S X="",(CNT,ECOLD)=0
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)
I '$D(ECSTOP),$D(ECHOICE) G P
PICK W !!,"Select Number: " R X:DTIME I '$T!("^"[X) S ECOUT=1 Q
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
S ECOLD=ECC,ECOLDN=ECCN,ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) I ECC=ECOLD K ECOLD,ECOLDN
P ; get procedure
S EC1=1 D PROS^ECHECK1
I '$O(^TMP("ECPRO",$J,0)) D Q:ECOUT
.W !!,"Within the ",ECLN," location there are no procedures defined",!
.W "for the DSS Unit ",ECDN,". Please select another DSS Unit.",!!
.W "Press <RET> to continue " R X:DTIME S ECOUT=2 Q
P1 ;
I '$D(^TMP("ECPRO",$J,2)) S CNT=1 D SETP W !,"Procedure: " D G DIE
. W $S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
. W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
;
NEWP S ECX="",(ECPCNT,CNT,OK)=0,EC1=1 K ECHOICE,ECSTOP
I $G(ECPN)]"" S DIR("B")=ECPN
S DIR("?")="^D PROS^ECED3"
S ECX=$$GETPRO^ECDSUTIL
I +$G(ECX)=-1 D KILLV^ECDSUTIL S ECOUT=1 Q
;
I +$G(ECX),($G(ECPROCED)=$G(ECPN)) D KILLV^ECDSUTIL G DIE
;
P2 ;ask mul proc
I +$G(ECX)=1 D SRCHTM^ECDSUTIL(ECX)
S ECPCNT=+$G(ECPCNT)
I ECPCNT=-1!(ECPCNT=-2) D G NEWP
. D @($S(ECPCNT=-1:"ERRMSG^ECDSUTIL",ECPCNT=-2:"ERRMSG2^ECDSUTIL"))
. D KILLV^ECDSUTIL
I ECPCNT>0 D G DIE
. S CNT=ECPCNT
. D SETP
. S OK=1
. D KILLV^ECDSUTIL
I 'ECPCNT,$D(ECPNAME) S CNT=$$PRLST^ECDSUTIL
I CNT=-1 D MSG^ECEDU,KILLV^ECDSUTIL Q
I CNT>0 D G DIE
. D SETP
. S OK=1
. D KILLV^ECDSUTIL
Q
PROS ;
S X="",CNT=0 K ECHOICE,ECSTOP
LISTP D HDR1^ECEDU S JJ=1 W !,"Available Procedures within "_ECDN_": ",!
W ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
S EC1=1
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)
I X="" D
.W !!?5,"Select by number, CPT or national code, procedure name, or synonym."
.W !?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
.W ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
Q
;
SETP ;set proc info
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)
S ECPTCD="" I ECCPT'="" D
. S ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT) I +ECPTCD>0 S ECPTCD=$P(ECPTCD,U,2)
W " "_$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
S EC4=$P(^TMP("ECPRO",$J,CNT),"^",2),EC4=$P($G(^ECJ(+EC4,"PRO")),"^",4)
S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"")
S ECID=$P($G(^SC(+EC4,0)),"^",7)
S ^TMP("ECLKUP",$J,"LAST")=CNT
Q
DIE ;edit record
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
. Q:ECPO=ECP
. W !,?8,"** Procedure code replaced, all modifiers deleted **"
. S (ECDA,DA(1))=DA,DIK="^ECH("_DA(1)_",""MOD"",",DA=0
. F S DA=$O(^ECH(ECDA,"MOD",DA)) Q:'DA D ^DIK
. K DA S DA=ECDA K ECPO,ECDA,DIK,^ECH(DA,"MOD")
K DIE,DR S DIE("NO^")="OUTOK",DIE="^ECH("
;
S DR=$S($G(ECCPT)'="":"36;",1:"")
S DR=DR_"9;11//"_ECMN
D ^DIE K DR
I $D(DTOUT)!($D(Y)'=0) K DIE S ECOUT=1 Q
;
;- Don't allow future dates for procedure date/time
I +$G(ECPR) S Y=ECPR D DD^%DT
S %DT="EAXR",%DT("A")="DATE/TIME OF PROCEDURE: ",%DT("B")=$S($G(ECPR)&($G(Y)]""):Y,1:""),%DT(0)="-NOW" K Y
D ^%DT K %DT
I $D(DTOUT)!($G(Y)=-1) K DTOUT,Y S ECOUT=1 Q
S DR="2////"_Y,ECNEWDT=Y
D ^DIE K DR,Y
;
;- Get inpatient/outpatient status and file in #721
S ECPTSTAT=$$INOUTPT^ECUTL0(+$G(ECDFN),+$G(ECNEWDT))
I ECPTSTAT="" D INOUTERR^ECUTL0 Q
S DR="29////"_ECPTSTAT
D ^DIE
K DR
;
;- Get associated clinic
I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D Q:+$G(ECOUT)
. S DR=$S(EC4N]"":"26//"_EC4N,1:"26")
. D ^DIE
. K DR
. I $D(DTOUT)!($D(Y)'=0) K DIE S ECOUT=1
;
; - Edit Primary and multiple secondary dx codes
I $P(ECPCE,"~",2)'="N" D DXEDT^ECEDU I ECOUT Q
;
;- Determine patient eligibility
I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D
. I '$$MULTELG^ECUTL0(+$G(ECDFN)) S ECELIG=+$G(VAEL(1))
. E D
.. S ECELCOD=+$P($G(^ECH(DA,"PCE")),"~",17)
.. S ECELDSP=$S(ECELCOD:$P($G(^DIC(8,ECELCOD,0)),"^"),1:"NO ELIGIBILITY ON FILE")
.. S ECELANS=$$ASKIF^ECUTL0(ECELDSP)
.. I (ECELANS<1) D
... I ECELDSP="NO ELIGIBILITY ON FILE" D ELIGERR^ECUTL0
... S ECELIG=$S(ECELDSP="NO ELIGIBILITY ON FILE":+$G(VAEL(1)),1:ECELCOD)
.. I (ECELANS>0) S ECELIG=+$$ELGLST^ECUTL0
K ECELANS,ECELCOD,ECELDSP,VAEL,ECNEWDT,ECDX1
;
;- Display inpatient/outpatient status message
D DSPSTAT^ECUTL0(ECPTSTAT)
;
;- Ask classification questions applicable to patient and file in #721
I $$ASKCLASS^ECUTL1(+$G(ECDFN),.ECCLFLDS,.ECOUT,ECPCE,ECPTSTAT,DA),($O(ECCLFLDS(""))]"") D EDCLASS^ECUTL1(DA,.ECCLFLDS)
Q:+$G(ECOUT)
K ECCLFLDS
;
;- Get provider(s) with active person class
I '$G(ECOUT) D ASKPRV^ECPRVMUT(DA,ECDT,.ECPRVARY,.ECOUT)
I '$G(ECOUT) S ECFIL=$$FILPRV^ECPRVMUT(DA,.ECPRVARY,.ECOUT)
K ECFIL,ECPRVARY,ECPRV,ECPRVN
I $G(ECOUT)!$D(DTOUT) K DIE S ECOUT=1 Q
;
;- File assoc clinic from event code screen if null
I $P($G(^ECH(DA,0)),"^",19)="" D
. I $G(EC4)="" D GETCLN
. S EC4=+$G(EC4)
. I EC4>0 D
.. S DR="26////^S X=EC4"
.. D ^DIE K DR
;
;- Procedure Reason(s)
I $G(ECP)]"" S ECSCR=+$O(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
I ECSCR>0,($P($G(^ECJ(ECSCR,"PRO")),"^",5)=1),(+$O(^ECL("AD",ECSCR,0))) D Q:+$G(ECOUT)
. S DIE="^ECH(",DR="34" D ^DIE K DR,DIE
. I $D(DTOUT)!($D(Y)'=0) K ECSCR S ECOUT=1 Q
;
K DIE,ECSCR S EC(0)=^ECH(+EC(EC),0),ECFN=+EC(0)
S ECZZ=$G(^ECH(ECFN,"P")),ECDX=+$P(ECZZ,"^",2),ECCPT=+$P(ECZZ,"^"),ECINP=$P(EC(0),"^",22) K ECZZ
S EC4=$P(EC(0),"^",19),ECID=$P($G(^SC(+EC4,0)),"^",7),$P(^ECH(ECFN,0),"^",20)=ECID
I $P(ECPCE,"~",2)="N" G SET
I ($P(ECPCE,"~",2)="O")&(ECINP'="O") G SET
D CLIN^ECEDF I 'ECPCL W !!,"You should edit this patient procedure and enter an active clinic.",!!
W !!,"Press <RET> to continue " R X:DTIME
SET ; sets data
S $P(^ECH(DA,0),"^",14)="",$P(^ECH(DA,0),"^",16)="",$P(^ECH(DA,0),"^",18)=""
S $P(^ECH(DA,0),"^",13)=DUZ,ECU=$P(^(0),"^",11) K DA
Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q
D PCEE^ECBEN2U
Q
DEL ; delete existing procedure
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
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
I "Nn"[X Q
S ECCH=$G(^ECH(+EC(EC),0)),ECVST=+$P(ECCH,"^",21) I 'ECVST G DELP
;
;* Prepare all EC records with same Visit file entry to resend to PCE
;* Remove Visit entry from ^ECH( so DELVFILE will complete cleanup
N ECVAR1 S ECVAR1=$$FNDVST^ECUTL(ECVST) K ECVAR1 ;* 2nd Param not sent
;
;- Set VALQUIET to stop Amb Care validator from broadcasting to screen
S VALQUIET=1,ECVV=$$DELVFILE^PXAPI("ALL",ECVST) K ECVST,VALQUIET
DELP S DA=+EC(EC),DIK="^ECH(" W !!,"Deleting Procedure... " D ^DIK K DA,DIK,ECVV
;S ECOUT=99 ;JAM/9/28/01 remove to allow redisplay of screen
W !!,"Press <RET> to continue " R X:DTIME
Q
SELC ; select category
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
I X="" W @IOF,!,$S(EC1:"Available Procedures",1:"Categories")_" within ",ECDN," : ",! Q
I 'EC1,'$D(ECC(X)) D MSGC^ECEDU Q
I EC1,'$D(^TMP("ECPRO",$J,X)) D MSGC^ECEDU Q
S ECHOICE=1
I 'EC1 S ECC=+$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) Q
Q
;
GETCLN ;- Get assoc clinic from event code screen
N ECI
I $G(EC4)="",($G(ECP)]"") D
. S ECI=+$O(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0)),EC4=+$P($G(^ECJ(+ECI,"PRO")),"^",4)
. S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECED3 9288 printed Apr 09, 2024@21:03:01 Page 2
ECED3 ;BIR/MAM,JPW-Enter Event Capture Data (cont'd) ;7 May 96
+1 ;;2.0; EVENT CAPTURE ;**1,4,5,7,10,13,18,23,29,32,47,72**;8 May 96
EDIT ; enter or edit procedure
+1 WRITE !!,"Edit or Delete this Procedure: EDIT// "
READ X:DTIME
IF '$TEST!(X["^")
SET ECOUT=1
QUIT
+2 SET X=$EXTRACT(X)
if X=""
SET X="E"
IF "EeDd"'[X
WRITE !!,"Press <RET> to edit the selected procedure, or enter D to delete",!,"the procedure.",!
GOTO EDIT
+3 IF "Dd"[X
DO DEL
QUIT
+4 DO SETE^ECEDU
ASK ;edit cat
+1 SET (ECFLG,ECOLD,ECOLDN,EC1,OK)=0
+2 IF '$DATA(ECC(1))
GOTO P
+3 IF '$DATA(ECC(2))
GOTO P
+4 WRITE !!,"Category: "_ECCN_"// "
READ X:DTIME
IF '$TEST!(X["^")
SET ECOUT=1
QUIT
+5 IF X=""
GOTO P
+6 IF "?"[X
GOTO NEWC
NEW ; create new procedure
+1 SET MM=""
FOR
SET MM=$ORDER(ECC(MM))
if (MM="")!($DATA(ECHOICE))
QUIT
IF $DATA(ECC(MM))
IF $PIECE(ECC(MM),"^",2)=X
SET ECHOICE=MM
+2 IF $DATA(ECHOICE)
SET ECOLD=ECC
SET ECOLDN=ECCN
SET ECC=+ECC(ECHOICE)
SET ECCN=$PIECE(ECC(ECHOICE),"^",2)
+3 IF $DATA(ECHOICE)
IF ECC=ECOLD
KILL ECOLD,ECOLDN
WRITE !,"CATEGORY: "_ECCN
KILL ECHOICE
GOTO P
+4 IF $DATA(ECHOICE)
GOTO P
NEWC SET X=""
SET (CNT,ECOLD)=0
LIST WRITE !,"Categories within "_ECDN_": ",!
SET EC1=0
FOR I=0:0
SET CNT=$ORDER(ECC(CNT))
if 'CNT!$DATA(ECHOICE)
QUIT
if ($Y+5>IOSL)
DO SELC
if $DATA(ECHOICE)
QUIT
IF X=""
WRITE !,CNT_". ",?5,$PIECE(ECC(CNT),"^",2)
+1 IF '$DATA(ECSTOP)
IF $DATA(ECHOICE)
GOTO P
PICK WRITE !!,"Select Number: "
READ X:DTIME
IF '$TEST!("^"[X)
SET ECOUT=1
QUIT
+1 IF '$DATA(ECC(X))
WRITE !!,"Select the number corresponding to the procedure category, or ^ to quit.",!!,"Press <RET> to continue ",!
READ X:DTIME
KILL ECHOICE,ECSTOP
SET CNT=CNT-5
SET X=""
DO HDR^ECEDU
GOTO LIST
+2 SET ECOLD=ECC
SET ECOLDN=ECCN
SET ECC=$PIECE(ECC(X),"^")
SET ECCN=$PIECE(ECC(X),"^",2)
IF ECC=ECOLD
KILL ECOLD,ECOLDN
P ; get procedure
+1 SET EC1=1
DO PROS^ECHECK1
+2 IF '$ORDER(^TMP("ECPRO",$JOB,0))
Begin DoDot:1
+3 WRITE !!,"Within the ",ECLN," location there are no procedures defined",!
+4 WRITE "for the DSS Unit ",ECDN,". Please select another DSS Unit.",!!
+5 WRITE "Press <RET> to continue "
READ X:DTIME
SET ECOUT=2
QUIT
End DoDot:1
if ECOUT
QUIT
P1 ;
+1 IF '$DATA(^TMP("ECPRO",$JOB,2))
SET CNT=1
DO SETP
WRITE !,"Procedure: "
Begin DoDot:1
+2 WRITE $SELECT(ECCPT="":"",1:ECPTCD_" ")_$EXTRACT(ECPN,1,50)
+3 WRITE $SELECT(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
End DoDot:1
GOTO DIE
+4 ;
NEWP SET ECX=""
SET (ECPCNT,CNT,OK)=0
SET EC1=1
KILL ECHOICE,ECSTOP
+1 IF $GET(ECPN)]""
SET DIR("B")=ECPN
+2 SET DIR("?")="^D PROS^ECED3"
+3 SET ECX=$$GETPRO^ECDSUTIL
+4 IF +$GET(ECX)=-1
DO KILLV^ECDSUTIL
SET ECOUT=1
QUIT
+5 ;
+6 IF +$GET(ECX)
IF ($GET(ECPROCED)=$GET(ECPN))
DO KILLV^ECDSUTIL
GOTO DIE
+7 ;
P2 ;ask mul proc
+1 IF +$GET(ECX)=1
DO SRCHTM^ECDSUTIL(ECX)
+2 SET ECPCNT=+$GET(ECPCNT)
+3 IF ECPCNT=-1!(ECPCNT=-2)
Begin DoDot:1
+4 DO @($SELECT(ECPCNT=-1:"ERRMSG^ECDSUTIL",ECPCNT=-2:"ERRMSG2^ECDSUTIL"))
+5 DO KILLV^ECDSUTIL
End DoDot:1
GOTO NEWP
+6 IF ECPCNT>0
Begin DoDot:1
+7 SET CNT=ECPCNT
+8 DO SETP
+9 SET OK=1
+10 DO KILLV^ECDSUTIL
End DoDot:1
GOTO DIE
+11 IF 'ECPCNT
IF $DATA(ECPNAME)
SET CNT=$$PRLST^ECDSUTIL
+12 IF CNT=-1
DO MSG^ECEDU
DO KILLV^ECDSUTIL
QUIT
+13 IF CNT>0
Begin DoDot:1
+14 DO SETP
+15 SET OK=1
+16 DO KILLV^ECDSUTIL
End DoDot:1
GOTO DIE
+17 QUIT
PROS ;
+1 SET X=""
SET CNT=0
KILL ECHOICE,ECSTOP
LISTP DO HDR1^ECEDU
SET JJ=1
WRITE !,"Available Procedures within "_ECDN_": ",!
+1 WRITE ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
+2 SET EC1=1
+3 FOR
SET CNT=$ORDER(^TMP("ECPRO",$JOB,CNT))
if 'CNT!$DATA(ECHOICE)
QUIT
if ($Y+5>IOSL)
DO SELC
if $DATA(ECHOICE)
QUIT
IF X=""
WRITE !,CNT_".",?5,$EXTRACT($PIECE(^TMP("ECPRO",$JOB,CNT),"^",4),1,30),?38,$EXTRACT($PIECE(^(CNT),"^",3),1,30),?72,$PIECE(^(CNT),"^",5)
+4 IF X=""
Begin DoDot:1
+5 WRITE !!?5,"Select by number, CPT or national code, procedure name, or synonym."
+6 WRITE !?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
+7 WRITE ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
End DoDot:1
+8 QUIT
+9 ;
SETP ;set proc info
+1 SET ECP=$PIECE(^TMP("ECPRO",$JOB,CNT),"^")
SET ECPN=$PIECE(^(CNT),"^",4)
SET NATN=$PIECE(^(CNT),"^",5)
SET SYN=$PIECE(^(CNT),"^",3)
SET ECCPT=$SELECT(ECP["EC":$PIECE($GET(^EC(725,+ECP,0)),"^",5),1:+ECP)
+2 SET ECPTCD=""
IF ECCPT'=""
Begin DoDot:1
+3 SET ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT)
IF +ECPTCD>0
SET ECPTCD=$PIECE(ECPTCD,U,2)
End DoDot:1
+4 WRITE " "_$SELECT(ECCPT="":"",1:ECPTCD_" ")_$EXTRACT(ECPN,1,50)
+5 WRITE $SELECT(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
+6 SET EC4=$PIECE(^TMP("ECPRO",$JOB,CNT),"^",2)
SET EC4=$PIECE($GET(^ECJ(+EC4,"PRO")),"^",4)
+7 SET EC4N=$SELECT($PIECE($GET(^SC(+EC4,0)),"^")]"":$PIECE(^(0),"^"),1:"")
+8 SET ECID=$PIECE($GET(^SC(+EC4,0)),"^",7)
+9 SET ^TMP("ECLKUP",$JOB,"LAST")=CNT
+10 QUIT
DIE ;edit record
+1 IF $DATA(^ECH(DA,0))
SET ECPO=$PIECE(^(0),"^",9)
SET $PIECE(^(0),"^",8)=+ECC
SET $PIECE(^(0),"^",9)=ECP
SET ECINP=$PIECE(^(0),"^",22)
SET ECCPT=$SELECT(ECP["EC":$PIECE($GET(^EC(725,+ECP,0)),"^",5),1:+ECP)
SET $PIECE(^ECH(DA,"P"),"^")=ECCPT
SET ECPR=$PIECE(^(0),"^",3)
SET ECFN=DA
SET ECDX1=$PIECE($GET(^ECH(DA,"P")),U,2)
Begin DoDot:1
+2 if ECPO=ECP
QUIT
+3 WRITE !,?8,"** Procedure code replaced, all modifiers deleted **"
+4 SET (ECDA,DA(1))=DA
SET DIK="^ECH("_DA(1)_",""MOD"","
SET DA=0
+5 FOR
SET DA=$ORDER(^ECH(ECDA,"MOD",DA))
if 'DA
QUIT
DO ^DIK
+6 KILL DA
SET DA=ECDA
KILL ECPO,ECDA,DIK,^ECH(DA,"MOD")
End DoDot:1
+7 KILL DIE,DR
SET DIE("NO^")="OUTOK"
SET DIE="^ECH("
+8 ;
+9 SET DR=$SELECT($GET(ECCPT)'="":"36;",1:"")
+10 SET DR=DR_"9;11//"_ECMN
+11 DO ^DIE
KILL DR
+12 IF $DATA(DTOUT)!($DATA(Y)'=0)
KILL DIE
SET ECOUT=1
QUIT
+13 ;
+14 ;- Don't allow future dates for procedure date/time
+15 IF +$GET(ECPR)
SET Y=ECPR
DO DD^%DT
+16 SET %DT="EAXR"
SET %DT("A")="DATE/TIME OF PROCEDURE: "
SET %DT("B")=$SELECT($GET(ECPR)&($GET(Y)]""):Y,1:"")
SET %DT(0)="-NOW"
KILL Y
+17 DO ^%DT
KILL %DT
+18 IF $DATA(DTOUT)!($GET(Y)=-1)
KILL DTOUT,Y
SET ECOUT=1
QUIT
+19 SET DR="2////"_Y
SET ECNEWDT=Y
+20 DO ^DIE
KILL DR,Y
+21 ;
+22 ;- Get inpatient/outpatient status and file in #721
+23 SET ECPTSTAT=$$INOUTPT^ECUTL0(+$GET(ECDFN),+$GET(ECNEWDT))
+24 IF ECPTSTAT=""
DO INOUTERR^ECUTL0
QUIT
+25 SET DR="29////"_ECPTSTAT
+26 DO ^DIE
+27 KILL DR
+28 ;
+29 ;- Get associated clinic
+30 IF $$CHKDSS^ECUTL0(+$GET(ECD),ECPTSTAT)
Begin DoDot:1
+31 SET DR=$SELECT(EC4N]"":"26//"_EC4N,1:"26")
+32 DO ^DIE
+33 KILL DR
+34 IF $DATA(DTOUT)!($DATA(Y)'=0)
KILL DIE
SET ECOUT=1
End DoDot:1
if +$GET(ECOUT)
QUIT
+35 ;
+36 ; - Edit Primary and multiple secondary dx codes
+37 IF $PIECE(ECPCE,"~",2)'="N"
DO DXEDT^ECEDU
IF ECOUT
QUIT
+38 ;
+39 ;- Determine patient eligibility
+40 IF $$CHKDSS^ECUTL0(+$GET(ECD),ECPTSTAT)
Begin DoDot:1
+41 IF '$$MULTELG^ECUTL0(+$GET(ECDFN))
SET ECELIG=+$GET(VAEL(1))
+42 IF '$TEST
Begin DoDot:2
+43 SET ECELCOD=+$PIECE($GET(^ECH(DA,"PCE")),"~",17)
+44 SET ECELDSP=$SELECT(ECELCOD:$PIECE($GET(^DIC(8,ECELCOD,0)),"^"),1:"NO ELIGIBILITY ON FILE")
+45 SET ECELANS=$$ASKIF^ECUTL0(ECELDSP)
+46 IF (ECELANS<1)
Begin DoDot:3
+47 IF ECELDSP="NO ELIGIBILITY ON FILE"
DO ELIGERR^ECUTL0
+48 SET ECELIG=$SELECT(ECELDSP="NO ELIGIBILITY ON FILE":+$GET(VAEL(1)),1:ECELCOD)
End DoDot:3
+49 IF (ECELANS>0)
SET ECELIG=+$$ELGLST^ECUTL0
End DoDot:2
End DoDot:1
+50 KILL ECELANS,ECELCOD,ECELDSP,VAEL,ECNEWDT,ECDX1
+51 ;
+52 ;- Display inpatient/outpatient status message
+53 DO DSPSTAT^ECUTL0(ECPTSTAT)
+54 ;
+55 ;- Ask classification questions applicable to patient and file in #721
+56 IF $$ASKCLASS^ECUTL1(+$GET(ECDFN),.ECCLFLDS,.ECOUT,ECPCE,ECPTSTAT,DA)
IF ($ORDER(ECCLFLDS(""))]"")
DO EDCLASS^ECUTL1(DA,.ECCLFLDS)
+57 if +$GET(ECOUT)
QUIT
+58 KILL ECCLFLDS
+59 ;
+60 ;- Get provider(s) with active person class
+61 IF '$GET(ECOUT)
DO ASKPRV^ECPRVMUT(DA,ECDT,.ECPRVARY,.ECOUT)
+62 IF '$GET(ECOUT)
SET ECFIL=$$FILPRV^ECPRVMUT(DA,.ECPRVARY,.ECOUT)
+63 KILL ECFIL,ECPRVARY,ECPRV,ECPRVN
+64 IF $GET(ECOUT)!$DATA(DTOUT)
KILL DIE
SET ECOUT=1
QUIT
+65 ;
+66 ;- File assoc clinic from event code screen if null
+67 IF $PIECE($GET(^ECH(DA,0)),"^",19)=""
Begin DoDot:1
+68 IF $GET(EC4)=""
DO GETCLN
+69 SET EC4=+$GET(EC4)
+70 IF EC4>0
Begin DoDot:2
+71 SET DR="26////^S X=EC4"
+72 DO ^DIE
KILL DR
End DoDot:2
End DoDot:1
+73 ;
+74 ;- Procedure Reason(s)
+75 IF $GET(ECP)]""
SET ECSCR=+$ORDER(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
+76 IF ECSCR>0
IF ($PIECE($GET(^ECJ(ECSCR,"PRO")),"^",5)=1)
IF (+$ORDER(^ECL("AD",ECSCR,0)))
Begin DoDot:1
+77 SET DIE="^ECH("
SET DR="34"
DO ^DIE
KILL DR,DIE
+78 IF $DATA(DTOUT)!($DATA(Y)'=0)
KILL ECSCR
SET ECOUT=1
QUIT
End DoDot:1
if +$GET(ECOUT)
QUIT
+79 ;
+80 KILL DIE,ECSCR
SET EC(0)=^ECH(+EC(EC),0)
SET ECFN=+EC(0)
+81 SET ECZZ=$GET(^ECH(ECFN,"P"))
SET ECDX=+$PIECE(ECZZ,"^",2)
SET ECCPT=+$PIECE(ECZZ,"^")
SET ECINP=$PIECE(EC(0),"^",22)
KILL ECZZ
+82 SET EC4=$PIECE(EC(0),"^",19)
SET ECID=$PIECE($GET(^SC(+EC4,0)),"^",7)
SET $PIECE(^ECH(ECFN,0),"^",20)=ECID
+83 IF $PIECE(ECPCE,"~",2)="N"
GOTO SET
+84 IF ($PIECE(ECPCE,"~",2)="O")&(ECINP'="O")
GOTO SET
+85 DO CLIN^ECEDF
IF 'ECPCL
WRITE !!,"You should edit this patient procedure and enter an active clinic.",!!
+86 WRITE !!,"Press <RET> to continue "
READ X:DTIME
SET ; sets data
+1 SET $PIECE(^ECH(DA,0),"^",14)=""
SET $PIECE(^ECH(DA,0),"^",16)=""
SET $PIECE(^ECH(DA,0),"^",18)=""
+2 SET $PIECE(^ECH(DA,0),"^",13)=DUZ
SET ECU=$PIECE(^(0),"^",11)
KILL DA
+3 if $PIECE(ECPCE,"~",2)="N"
QUIT
IF $PIECE(ECPCE,"~",2)="O"&(ECINP'="O")
QUIT
+4 DO PCEE^ECBEN2U
+5 QUIT
DEL ; delete existing procedure
+1 WRITE !!,"Are you sure that you want to delete this entire procedure from",!,"your records ? NO// "
READ X:DTIME
IF '$TEST!(X["^")
SET ECOUT=1
QUIT
+2 SET X=$EXTRACT(X)
if X=""
SET X="N"
IF "NnYy"'[X
WRITE !!,"Enter YES to delete this procedure, or <RET> to quit this option."
GOTO DEL
+3 IF "Nn"[X
QUIT
+4 SET ECCH=$GET(^ECH(+EC(EC),0))
SET ECVST=+$PIECE(ECCH,"^",21)
IF 'ECVST
GOTO DELP
+5 ;
+6 ;* Prepare all EC records with same Visit file entry to resend to PCE
+7 ;* Remove Visit entry from ^ECH( so DELVFILE will complete cleanup
+8 ;* 2nd Param not sent
NEW ECVAR1
SET ECVAR1=$$FNDVST^ECUTL(ECVST)
KILL ECVAR1
+9 ;
+10 ;- Set VALQUIET to stop Amb Care validator from broadcasting to screen
+11 SET VALQUIET=1
SET ECVV=$$DELVFILE^PXAPI("ALL",ECVST)
KILL ECVST,VALQUIET
DELP SET DA=+EC(EC)
SET DIK="^ECH("
WRITE !!,"Deleting Procedure... "
DO ^DIK
KILL DA,DIK,ECVV
+1 ;S ECOUT=99 ;JAM/9/28/01 remove to allow redisplay of screen
+2 WRITE !!,"Press <RET> to continue "
READ X:DTIME
+3 QUIT
SELC ; select category
+1 WRITE !!,$SELECT(EC1:"Press",1:"Select Number, or press")_" <RET> to continue listing "_$SELECT(EC1:"procedures",1:"categories")_" or '^' to stop: "
READ X:DTIME
IF '$TEST!(X="^")
SET (ECSTOP,ECHOICE)=1
QUIT
+2 IF X=""
WRITE @IOF,!,$SELECT(EC1:"Available Procedures",1:"Categories")_" within ",ECDN," : ",!
QUIT
+3 IF 'EC1
IF '$DATA(ECC(X))
DO MSGC^ECEDU
QUIT
+4 IF EC1
IF '$DATA(^TMP("ECPRO",$JOB,X))
DO MSGC^ECEDU
QUIT
+5 SET ECHOICE=1
+6 IF 'EC1
SET ECC=+$PIECE(ECC(X),"^")
SET ECCN=$PIECE(ECC(X),"^",2)
QUIT
+7 QUIT
+8 ;
GETCLN ;- Get assoc clinic from event code screen
+1 NEW ECI
+2 IF $GET(EC4)=""
IF ($GET(ECP)]"")
Begin DoDot:1
+3 SET ECI=+$ORDER(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
SET EC4=+$PIECE($GET(^ECJ(+ECI,"PRO")),"^",4)
+4 SET EC4N=$SELECT($PIECE($GET(^SC(+EC4,0)),"^")]"":$PIECE(^(0),"^"),1:"")
End DoDot:1
+5 QUIT
