Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECBEN2U

ECBEN2U.m

Go to the documentation of this file.
  1. 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
  1. END Q
  1. HDR ;screen header
  1. W @IOF,!,"Location: ",ECLN
  1. W !,"DSS Unit: ",$E(ECDN,1,30) I $G(ECCN)]"" W ?48,"Category: ",$E(ECCN,1,20)
  1. W !,"Ordering Section: ",ECON
  1. W !,"Procedure Date: ",ECDATE,!
  1. D DSP1416^ECPRVMUT(.ECPRVARY)
  1. W !
  1. Q
  1. MSG W !!,"No procedures entered. No Action Taken.",!!,"Press <RET> to continue " R X:DTIME S ECOUT=1
  1. Q
  1. MSG1 ;
  1. 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."
  1. S CNT=CNT-5
  1. Q
  1. HDRP ;hdr batch by proc
  1. W @IOF,!,"Location: ",ECLN
  1. I $G(ECCN)]"" W !,"Category: ",ECCN
  1. W !,"Procedure Date: ",ECDATE
  1. D DSP1442^ECPRVMUT(.ECPRVARY)
  1. W !
  1. Q
  1. PCEQST ;entry pt for PCE questions
  1. S (ECDX,ECDXN,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV,ECSHAD)=""
  1. INP ;- Set inpatient/outpatient status
  1. S ECINP=$G(ECPTSTAT)
  1. D CLINIC I ECOUT Q
  1. ;ask dx
  1. D DIAG^ECUTL2 I ECOUT Q
  1. I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q
  1. D VISIT
  1. Q
  1. CLINIC ;display default clinic
  1. Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q
  1. 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"
  1. I EC4,EC4N'["NO ASSOCIATED CLINIC" S DIR("B")=EC4N
  1. D ^DIR K DIR
  1. I Y S EC4=+Y,ECID=$P($G(^SC(+EC4,0)),"^",7)
  1. I $D(DTOUT)!$D(DUOUT) S ECOUT=1 Q
  1. I +EC4,'$G(ECOUT) D CLIN I 'ECPCL W !!,"You must enter an active clinic now.",! G CLINIC
  1. 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.",!!
  1. Q
  1. VISIT ;ask visit info
  1. Q:ECINP="I"
  1. ;
  1. ;- Ask classification questions applicable to patient and file in #721
  1. I $$ASKCLASS^ECUTL1(+$G(ECPT(CNT)),.ECCLFLDS,.ECOUT,ECPCE,ECINP),($O(ECCLFLDS(""))]"") D SETCLASS^ECUTL1(.ECCLFLDS)
  1. I +$G(ECOUT) Q
  1. K ECCLFLDS
  1. Q
  1. PCEE ;checks edited data and sets PCE node for filing
  1. S ECVST=+$P(EC(0),"^",21) I 'ECVST G PCE
  1. DEL ;delete visit and refresh data to PCE
  1. K DA,DIE,DR S DA=ECFN,DIE=721,DR="25///@;28///@" D ^DIE K DA,DIE,DR
  1. ;
  1. ;* Prepare all EC records with same Visit file entry to resend to PCE
  1. N ECVAR1,EC2PCE S ECVAR1=$$FNDVST^ECUTL(ECVST,ECFN,.EC2PCE) K ECVAR1
  1. ;
  1. ;- Set VALQUIET to stop Amb Care validator from broadcasting to screen
  1. N ECPKG,ECSOU
  1. S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECSOU="EVENT CAPTURE DATA"
  1. S VALQUIET=1,ECVV=$$DELVFILE^PXAPI("ALL",ECVST,ECPKG,ECSOU) K ECVST,VALQUIET
  1. ;- Resend to PCE task
  1. D PCETASK^ECPCEU(.EC2PCE) K EC2PCE
  1. PCE ;set data for PCE filing
  1. Q:$P(ECPCE,"~",2)="N" ;139
  1. S ECREAS=""
  1. ;
  1. ;- Kill Reason node
  1. D KILLR
  1. I EC4 D CLIN^ECPCEU
  1. I 'EC4 S ECREAS="Clinic missing;"
  1. I 'ECDX S:$P(ECPCE,"~",2)="A" ECREAS="Diagnosis not entered;" ;139
  1. I EC4,'ECPCL S ECREAS=ECREAS_"Clinic inactive;"
  1. I 'ECCPT S ECREAS=ECREAS_"CPT code missing;"
  1. I ECREAS]"" S ^ECH(ECFN,"R")=ECREAS K ECPCL,ECREAS Q
  1. I '$D(^ECH(ECFN,0)) Q
  1. I '$D(^ECH(ECFN,"P")) Q
  1. S PN=^ECH(ECFN,0),PNP=^ECH(ECFN,"P")
  1. S PNMOD="" I $D(^ECH(ECFN,"MOD")) D
  1. . N MOD,MODS S MODS=0 F S MODS=$O(^ECH(ECFN,"MOD",MODS)) Q:'MODS D
  1. . . S MOD=$P($G(^ECH(ECFN,"MOD",MODS,0)),U)
  1. . . S MOD=$$MOD^ICPTMOD(MOD,"I",$P(PN,U,3)) I +MOD<0 Q
  1. . . S PNMOD=$S(PNMOD'="":PNMOD_";",1:"")_$P(MOD,U,2)
  1. SET ;set data pieces
  1. S ECP3=+$P(PN,"^",3) I ECP3'["." K ECP3 D DELNOD Q
  1. S ECP2=+$P(PN,"^",2) I 'ECP2 K ECP2 D DELNOD Q
  1. S ECP19=+$P(PN,"^",19) I 'ECP19 K ECP19 D DELNOD Q
  1. S ECP4=+$P(PN,"^",4) I 'ECP4 K ECP4 D DELNOD Q
  1. S ECP20=+$P(PN,"^",20) I 'ECP20 K ECP20 D DELNOD Q
  1. S ECP10=+$P(PN,"^",10) I 'ECP10 K ECP10 D DELNOD Q
  1. S ECPP1=+$P(PNP,"^") I 'ECPP1 K ECPP1 D DELNOD Q
  1. 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
  1. S ECPP3=$P(PNP,"^",3),ECPP3=$S(ECPP3="Y":1,ECPP3="N":0,1:"")
  1. S ECPP4=$P(PNP,"^",4),ECPP4=$S(ECPP4="Y":1,ECPP4="N":0,1:"")
  1. S ECPP5=$P(PNP,"^",5),ECPP5=$S(ECPP5="Y":1,ECPP5="N":0,1:"")
  1. S ECPP6=$P(PNP,"^",6),ECPP6=$S(ECPP6="Y":1,ECPP6="N":0,1:"")
  1. S ECPP9=$P(PNP,"^",9),ECPP9=$S(ECPP9="Y":1,ECPP9="N":0,1:"")
  1. S ECPP10=$P(PNP,"^",10),ECPP10=$S(ECPP10="Y":1,ECPP10="N":0,1:"")
  1. S ECPP11=$P(PNP,"^",11),ECPP11=$S(ECPP11="Y":1,ECPP11="N":0,1:"")
  1. S ECPP12=$P(PNP,"^",12),ECPP12=$S(ECPP12="Y":1,ECPP12="N":0,1:"")
  1. S ECPP1A="" I $P(PN,"^",9)["EC" S ECPP1A=$G(^EC(725,+$P(PN,"^",9),0)),ECPP1A=$P(ECPP1A,"^",2)_" "_$P(ECPP1A,"^")
  1. S ECELIG=$S($G(ECELIG):ECELIG,1:"")
  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
  1. S PNODE=ECP3_"~"_ECP2_"~"_ECP19_"~"_ECP4_"~"_ECP20_"~~~~"_ECP10_"~"_ECPP1_"~"_ECPP2_"~"_ECPP3_"~"_ECPP4_"~"_ECPP5_"~"_ECPP6_"~"_ECPP1A_"~"_ECELIG_"~"_ECPP9_"~"_ECPP10_"~"_ECPP11_"~"_ECPP12
  1. S ^ECH(ECFN,"PCE")=PNODE
  1. ;set "PCE1" node
  1. ;CPT modifier1;CPT modifier 2;CPT modifier 3;...CPT modifier n
  1. I PNMOD'="" S ^ECH(ECFN,"PCE1")=PNMOD
  1. ;Replace set of SEND TO PCE w/direct task call - patch 95
  1. ;S DA=ECFN,DIE=721,DR="31////"_ECDT D ^DIE K DA,DIE,DR
  1. S EC2PCE(ECDT,ECFN)=""
  1. D PCETASK^ECPCEU(.EC2PCE) K EC2PCE ;send to PCE task
  1. 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
  1. Q
  1. CLIN ;check for active associated clinic
  1. S MSG1=1,MSG2=0
  1. D CLIN^ECPCEU
  1. I 'ECPCL D
  1. .W !!,"The clinic ",$S(MSG1:"associated with",1:"you selected for")," this procedure ",$S(MSG2:"has not been entered",1:"is inactive"),"."
  1. .W !,"Workload data cannot be sent to PCE for this procedure with ",!,$S(MSG2:"a missing",1:"an inactive")," clinic."
  1. S (MSG1,MSG2)=0
  1. Q
  1. ;
  1. ;
  1. KILLR ;- Kill 'R' (Reason) node
  1. ;
  1. K ^ECH(ECFN,"R")
  1. Q
  1. ;
  1. ;
  1. DELNOD ;- Delete 'PCE' and 'Send' nodes
  1. ;
  1. N DA,DIE,DR
  1. ;
  1. ;- Lock node
  1. L +^ECH(ECFN):5 Q:'$T
  1. S DA=ECFN
  1. S DIE="^ECH("
  1. S DR="30////@;31////@;37////@"
  1. ;
  1. ;- Delete contents
  1. D ^DIE
  1. ;
  1. ;- Unlock node
  1. L -^ECH(ECFN)
  1. Q