190 lines
5.7 KiB
Mathematica
190 lines
5.7 KiB
Mathematica
ECMLMF ;ALB/ESD - File Multiple Dates/Multiple Procedures - 29 AUG 97 08:51
|
|
;;2.0; EVENT CAPTURE ;**5,10,15,13,17,18,23,42,54,72**;8 May 96
|
|
;
|
|
EN ;- Entry point to file selected patients and procedures
|
|
;
|
|
N DIR,DIRUT,I,J,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
|
|
I '$D(^TMP("ECMPIDX",$J))!('$D(^TMP("ECMPTIDX",$J))) W !!,*7,"No patient data found. No patient record(s) have been filed." D MSG G ENQ
|
|
;
|
|
W !!,"You have selected the following patients for filing:",!
|
|
;
|
|
;- List patients
|
|
S I=0
|
|
F S I=$O(^TMP("ECMPTIDX",$J,I)) Q:'I D
|
|
. W !?5,I_". ",$P($G(^TMP("ECMPTIDX",$J,I)),"^",3)
|
|
W !! S DIR(0)="YA",DIR("A")="Is this correct? ",DIR("B")="YES"
|
|
S DIR("?")="Answer YES to continue, NO to exit."
|
|
D ^DIR K DIR
|
|
I '$G(Y)!($D(DIRUT)) W !,"Exiting option...no patients filed.",! D MSG G ENQ
|
|
;
|
|
;- Task job
|
|
F J="DUZ","ECL","ECDSSU","ECCAT","ECU*" S ZTSAVE(J)=""
|
|
S ZTSAVE("^TMP(""ECMPIDX"",$J,")="",ZTSAVE("^TMP(""ECMPTIDX"",$J,")=""
|
|
S ZTIO="",ZTDESC="EC MULT DATES/MULT PROCS DATA ENTRY",ZTRTN="GETNODS^ECMLMF",ZTDTH=$H
|
|
;
|
|
W !!,"These patients will be sent to the background for filing.",!
|
|
D ^%ZTLOAD
|
|
I $D(ZTSK) W !,"Queued as Task #",ZTSK,!
|
|
D MSG
|
|
;
|
|
ENQ K ^TMP("ECPLST",$J)
|
|
Q
|
|
;
|
|
;
|
|
GETNODS ;- Get procedure node and patient node for processing
|
|
;
|
|
N ECI,ECJ,ECPRNOD,ECPTNOD,ECDXX
|
|
S (ECI,ECJ)=0
|
|
F S ECI=$O(^TMP("ECMPTIDX",$J,ECI)) Q:'ECI D
|
|
. S ECPTNOD="",ECPTNOD=$G(^TMP("ECMPTIDX",$J,ECI))
|
|
. K ECDXX M ECDXX=^TMP("ECMPTIDX",$J,ECI,"DXS")
|
|
. F S ECJ=$O(^TMP("ECMPIDX",$J,ECJ)) Q:'ECJ D
|
|
.. S ECPRNOD="",ECPRNOD=$G(^TMP("ECMPIDX",$J,ECJ))
|
|
.. D FILREC
|
|
D ENQ^ECMLMD
|
|
S ZTREQ="@"
|
|
Q
|
|
;
|
|
;
|
|
FILREC ;- Create record in #721 and file fields
|
|
;
|
|
N DA,ECIEN,ECNOGO,ECPRR,ECPTR,ECREAS,ECSND,DIC,DLAYGO,DIE,DR,I,Y
|
|
S ECNOGO=0
|
|
S I=$P(^ECH(0),"^",3)
|
|
LOCKHD S I=I+1 L +^ECH(I):2 I '$T!$D(^ECH(I)) L -^ECH(I) G LOCKHD
|
|
L -^ECH(0)
|
|
K DD,DO S X=I,DIC(0)="L",DLAYGO=721,DIC="^ECH(" D FILE^DICN
|
|
K DIC,DLAYGO,X
|
|
I Y=-1 G FILRECQ
|
|
S (ECIEN,DA)=+Y
|
|
L +^ECH(ECIEN):2 I '$T G FILRECQ
|
|
;
|
|
D SETARRY
|
|
;
|
|
;- File zero node and "P" node
|
|
S DIE="^ECH(",DR="[EC CREATE PATIENT ENTRY]" D ^DIE K DR
|
|
;
|
|
;- File multiple providers, ALB/JAM
|
|
S ECFIL=$$FILPRV^ECPRVMUT(ECIEN,.ECU,.ECOUT) K ECFIL
|
|
;- File secondary diagnoses codes, ALB/JAM
|
|
S (DXS,DXSIEN)=""
|
|
F S DXS=$O(ECDXX(DXS)) Q:DXS="" D
|
|
. S DXSIEN=+ECDXX(DXS) I DXSIEN<0 Q
|
|
. K DIC,DD,DO S DIC(0)="L",DA(1)=ECIEN,DIC("P")=$P(^DD(721,38,0),U,2)
|
|
. S X=DXSIEN,DIC="^ECH("_DA(1)_","_"""DX"""_"," D FILE^DICN
|
|
K DXS,DXSIEN,DIC
|
|
;update encounter's procedures to have same primary & secondary dx
|
|
S PXUPD=$$PXUPD^ECUTL2(ECPTR("DFN"),ECPRR("PROCDT"),ECL,ECPTR("CLIN"),ECPTR("DX"),.ECDXX,ECIEN) K PXUPD
|
|
;
|
|
;File CPT modifiers, ALB/JAM
|
|
N MOD,MODIEN
|
|
S (ECMODS,MOD)=""
|
|
F S MOD=$O(^TMP("ECMPIDX",$J,ECJ,"MOD",MOD)) Q:MOD="" D
|
|
. S MODIEN=$P(^TMP("ECMPIDX",$J,ECJ,"MOD",MOD),U,2) I MODIEN<0 Q
|
|
. K DIC,DD,DO S DIC(0)="L",DA(1)=ECIEN,DIC("P")=$P(^DD(721,36,0),U,2)
|
|
. S X=MODIEN,DIC="^ECH("_DA(1)_","_"""MOD"""_"," D FILE^DICN
|
|
. S ECMODS=ECMODS_$S(ECMODS="":"",1:";")_MOD
|
|
;
|
|
S ECSND=$P($G(^ECD(+$P($G(ECDSSU),"^"),0)),"^",14),DA=ECIEN
|
|
I ECSND="" S ECSND="N"
|
|
I ECSND="A"!((ECSND="O")&(ECPTR("IO")="O")) D
|
|
. S ECNOGO=$$BADFLDS(.ECREAS)
|
|
. I ECNOGO S DR="33////^S X=$G(ECREAS)" D ^DIE Q
|
|
. I 'ECNOGO D PCE
|
|
;
|
|
FILRECQ L -^ECH(ECIEN)
|
|
Q
|
|
;
|
|
;
|
|
SETARRY ;- Set local arrays with procedure and patient data for filing
|
|
;
|
|
N I
|
|
F I="PROCDT","PROC","REAS","VOL" S ECPRR(I)=$P(ECPRNOD,"^",+$P($T(@I),";;",2))
|
|
I ECPRR("REAS")=0 S ECPRR("REAS")=""
|
|
S I="PCEPR" S ECPRR(I)=$S($P($G(ECPRR("PROC")),";",2)="ICPT(":$P($G(ECPRR("PROC")),";"),1:$P($G(^EC(725,+$P($G(ECPRR("PROC")),";"),0)),"^",5))
|
|
F I="DFN","ORDSEC","IO","CLIN","DX","AO","ENV","IR","SC","ELIG","MST","HNC","CV" S ECPTR(I)=$P(ECPTNOD,"^",+$P($T(@I),";;",2))
|
|
Q
|
|
;
|
|
;
|
|
BADFLDS(ECRS) ; - Validation checks on fields to be set in "PCE" node
|
|
;
|
|
S ECRS=""
|
|
I ECPTR("CLIN")="" S ECRS="Clinic missing;"
|
|
I ECPTR("CLIN")=0 S ECRS="Clinic inactive;"
|
|
I ECPTR("DX")="" S ECRS=$G(ECRS)_"Diagnosis missing;"
|
|
I ECPRR("PCEPR")="" S ECRS=$G(ECRS)_"CPT code missing;"
|
|
Q $S($G(ECRS)="":0,1:1)
|
|
;
|
|
;
|
|
PCE ;- More validation checks on fields to be set in "PCE" node
|
|
;
|
|
N ECDSS,I,ECAO,ECELIG,ECEV,ECIR,ECSC,ECNP,ECNPP,ECPCENOD,ECMST,ECHNC,ECCV
|
|
G PCEQ:$G(ECPRR("PROCDT"))'["."!('$G(ECPRR("PCEPR")))
|
|
F I="DFN","CLIN","DX" G PCEQ:'$G(ECPTR(I))
|
|
G PCEQ:'$G(ECPRR("VOL"))
|
|
S ECDSS=$P($G(^ECH(ECIEN,0)),"^",20)
|
|
G PCEQ:'$G(ECL)!('ECDSS)!('$G(ECU(1)))
|
|
;
|
|
S ECPTR("AO")=$G(ECPTR("AO"))
|
|
S ECAO=$S(ECPTR("AO")="Y":1,ECPTR("AO")="N":0,1:"")
|
|
;
|
|
S ECPTR("ENV")=$G(ECPTR("ENV"))
|
|
S ECEV=$S(ECPTR("ENV")="Y":1,ECPTR("ENV")="N":0,1:"")
|
|
;
|
|
S ECPTR("IR")=$G(ECPTR("IR"))
|
|
S ECIR=$S(ECPTR("IR")="Y":1,ECPTR("IR")="N":0,1:"")
|
|
;
|
|
S ECPTR("SC")=$G(ECPTR("SC"))
|
|
S ECSC=$S(ECPTR("SC")="Y":1,ECPTR("SC")="N":0,1:"")
|
|
;
|
|
S ECNPP="" I $G(ECPRR("PROC"))["EC" S ECNP=$G(^EC(725,+ECPRR("PROC"),0)),ECNPP=$P(ECNP,"^",2)_" "_$P(ECNP,"^",1)
|
|
;
|
|
S ECELIG=$S($G(ECPTR("ELIG")):ECPTR("ELIG"),1:"")
|
|
;
|
|
S ECPTR("MST")=$G(ECPTR("MST"))
|
|
S ECMST=$S(ECPTR("MST")="Y":1,ECPTR("MST")="N":0,1:"")
|
|
;
|
|
;JAM;09/30/02,Head/Neck Cancer
|
|
S ECPTR("HNC")=$G(ECPTR("HNC"))
|
|
S ECHNC=$S(ECPTR("HNC")="Y":1,ECPTR("HNC")="N":0,1:"")
|
|
;
|
|
;JAM;10/29/03,Combat Veteran
|
|
S ECPTR("CV")=$G(ECPTR("CV"))
|
|
S ECCV=$S(ECPTR("CV")="Y":1,ECPTR("CV")="N":0,1:"")
|
|
;
|
|
;JAM;06/01/05,Project 112/SHAD
|
|
;S ECPTR("SHAD")=$G(ECPTR("SHAD"))
|
|
;S ECSHAD=$S(ECPTR("SHAD")="Y":1,ECPTR("SHAD")="N":0,1:"")
|
|
;- File "PCE" and "PCE1" nodes
|
|
;
|
|
S DR="[EC FILE PCE NODE]" D ^DIE K DR
|
|
S DR="31////"_$$NOW^XLFDT D ^DIE
|
|
PCEQ Q
|
|
;
|
|
;
|
|
MSG ;- Message displayed so error message can be read on screen
|
|
;
|
|
S DIR(0)="E" D ^DIR
|
|
Q
|
|
;
|
|
;- Subscripts used in creating ECPRR and ECPTR arrays
|
|
;
|
|
PROCDT ;;2
|
|
PROC ;;3
|
|
REAS ;;5
|
|
VOL ;;7
|
|
;
|
|
DFN ;;2
|
|
ORDSEC ;;4
|
|
IO ;;5
|
|
CLIN ;;6
|
|
DX ;;8
|
|
AO ;;10
|
|
ENV ;;11
|
|
IR ;;12
|
|
SC ;;13
|
|
ELIG ;;14
|
|
MST ;;15
|
|
HNC ;;16
|
|
CV ;;17
|