- ECBEN2U ;BIR/MAM,JPW-Categories and Procedures Selection ;2/16/18 16:40
- ;;2.0;EVENT CAPTURE;**4,5,7,10,17,18,23,42,47,54,72,95,76,139**;8 May 96;Build 7
- END Q
- HDR ;screen header
- W @IOF,!,"Location: ",ECLN
- W !,"DSS Unit: ",$E(ECDN,1,30) I $G(ECCN)]"" W ?48,"Category: ",$E(ECCN,1,20)
- W !,"Ordering Section: ",ECON
- W !,"Procedure Date: ",ECDATE,!
- D DSP1416^ECPRVMUT(.ECPRVARY)
- W !
- Q
- MSG W !!,"No procedures entered. No Action Taken.",!!,"Press <RET> to continue " R X:DTIME S ECOUT=1
- Q
- MSG1 ;
- W !!,"Please enter the number that corresponds to the "_$S(OK:"procedure",1:"category")_" from which",!,"you would like to select a procedure. If you would like to continue",!,"with the list, press <RET>. Enter ^ to quit."
- S CNT=CNT-5
- Q
- HDRP ;hdr batch by proc
- W @IOF,!,"Location: ",ECLN
- I $G(ECCN)]"" W !,"Category: ",ECCN
- W !,"Procedure Date: ",ECDATE
- D DSP1442^ECPRVMUT(.ECPRVARY)
- W !
- Q
- PCEQST ;entry pt for PCE questions
- S (ECDX,ECDXN,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV,ECSHAD)=""
- INP ;- Set inpatient/outpatient status
- S ECINP=$G(ECPTSTAT)
- D CLINIC I ECOUT Q
- ;ask dx
- D DIAG^ECUTL2 I ECOUT Q
- I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q
- D VISIT
- Q
- CLINIC ;display default clinic
- Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q
- K DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT S DIR(0)="721,26",DIR("A")="Associated Clinic",DIR("?")="An active clinic is required. Enter an active clinic or an ^ to exit"
- I EC4,EC4N'["NO ASSOCIATED CLINIC" S DIR("B")=EC4N
- D ^DIR K DIR
- I Y S EC4=+Y,ECID=$P($G(^SC(+EC4,0)),"^",7)
- I $D(DTOUT)!$D(DUOUT) S ECOUT=1 Q
- I +EC4,'$G(ECOUT) D CLIN I 'ECPCL W !!,"You must enter an active clinic now.",! G CLINIC
- I $D(DTOUT)!$D(DUOUT)!('Y)!(Y<0) W:$P(ECPCE,"~",2)'="N" !!,"Please note that this record cannot be sent to PCE without an active clinic.",!!
- Q
- VISIT ;ask visit info
- Q:ECINP="I"
- ;
- ;- Ask classification questions applicable to patient and file in #721
- I $$ASKCLASS^ECUTL1(+$G(ECPT(CNT)),.ECCLFLDS,.ECOUT,ECPCE,ECINP),($O(ECCLFLDS(""))]"") D SETCLASS^ECUTL1(.ECCLFLDS)
- I +$G(ECOUT) Q
- K ECCLFLDS
- Q
- PCEE ;checks edited data and sets PCE node for filing
- S ECVST=+$P(EC(0),"^",21) I 'ECVST G PCE
- DEL ;delete visit and refresh data to PCE
- K DA,DIE,DR S DA=ECFN,DIE=721,DR="25///@;28///@" D ^DIE K DA,DIE,DR
- ;
- ;* Prepare all EC records with same Visit file entry to resend to PCE
- N ECVAR1,EC2PCE S ECVAR1=$$FNDVST^ECUTL(ECVST,ECFN,.EC2PCE) K ECVAR1
- ;
- ;- Set VALQUIET to stop Amb Care validator from broadcasting to screen
- N ECPKG,ECSOU
- S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECSOU="EVENT CAPTURE DATA"
- S VALQUIET=1,ECVV=$$DELVFILE^PXAPI("ALL",ECVST,ECPKG,ECSOU) K ECVST,VALQUIET
- ;- Resend to PCE task
- D PCETASK^ECPCEU(.EC2PCE) K EC2PCE
- PCE ;set data for PCE filing
- Q:$P(ECPCE,"~",2)="N" ;139
- S ECREAS=""
- ;
- ;- Kill Reason node
- D KILLR
- I EC4 D CLIN^ECPCEU
- I 'EC4 S ECREAS="Clinic missing;"
- I 'ECDX S:$P(ECPCE,"~",2)="A" ECREAS="Diagnosis not entered;" ;139
- I EC4,'ECPCL S ECREAS=ECREAS_"Clinic inactive;"
- I 'ECCPT S ECREAS=ECREAS_"CPT code missing;"
- I ECREAS]"" S ^ECH(ECFN,"R")=ECREAS K ECPCL,ECREAS Q
- I '$D(^ECH(ECFN,0)) Q
- I '$D(^ECH(ECFN,"P")) Q
- S PN=^ECH(ECFN,0),PNP=^ECH(ECFN,"P")
- S PNMOD="" I $D(^ECH(ECFN,"MOD")) D
- . N MOD,MODS S MODS=0 F S MODS=$O(^ECH(ECFN,"MOD",MODS)) Q:'MODS D
- . . S MOD=$P($G(^ECH(ECFN,"MOD",MODS,0)),U)
- . . S MOD=$$MOD^ICPTMOD(MOD,"I",$P(PN,U,3)) I +MOD<0 Q
- . . S PNMOD=$S(PNMOD'="":PNMOD_";",1:"")_$P(MOD,U,2)
- SET ;set data pieces
- S ECP3=+$P(PN,"^",3) I ECP3'["." K ECP3 D DELNOD Q
- S ECP2=+$P(PN,"^",2) I 'ECP2 K ECP2 D DELNOD Q
- S ECP19=+$P(PN,"^",19) I 'ECP19 K ECP19 D DELNOD Q
- S ECP4=+$P(PN,"^",4) I 'ECP4 K ECP4 D DELNOD Q
- S ECP20=+$P(PN,"^",20) I 'ECP20 K ECP20 D DELNOD Q
- S ECP10=+$P(PN,"^",10) I 'ECP10 K ECP10 D DELNOD Q
- S ECPP1=+$P(PNP,"^") I 'ECPP1 K ECPP1 D DELNOD Q
- S ECPP2=+$P(PNP,"^",2) I $P(ECPCE,"~",2)="A" I 'ECPP2 K ECPP2 D DELNOD Q ;139 Must have primary diagnosis if sending all records
- S ECPP3=$P(PNP,"^",3),ECPP3=$S(ECPP3="Y":1,ECPP3="N":0,1:"")
- S ECPP4=$P(PNP,"^",4),ECPP4=$S(ECPP4="Y":1,ECPP4="N":0,1:"")
- S ECPP5=$P(PNP,"^",5),ECPP5=$S(ECPP5="Y":1,ECPP5="N":0,1:"")
- S ECPP6=$P(PNP,"^",6),ECPP6=$S(ECPP6="Y":1,ECPP6="N":0,1:"")
- S ECPP9=$P(PNP,"^",9),ECPP9=$S(ECPP9="Y":1,ECPP9="N":0,1:"")
- S ECPP10=$P(PNP,"^",10),ECPP10=$S(ECPP10="Y":1,ECPP10="N":0,1:"")
- S ECPP11=$P(PNP,"^",11),ECPP11=$S(ECPP11="Y":1,ECPP11="N":0,1:"")
- S ECPP12=$P(PNP,"^",12),ECPP12=$S(ECPP12="Y":1,ECPP12="N":0,1:"")
- S ECPP1A="" I $P(PN,"^",9)["EC" S ECPP1A=$G(^EC(725,+$P(PN,"^",9),0)),ECPP1A=$P(ECPP1A,"^",2)_" "_$P(ECPP1A,"^")
- S ECELIG=$S($G(ECELIG):ECELIG,1:"")
- NODE ;sets "PCE" node
- ;d/t~dfn~hosp loc~inst~dss id~*prov(not filled)~*prov2*~prov3~vol~cpt~dx~ao~rad~env~sc~ecs nat # & name~eligibility~mst~hnc~cv~proj112/shad
- S PNODE=ECP3_"~"_ECP2_"~"_ECP19_"~"_ECP4_"~"_ECP20_"~~~~"_ECP10_"~"_ECPP1_"~"_ECPP2_"~"_ECPP3_"~"_ECPP4_"~"_ECPP5_"~"_ECPP6_"~"_ECPP1A_"~"_ECELIG_"~"_ECPP9_"~"_ECPP10_"~"_ECPP11_"~"_ECPP12
- S ^ECH(ECFN,"PCE")=PNODE
- ;set "PCE1" node
- ;CPT modifier1;CPT modifier 2;CPT modifier 3;...CPT modifier n
- I PNMOD'="" S ^ECH(ECFN,"PCE1")=PNMOD
- ;Replace set of SEND TO PCE w/direct task call - patch 95
- ;S DA=ECFN,DIE=721,DR="31////"_ECDT D ^DIE K DA,DIE,DR
- S EC2PCE(ECDT,ECFN)=""
- D PCETASK^ECPCEU(.EC2PCE) K EC2PCE ;send to PCE task
- K ECP2,ECP3,ECP4,ECP10,ECP19,ECP20,ECPP1,ECPP1A,ECPP2,ECPP3,ECPP4,ECPP5,ECPP6,ECPP9,ECPP10,ECPP11,ECPP12,ECREAS,ECPCL,PN,PNP,PNODE,ECELIG,PNMOD
- Q
- CLIN ;check for active associated clinic
- S MSG1=1,MSG2=0
- 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
- ;
- ;
- KILLR ;- Kill 'R' (Reason) node
- ;
- K ^ECH(ECFN,"R")
- Q
- ;
- ;
- DELNOD ;- Delete 'PCE' and 'Send' nodes
- ;
- N DA,DIE,DR
- ;
- ;- Lock node
- L +^ECH(ECFN):5 Q:'$T
- S DA=ECFN
- S DIE="^ECH("
- S DR="30////@;31////@;37////@"
- ;
- ;- Delete contents
- D ^DIE
- ;
- ;- Unlock node
- L -^ECH(ECFN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECBEN2U 6256 printed Feb 18, 2025@23:23:17 Page 2
- ECBEN2U ;BIR/MAM,JPW-Categories and Procedures Selection ;2/16/18 16:40
- +1 ;;2.0;EVENT CAPTURE;**4,5,7,10,17,18,23,42,47,54,72,95,76,139**;8 May 96;Build 7
- END QUIT
- HDR ;screen header
- +1 WRITE @IOF,!,"Location: ",ECLN
- +2 WRITE !,"DSS Unit: ",$EXTRACT(ECDN,1,30)
- IF $GET(ECCN)]""
- WRITE ?48,"Category: ",$EXTRACT(ECCN,1,20)
- +3 WRITE !,"Ordering Section: ",ECON
- +4 WRITE !,"Procedure Date: ",ECDATE,!
- +5 DO DSP1416^ECPRVMUT(.ECPRVARY)
- +6 WRITE !
- +7 QUIT
- MSG WRITE !!,"No procedures entered. No Action Taken.",!!,"Press <RET> to continue "
- READ X:DTIME
- SET ECOUT=1
- +1 QUIT
- MSG1 ;
- +1 WRITE !!,"Please enter the number that corresponds to the "_$SELECT(OK:"procedure",1:"category")_" from which",!,"you would like to select a procedure. If you would like to continue",!,"with the list, press <RET>. Enter ^ to quit."
- +2 SET CNT=CNT-5
- +3 QUIT
- HDRP ;hdr batch by proc
- +1 WRITE @IOF,!,"Location: ",ECLN
- +2 IF $GET(ECCN)]""
- WRITE !,"Category: ",ECCN
- +3 WRITE !,"Procedure Date: ",ECDATE
- +4 DO DSP1442^ECPRVMUT(.ECPRVARY)
- +5 WRITE !
- +6 QUIT
- PCEQST ;entry pt for PCE questions
- +1 SET (ECDX,ECDXN,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV,ECSHAD)=""
- INP ;- Set inpatient/outpatient status
- +1 SET ECINP=$GET(ECPTSTAT)
- +2 DO CLINIC
- IF ECOUT
- QUIT
- +3 ;ask dx
- +4 DO DIAG^ECUTL2
- IF ECOUT
- QUIT
- +5 IF $PIECE(ECPCE,"~",2)="O"&(ECINP'="O")
- QUIT
- +6 DO VISIT
- +7 QUIT
- CLINIC ;display default clinic
- +1 if $PIECE(ECPCE,"~",2)="N"
- QUIT
- IF $PIECE(ECPCE,"~",2)="O"&(ECINP'="O")
- QUIT
- +2 KILL DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT
- SET DIR(0)="721,26"
- SET DIR("A")="Associated Clinic"
- SET DIR("?")="An active clinic is required. Enter an active clinic or an ^ to exit"
- +3 IF EC4
- IF EC4N'["NO ASSOCIATED CLINIC"
- SET DIR("B")=EC4N
- +4 DO ^DIR
- KILL DIR
- +5 IF Y
- SET EC4=+Y
- SET ECID=$PIECE($GET(^SC(+EC4,0)),"^",7)
- +6 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET ECOUT=1
- QUIT
- +7 IF +EC4
- IF '$GET(ECOUT)
- DO CLIN
- IF 'ECPCL
- WRITE !!,"You must enter an active clinic now.",!
- GOTO CLINIC
- +8 IF $DATA(DTOUT)!$DATA(DUOUT)!('Y)!(Y<0)
- if $PIECE(ECPCE,"~",2)'="N"
- WRITE !!,"Please note that this record cannot be sent to PCE without an active clinic.",!!
- +9 QUIT
- VISIT ;ask visit info
- +1 if ECINP="I"
- QUIT
- +2 ;
- +3 ;- Ask classification questions applicable to patient and file in #721
- +4 IF $$ASKCLASS^ECUTL1(+$GET(ECPT(CNT)),.ECCLFLDS,.ECOUT,ECPCE,ECINP)
- IF ($ORDER(ECCLFLDS(""))]"")
- DO SETCLASS^ECUTL1(.ECCLFLDS)
- +5 IF +$GET(ECOUT)
- QUIT
- +6 KILL ECCLFLDS
- +7 QUIT
- PCEE ;checks edited data and sets PCE node for filing
- +1 SET ECVST=+$PIECE(EC(0),"^",21)
- IF 'ECVST
- GOTO PCE
- DEL ;delete visit and refresh data to PCE
- +1 KILL DA,DIE,DR
- SET DA=ECFN
- SET DIE=721
- SET DR="25///@;28///@"
- DO ^DIE
- KILL DA,DIE,DR
- +2 ;
- +3 ;* Prepare all EC records with same Visit file entry to resend to PCE
- +4 NEW ECVAR1,EC2PCE
- SET ECVAR1=$$FNDVST^ECUTL(ECVST,ECFN,.EC2PCE)
- KILL ECVAR1
- +5 ;
- +6 ;- Set VALQUIET to stop Amb Care validator from broadcasting to screen
- +7 NEW ECPKG,ECSOU
- +8 SET ECPKG=$ORDER(^DIC(9.4,"B","EVENT CAPTURE",0))
- SET ECSOU="EVENT CAPTURE DATA"
- +9 SET VALQUIET=1
- SET ECVV=$$DELVFILE^PXAPI("ALL",ECVST,ECPKG,ECSOU)
- KILL ECVST,VALQUIET
- +10 ;- Resend to PCE task
- +11 DO PCETASK^ECPCEU(.EC2PCE)
- KILL EC2PCE
- PCE ;set data for PCE filing
- +1 ;139
- if $PIECE(ECPCE,"~",2)="N"
- QUIT
- +2 SET ECREAS=""
- +3 ;
- +4 ;- Kill Reason node
- +5 DO KILLR
- +6 IF EC4
- DO CLIN^ECPCEU
- +7 IF 'EC4
- SET ECREAS="Clinic missing;"
- +8 ;139
- IF 'ECDX
- if $PIECE(ECPCE,"~",2)="A"
- SET ECREAS="Diagnosis not entered;"
- +9 IF EC4
- IF 'ECPCL
- SET ECREAS=ECREAS_"Clinic inactive;"
- +10 IF 'ECCPT
- SET ECREAS=ECREAS_"CPT code missing;"
- +11 IF ECREAS]""
- SET ^ECH(ECFN,"R")=ECREAS
- KILL ECPCL,ECREAS
- QUIT
- +12 IF '$DATA(^ECH(ECFN,0))
- QUIT
- +13 IF '$DATA(^ECH(ECFN,"P"))
- QUIT
- +14 SET PN=^ECH(ECFN,0)
- SET PNP=^ECH(ECFN,"P")
- +15 SET PNMOD=""
- IF $DATA(^ECH(ECFN,"MOD"))
- Begin DoDot:1
- +16 NEW MOD,MODS
- SET MODS=0
- FOR
- SET MODS=$ORDER(^ECH(ECFN,"MOD",MODS))
- if 'MODS
- QUIT
- Begin DoDot:2
- +17 SET MOD=$PIECE($GET(^ECH(ECFN,"MOD",MODS,0)),U)
- +18 SET MOD=$$MOD^ICPTMOD(MOD,"I",$PIECE(PN,U,3))
- IF +MOD<0
- QUIT
- +19 SET PNMOD=$SELECT(PNMOD'="":PNMOD_";",1:"")_$PIECE(MOD,U,2)
- End DoDot:2
- End DoDot:1
- SET ;set data pieces
- +1 SET ECP3=+$PIECE(PN,"^",3)
- IF ECP3'["."
- KILL ECP3
- DO DELNOD
- QUIT
- +2 SET ECP2=+$PIECE(PN,"^",2)
- IF 'ECP2
- KILL ECP2
- DO DELNOD
- QUIT
- +3 SET ECP19=+$PIECE(PN,"^",19)
- IF 'ECP19
- KILL ECP19
- DO DELNOD
- QUIT
- +4 SET ECP4=+$PIECE(PN,"^",4)
- IF 'ECP4
- KILL ECP4
- DO DELNOD
- QUIT
- +5 SET ECP20=+$PIECE(PN,"^",20)
- IF 'ECP20
- KILL ECP20
- DO DELNOD
- QUIT
- +6 SET ECP10=+$PIECE(PN,"^",10)
- IF 'ECP10
- KILL ECP10
- DO DELNOD
- QUIT
- +7 SET ECPP1=+$PIECE(PNP,"^")
- IF 'ECPP1
- KILL ECPP1
- DO DELNOD
- QUIT
- +8 ;139 Must have primary diagnosis if sending all records
- SET ECPP2=+$PIECE(PNP,"^",2)
- IF $PIECE(ECPCE,"~",2)="A"
- IF 'ECPP2
- KILL ECPP2
- DO DELNOD
- QUIT
- +9 SET ECPP3=$PIECE(PNP,"^",3)
- SET ECPP3=$SELECT(ECPP3="Y":1,ECPP3="N":0,1:"")
- +10 SET ECPP4=$PIECE(PNP,"^",4)
- SET ECPP4=$SELECT(ECPP4="Y":1,ECPP4="N":0,1:"")
- +11 SET ECPP5=$PIECE(PNP,"^",5)
- SET ECPP5=$SELECT(ECPP5="Y":1,ECPP5="N":0,1:"")
- +12 SET ECPP6=$PIECE(PNP,"^",6)
- SET ECPP6=$SELECT(ECPP6="Y":1,ECPP6="N":0,1:"")
- +13 SET ECPP9=$PIECE(PNP,"^",9)
- SET ECPP9=$SELECT(ECPP9="Y":1,ECPP9="N":0,1:"")
- +14 SET ECPP10=$PIECE(PNP,"^",10)
- SET ECPP10=$SELECT(ECPP10="Y":1,ECPP10="N":0,1:"")
- +15 SET ECPP11=$PIECE(PNP,"^",11)
- SET ECPP11=$SELECT(ECPP11="Y":1,ECPP11="N":0,1:"")
- +16 SET ECPP12=$PIECE(PNP,"^",12)
- SET ECPP12=$SELECT(ECPP12="Y":1,ECPP12="N":0,1:"")
- +17 SET ECPP1A=""
- IF $PIECE(PN,"^",9)["EC"
- SET ECPP1A=$GET(^EC(725,+$PIECE(PN,"^",9),0))
- SET ECPP1A=$PIECE(ECPP1A,"^",2)_" "_$PIECE(ECPP1A,"^")
- +18 SET ECELIG=$SELECT($GET(ECELIG):ECELIG,1:"")
- NODE ;sets "PCE" node
- +1 ;d/t~dfn~hosp loc~inst~dss id~*prov(not filled)~*prov2*~prov3~vol~cpt~dx~ao~rad~env~sc~ecs nat # & name~eligibility~mst~hnc~cv~proj112/shad
- +2 SET PNODE=ECP3_"~"_ECP2_"~"_ECP19_"~"_ECP4_"~"_ECP20_"~~~~"_ECP10_"~"_ECPP1_"~"_ECPP2_"~"_ECPP3_"~"_ECPP4_"~"_ECPP5_"~"_ECPP6_"~"_ECPP1A_"~"_ECELIG_"~"_ECPP9_"~"_ECPP10_"~"_ECPP11_"~"_ECPP12
- +3 SET ^ECH(ECFN,"PCE")=PNODE
- +4 ;set "PCE1" node
- +5 ;CPT modifier1;CPT modifier 2;CPT modifier 3;...CPT modifier n
- +6 IF PNMOD'=""
- SET ^ECH(ECFN,"PCE1")=PNMOD
- +7 ;Replace set of SEND TO PCE w/direct task call - patch 95
- +8 ;S DA=ECFN,DIE=721,DR="31////"_ECDT D ^DIE K DA,DIE,DR
- +9 SET EC2PCE(ECDT,ECFN)=""
- +10 ;send to PCE task
- DO PCETASK^ECPCEU(.EC2PCE)
- KILL EC2PCE
- +11 KILL ECP2,ECP3,ECP4,ECP10,ECP19,ECP20,ECPP1,ECPP1A,ECPP2,ECPP3,ECPP4,ECPP5,ECPP6,ECPP9,ECPP10,ECPP11,ECPP12,ECREAS,ECPCL,PN,PNP,PNODE,ECELIG,PNMOD
- +12 QUIT
- CLIN ;check for active associated clinic
- +1 SET MSG1=1
- SET MSG2=0
- +2 DO CLIN^ECPCEU
- +3 IF 'ECPCL
- Begin DoDot:1
- +4 WRITE !!,"The clinic ",$SELECT(MSG1:"associated with",1:"you selected for")," this procedure ",$SELECT(MSG2:"has not been entered",1:"is inactive"),"."
- +5 WRITE !,"Workload data cannot be sent to PCE for this procedure with ",!,$SELECT(MSG2:"a missing",1:"an inactive")," clinic."
- End DoDot:1
- +6 SET (MSG1,MSG2)=0
- +7 QUIT
- +8 ;
- +9 ;
- KILLR ;- Kill 'R' (Reason) node
- +1 ;
- +2 KILL ^ECH(ECFN,"R")
- +3 QUIT
- +4 ;
- +5 ;
- DELNOD ;- Delete 'PCE' and 'Send' nodes
- +1 ;
- +2 NEW DA,DIE,DR
- +3 ;
- +4 ;- Lock node
- +5 LOCK +^ECH(ECFN):5
- if '$TEST
- QUIT
- +6 SET DA=ECFN
- +7 SET DIE="^ECH("
- +8 SET DR="30////@;31////@;37////@"
- +9 ;
- +10 ;- Delete contents
- +11 DO ^DIE
- +12 ;
- +13 ;- Unlock node
- +14 LOCK -^ECH(ECFN)
- +15 QUIT