- 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 Feb 18, 2025@23:23:46 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