ECEDF ;BIR/MAM,JPW-Enter Event Capture Data (cont'd) ;6 Mar 96
;;2.0; EVENT CAPTURE ;**4,5,10,13,18,23,33,72**;8 May 96
FILE ;file proc
L +^ECH(0) S ECRN=$P(^ECH(0),"^",3)+1 I $D(^ECH(ECRN)) S $P(^ECH(0),"^",3)=$P(^(0),"^",3)+1 L -^ECH(0) G FILE
L -^ECH(0) K DA,DD,DO,DIC S DIC(0)="L",DIC="^ECH(",X=ECRN D FILE^DICN K DIC S ECFN=+Y
;Ask and file CPT modifiers, ALB/JAM
S ECCPT=$S(ECP["ICPT":+ECP,1:$P($G(^EC(725,+ECP,0)),U,5)) I ECCPT D
. S ECMODS=$G(ECMODS)
. S ECMODF=$$ASKMOD^ECUTL(ECCPT,ECMODS,ECDT,.ECMOD,.ECERR)
. S:$G(ECERR) ECOUT=1 K ECMODF,ECMODS I ECOUT Q
. S MOD="" F S MOD=$O(ECMOD(ECCPT,MOD)) Q:MOD="" D
. . S MODIEN=$P(ECMOD(ECCPT,MOD),U,2) I MODIEN<0 Q
. . K DIC,DD,DO S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,36,0),U,2)
. . S X=MODIEN,DIC="^ECH("_DA(1)_","_"""MOD"""_"," D FILE^DICN
. K MOD,MODIEN,DIC,ECMOD
I $G(ECOUT) K ECMODS,ECMOD,ECERR D RECDEL,MSG Q
S DIR("A")="Volume",DIR("B")=ECVOL,DIR(0)="N^^K:(X<1)!(X>99) X"
S DIR("?")="Type a Number between 1 and 99, 0 Decimal Digits"
D ^DIR I $D(DIRUT) K DIR D RECDEL,MSG Q
S ECVOL=+Y,ECNULL="" K DIR
K DA,DR,DIE S DIE("NO^")="OUTOK",DIE="^ECH(",DA=ECFN
S DR="1////"_ECDFN_";3////"_ECL_";4////"_ECS_";5////"_ECM_";6////"_ECD_";7////"_+ECC_";9////"_ECVOL_";Q;8////"_ECNULL D ^DIE K DR
I $D(DTOUT)!($D(Y)'=0) K DIE D RECDEL,MSG Q
;
;- Default to previous ordering section if >1 procedure entered
S ECODFN=+$G(ECODFN)
S ECMN=$S((ECODFN=ECDFN)&(+$G(ECOM)):$P($G(^ECC(723,ECOM,0)),"^"),1:$P($G(^ECC(723,ECM,0)),"^"))
;
;- Get ordering section, and Procedure Date/Time
S DR="11//"_ECMN_";2////"_ECDT
D ^DIE K DR
I $D(DTOUT)!($D(Y)'=0)!($P(^ECH(ECFN,0),"^",3)="") K DIE D RECDEL,MSG Q
;
;- Get associated clinic
I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D I +$G(ECOUT) D RECDEL,MSG Q
. S DR=$S(EC4N]"":"26//"_EC4N,1:"26")
. D ^DIE S EC4=X K DR
. I $D(DTOUT)!($D(Y)'=0) K DIE S ECOUT=1
;
; Get primary and multiple secondary diagnosis codes, ALB/JAM
I $P(ECPCE,"~",2)'="N" D I ECOUT D RECDEL,MSG Q
. D DIAG^ECUTL2 I ECOUT Q
. S DA=ECFN,DR=$S(ECDX]"":"20////"_ECDX,1:20) D ^DIE S ECDXY=X K DR
. S DXS="" F S DXS=$O(ECDXS(DXS)) Q:DXS="" D
. . S DXSIEN=$P(ECDXS(DXS),U) I DXSIEN<0 Q
. . K DIC,DD,DO S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,38,0),U,2)
. . S X=DXSIEN,DIC="^ECH("_DA(1)_","_"""DX"""_"," D FILE^DICN
. K ECDXX M ECDXX=ECDXS K DXS,DXSIEN,DIC,ECDXS
. ; Update all procedures for an encounter with same primary & second dx
. S PXUPD=$$PXUPD^ECUTL2(ECDFN,ECDT,ECL,EC4,ECDXY,.ECDXX,ECFN)
. K PXUPD,ECDXY,ECDXX
S DA=ECFN
;
;- Determine patient eligibility
I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D
. I $$MULTELG^ECUTL0(+$G(ECDFN)) S ECELIG=+$$ELGLST^ECUTL0
. E S ECELIG=+$G(VAEL(1))
K VAEL
;
;- File inpatient/outpatient status
S DR="29////"_ECPTSTAT
D ^DIE K DR
;
;- Ask classification questions applicable to patient and file in #721
I $$ASKCLASS^ECUTL1(+$G(ECDFN),.ECCLFLDS,.ECOUT,ECPCE,ECPTSTAT),($O(ECCLFLDS(""))]"") D EDCLASS^ECUTL1(ECFN,.ECCLFLDS)
I +$G(ECOUT) K DIE D RECDEL,MSG Q
K ECCLFLDS
;
;;get provider(s) with active person class
D ASKPRV^ECPRVMUT(ECFN,ECDT,.ECPRVARY,.ECOUT)
I +$G(ECOUT) K DIE D RECDEL,MSG Q
S ECFIL=$$FILPRV^ECPRVMUT(ECFN,.ECPRVARY,.ECOUT)
K ECFIL,ECPRVARY,ECPRV,ECPRVN
I +$G(ECOUT) K DIE D RECDEL,MSG Q
;
;- File assoc clinic from event code screen if null
I $P($G(^ECH(ECFN,0)),"^",19)="" D
. I $G(EC4)="" D GETCLN
. S EC4=+$G(EC4)
. I EC4>0 D
.. S DA=ECFN,DR="26////^S X=EC4"
.. D ^DIE K DA,DR,DIE
;
K DA,DR,DIE,ECNULL
;
;- Set vars and default to prev ordering section if >1 proc entered
S EC4=$P(^ECH(ECFN,0),"^",19),ECINP=$P(^(0),"^",22),ECOM=$P(^(0),"^",12),ECID=$P($G(^SC(+EC4,0)),"^",7),ECODFN=ECDFN
;
I $P(ECPCE,"~",2)="N" G FILE2
I ($P(ECPCE,"~",2)="O")&(ECINP'="O") G FILE2
D CLIN I 'ECPCL W !!,"You should edit this patient procedure and enter an active clinic." W:'$D(ECIOFLG) !!,"Press <RET> to continue " R X:DTIME
FILE2 ;continue
S $P(^ECH(ECFN,0),"^",13)=DUZ,$P(^(0),"^",9)=ECP,$P(^(0),"^",20)=ECID,ECINP=$P(^(0),"^",22),ECDX=+$P($G(^("P")),"^",2)
S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
S $P(^ECH(ECFN,"P"),"^")=ECCPT
;
;- 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(",DA=ECFN,DR="34" D ^DIE K DA,DR,DIE
. I $D(DTOUT)!($D(Y)'=0) K ECSCR D RECDEL,MSG Q
K ECSCR
;
PCE ; format PCE data to send
Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q
D PCE^ECBEN2U
Q
MSG ;
W !!,"All information was not entered. This procedure has been deleted.",!!,"Press <RET> to continue " R X:DTIME S ECOUT=1
Q
CLIN ;check for active associated clinic
S MSG1=1,MSG2=0
I 'EC4 S MSG2=1
D CLIN^ECPCEU
I 'ECPCL D
.W !!,"The clinic ",$S(MSG1:"associated with",1:"you selected for")," this procedure ",$S(MSG2:"has not been entered",1:"is inactive"),"."
.W !,"Workload data cannot be sent to PCE for this procedure with ",!,$S(MSG2:"a missing",1:"an inactive")," clinic."
S (MSG1,MSG2)=0
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
;
RECDEL ; Delete record
;
N DA,DIK
S DA=ECFN,DIK="^ECH(" D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECEDF 5495 printed Apr 09, 2024@21:00:35 Page 2
ECEDF ;BIR/MAM,JPW-Enter Event Capture Data (cont'd) ;6 Mar 96
+1 ;;2.0; EVENT CAPTURE ;**4,5,10,13,18,23,33,72**;8 May 96
FILE ;file proc
+1 LOCK +^ECH(0)
SET ECRN=$PIECE(^ECH(0),"^",3)+1
IF $DATA(^ECH(ECRN))
SET $PIECE(^ECH(0),"^",3)=$PIECE(^(0),"^",3)+1
LOCK -^ECH(0)
GOTO FILE
+2 LOCK -^ECH(0)
KILL DA,DD,DO,DIC
SET DIC(0)="L"
SET DIC="^ECH("
SET X=ECRN
DO FILE^DICN
KILL DIC
SET ECFN=+Y
+3 ;Ask and file CPT modifiers, ALB/JAM
+4 SET ECCPT=$SELECT(ECP["ICPT":+ECP,1:$PIECE($GET(^EC(725,+ECP,0)),U,5))
IF ECCPT
Begin DoDot:1
+5 SET ECMODS=$GET(ECMODS)
+6 SET ECMODF=$$ASKMOD^ECUTL(ECCPT,ECMODS,ECDT,.ECMOD,.ECERR)
+7 if $GET(ECERR)
SET ECOUT=1
KILL ECMODF,ECMODS
IF ECOUT
QUIT
+8 SET MOD=""
FOR
SET MOD=$ORDER(ECMOD(ECCPT,MOD))
if MOD=""
QUIT
Begin DoDot:2
+9 SET MODIEN=$PIECE(ECMOD(ECCPT,MOD),U,2)
IF MODIEN<0
QUIT
+10 KILL DIC,DD,DO
SET DIC(0)="L"
SET DA(1)=ECFN
SET DIC("P")=$PIECE(^DD(721,36,0),U,2)
+11 SET X=MODIEN
SET DIC="^ECH("_DA(1)_","_"""MOD"""_","
DO FILE^DICN
End DoDot:2
+12 KILL MOD,MODIEN,DIC,ECMOD
End DoDot:1
+13 IF $GET(ECOUT)
KILL ECMODS,ECMOD,ECERR
DO RECDEL
DO MSG
QUIT
+14 SET DIR("A")="Volume"
SET DIR("B")=ECVOL
SET DIR(0)="N^^K:(X<1)!(X>99) X"
+15 SET DIR("?")="Type a Number between 1 and 99, 0 Decimal Digits"
+16 DO ^DIR
IF $DATA(DIRUT)
KILL DIR
DO RECDEL
DO MSG
QUIT
+17 SET ECVOL=+Y
SET ECNULL=""
KILL DIR
+18 KILL DA,DR,DIE
SET DIE("NO^")="OUTOK"
SET DIE="^ECH("
SET DA=ECFN
+19 SET DR="1////"_ECDFN_";3////"_ECL_";4////"_ECS_";5////"_ECM_";6////"_ECD_";7////"_+ECC_";9////"_ECVOL_";Q;8////"_ECNULL
DO ^DIE
KILL DR
+20 IF $DATA(DTOUT)!($DATA(Y)'=0)
KILL DIE
DO RECDEL
DO MSG
QUIT
+21 ;
+22 ;- Default to previous ordering section if >1 procedure entered
+23 SET ECODFN=+$GET(ECODFN)
+24 SET ECMN=$SELECT((ECODFN=ECDFN)&(+$GET(ECOM)):$PIECE($GET(^ECC(723,ECOM,0)),"^"),1:$PIECE($GET(^ECC(723,ECM,0)),"^"))
+25 ;
+26 ;- Get ordering section, and Procedure Date/Time
+27 SET DR="11//"_ECMN_";2////"_ECDT
+28 DO ^DIE
KILL DR
+29 IF $DATA(DTOUT)!($DATA(Y)'=0)!($PIECE(^ECH(ECFN,0),"^",3)="")
KILL DIE
DO RECDEL
DO MSG
QUIT
+30 ;
+31 ;- Get associated clinic
+32 IF $$CHKDSS^ECUTL0(+$GET(ECD),ECPTSTAT)
Begin DoDot:1
+33 SET DR=$SELECT(EC4N]"":"26//"_EC4N,1:"26")
+34 DO ^DIE
SET EC4=X
KILL DR
+35 IF $DATA(DTOUT)!($DATA(Y)'=0)
KILL DIE
SET ECOUT=1
End DoDot:1
IF +$GET(ECOUT)
DO RECDEL
DO MSG
QUIT
+36 ;
+37 ; Get primary and multiple secondary diagnosis codes, ALB/JAM
+38 IF $PIECE(ECPCE,"~",2)'="N"
Begin DoDot:1
+39 DO DIAG^ECUTL2
IF ECOUT
QUIT
+40 SET DA=ECFN
SET DR=$SELECT(ECDX]"":"20////"_ECDX,1:20)
DO ^DIE
SET ECDXY=X
KILL DR
+41 SET DXS=""
FOR
SET DXS=$ORDER(ECDXS(DXS))
if DXS=""
QUIT
Begin DoDot:2
+42 SET DXSIEN=$PIECE(ECDXS(DXS),U)
IF DXSIEN<0
QUIT
+43 KILL DIC,DD,DO
SET DIC(0)="L"
SET DA(1)=ECFN
SET DIC("P")=$PIECE(^DD(721,38,0),U,2)
+44 SET X=DXSIEN
SET DIC="^ECH("_DA(1)_","_"""DX"""_","
DO FILE^DICN
End DoDot:2
+45 KILL ECDXX
MERGE ECDXX=ECDXS
KILL DXS,DXSIEN,DIC,ECDXS
+46 ; Update all procedures for an encounter with same primary & second dx
+47 SET PXUPD=$$PXUPD^ECUTL2(ECDFN,ECDT,ECL,EC4,ECDXY,.ECDXX,ECFN)
+48 KILL PXUPD,ECDXY,ECDXX
End DoDot:1
IF ECOUT
DO RECDEL
DO MSG
QUIT
+49 SET DA=ECFN
+50 ;
+51 ;- Determine patient eligibility
+52 IF $$CHKDSS^ECUTL0(+$GET(ECD),ECPTSTAT)
Begin DoDot:1
+53 IF $$MULTELG^ECUTL0(+$GET(ECDFN))
SET ECELIG=+$$ELGLST^ECUTL0
+54 IF '$TEST
SET ECELIG=+$GET(VAEL(1))
End DoDot:1
+55 KILL VAEL
+56 ;
+57 ;- File inpatient/outpatient status
+58 SET DR="29////"_ECPTSTAT
+59 DO ^DIE
KILL DR
+60 ;
+61 ;- Ask classification questions applicable to patient and file in #721
+62 IF $$ASKCLASS^ECUTL1(+$GET(ECDFN),.ECCLFLDS,.ECOUT,ECPCE,ECPTSTAT)
IF ($ORDER(ECCLFLDS(""))]"")
DO EDCLASS^ECUTL1(ECFN,.ECCLFLDS)
+63 IF +$GET(ECOUT)
KILL DIE
DO RECDEL
DO MSG
QUIT
+64 KILL ECCLFLDS
+65 ;
+66 ;;get provider(s) with active person class
+67 DO ASKPRV^ECPRVMUT(ECFN,ECDT,.ECPRVARY,.ECOUT)
+68 IF +$GET(ECOUT)
KILL DIE
DO RECDEL
DO MSG
QUIT
+69 SET ECFIL=$$FILPRV^ECPRVMUT(ECFN,.ECPRVARY,.ECOUT)
+70 KILL ECFIL,ECPRVARY,ECPRV,ECPRVN
+71 IF +$GET(ECOUT)
KILL DIE
DO RECDEL
DO MSG
QUIT
+72 ;
+73 ;- File assoc clinic from event code screen if null
+74 IF $PIECE($GET(^ECH(ECFN,0)),"^",19)=""
Begin DoDot:1
+75 IF $GET(EC4)=""
DO GETCLN
+76 SET EC4=+$GET(EC4)
+77 IF EC4>0
Begin DoDot:2
+78 SET DA=ECFN
SET DR="26////^S X=EC4"
+79 DO ^DIE
KILL DA,DR,DIE
End DoDot:2
End DoDot:1
+80 ;
+81 KILL DA,DR,DIE,ECNULL
+82 ;
+83 ;- Set vars and default to prev ordering section if >1 proc entered
+84 SET EC4=$PIECE(^ECH(ECFN,0),"^",19)
SET ECINP=$PIECE(^(0),"^",22)
SET ECOM=$PIECE(^(0),"^",12)
SET ECID=$PIECE($GET(^SC(+EC4,0)),"^",7)
SET ECODFN=ECDFN
+85 ;
+86 IF $PIECE(ECPCE,"~",2)="N"
GOTO FILE2
+87 IF ($PIECE(ECPCE,"~",2)="O")&(ECINP'="O")
GOTO FILE2
+88 DO CLIN
IF 'ECPCL
WRITE !!,"You should edit this patient procedure and enter an active clinic."
if '$DATA(ECIOFLG)
WRITE !!,"Press <RET> to continue "
READ X:DTIME
FILE2 ;continue
+1 SET $PIECE(^ECH(ECFN,0),"^",13)=DUZ
SET $PIECE(^(0),"^",9)=ECP
SET $PIECE(^(0),"^",20)=ECID
SET ECINP=$PIECE(^(0),"^",22)
SET ECDX=+$PIECE($GET(^("P")),"^",2)
+2 SET ECCPT=$SELECT(ECP["EC":$PIECE($GET(^EC(725,+ECP,0)),"^",5),1:+ECP)
+3 SET $PIECE(^ECH(ECFN,"P"),"^")=ECCPT
+4 ;
+5 ;- Procedure Reason(s)
+6 IF $GET(ECP)]""
SET ECSCR=+$ORDER(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
+7 IF ECSCR>0
IF ($PIECE($GET(^ECJ(ECSCR,"PRO")),"^",5)=1)
IF (+$ORDER(^ECL("AD",ECSCR,0)))
Begin DoDot:1
+8 SET DIE="^ECH("
SET DA=ECFN
SET DR="34"
DO ^DIE
KILL DA,DR,DIE
+9 IF $DATA(DTOUT)!($DATA(Y)'=0)
KILL ECSCR
DO RECDEL
DO MSG
QUIT
End DoDot:1
if +$GET(ECOUT)
QUIT
+10 KILL ECSCR
+11 ;
PCE ; format PCE data to send
+1 if $PIECE(ECPCE,"~",2)="N"
QUIT
IF $PIECE(ECPCE,"~",2)="O"&(ECINP'="O")
QUIT
+2 DO PCE^ECBEN2U
+3 QUIT
MSG ;
+1 WRITE !!,"All information was not entered. This procedure has been deleted.",!!,"Press <RET> to continue "
READ X:DTIME
SET ECOUT=1
+2 QUIT
CLIN ;check for active associated clinic
+1 SET MSG1=1
SET MSG2=0
+2 IF 'EC4
SET MSG2=1
+3 DO CLIN^ECPCEU
+4 IF 'ECPCL
Begin DoDot:1
+5 WRITE !!,"The clinic ",$SELECT(MSG1:"associated with",1:"you selected for")," this procedure ",$SELECT(MSG2:"has not been entered",1:"is inactive"),"."
+6 WRITE !,"Workload data cannot be sent to PCE for this procedure with ",!,$SELECT(MSG2:"a missing",1:"an inactive")," clinic."
End DoDot:1
+7 SET (MSG1,MSG2)=0
+8 QUIT
+9 ;
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
+6 ;
RECDEL ; Delete record
+1 ;
+2 NEW DA,DIK
+3 SET DA=ECFN
SET DIK="^ECH("
DO ^DIK
+4 QUIT
