ECEFPAT ;ALB/JAM-Enter Event Capture Data Patient Filer ;9/6/19 15:40
;;2.0;EVENT CAPTURE;**25,32,39,42,47,49,54,65,72,95,76,112,119,114,126,134,139,148**;8 May 96;Build 4
;
; Reference to $$SINFO^ICDEX supported by ICR #5747
; Reference to $$ICDDX^ICDEX supported by ICR #5747
;
FILE ;Used by the RPC broker to file patient encounter in file #721
; Uses Supported IA 1995 - allow access to $$CPT^ICPTCOD
;
; Variables passed in
; ECIEN - IEN of #721, if editing
; ECDEL - Delete record. 1- YES; 0- 0, null or undefine for NO.
; ECDFN - Patient IEN for file #2
; ECDT - Date and time of procedure
; ECL - Location
; ECD - DSS Unit
; ECC - Category
; ECP - Procedure
; ECVOL - Volume
; ECU1..n - Provider (1 thru n), Prov 1 is required,other optional
; ECMN - Ordering Section
; ECDUZ - Entered/Edited by, pointer to #200
; ECDX - Primary Diagnosis
; ECDXS - Secondary Diagnosis; multiple, optional
; EC4 - Associated Clinic, required if sending data to PCE
; ECPTSTAT- Patient Status
; ECPXREAS- Procedure reason, optional
; ECPXREA2- Procedure reason #2, optional ;112
; ECPXREA3- Procedure reason #3, optional ;112
; ECMOD - CPT modifiers, optional
; ECLASS - Classification, optional
; ECELIG - Eligibility, optional
; ECSOURCE- Indicates source of input (e.g. STATE HOME)
; ECSSID - Unique Spread Sheet ID (ddmmyyyyhhmmss_hash)
; ECSHNAME- Name of State Home from spread sheet upload
;
; Variable return
; ^TMP($J,"ECMSG",n)=Success or failure to file in #721^Message
;
N NODE,ECS,ECM,ECID,ECCPT,ECINT,ECPCE,ECX,ECERR,ECOUT,ECFLG,ECRES
N ECFIL,ECPRV,ECCS
; Determine Active Coding System based on Date of Interest
S ECCS=$S($G(ECDT)'="":ECDT,1:DT)
S ECCS=$$SINFO^ICDEX("DIAG",ECCS) ; Supported by ICR 5747
;
S ECFLG=1,ECERR=0 D CHKDT(1) I ECERR Q
F ECX=1:1 Q:'$D(@("ECU"_ECX)) D I ECERR Q
.I @("ECU"_ECX)="" Q
.S NODE=$$GET^XUA4A72(@("ECU"_ECX),ECDT) I +NODE'>0&($P($G(^ECD(ECD,0)),U,14)'="N") S ECERR=1 D Q ;134 Added check for DSS Unit's send to PCE setting. If set to "no" allow non-providers to be used.
..S ^TMP($J,"ECMSG",1)="0^Provider doesn't have an active Person class"
.S ECPRV(ECX)=@("ECU"_ECX)_"^^"_$S(ECX=1:"P",1:"S")
I $G(ECIEN)'="" S ECFLG=0 D I ECERR Q
. I '$D(^ECH(ECIEN)) S ECERR=1,^TMP($J,"ECMSG",1)="0^Pat IEN Not Found"
I $G(ECDEL) K ^TMP($J,"ECMSG") D Q
.S ECVST=$P($G(^ECH(ECIEN,0)),"^",21) I ECVST D
..;* Resend all EC records with same Visit file entry to PCE
..;* Remove Visit entry from ^ECH( so DELVFILE will complete cleanup
..K EC2PCE S ECVAR1=$$FNDVST^ECUTL(ECVST,,.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
..;- Send to PCE task
..D PCETASK^ECPCEU(.EC2PCE) K EC2PCE
.S DA=ECIEN,DIK="^ECH(" D ^DIK K DA,DIK,ECVV
.D TABLE("D",ECIEN) ;134 Remove entry from table
.S ^TMP($J,"ECMSG",1)="1^Procedure Deleted"
I '$D(ECPRV) S ^TMP($J,"ECMSG",1)="0^No provider present" Q
S ECDT=+ECDT,NODE=$G(^ECD(ECD,0)) I NODE="" D MSG Q
S ECFN=$G(ECIEN),ECVOL=$G(ECVOL,1),ECS=$P(NODE,U,2),ECM=$P(NODE,U,3)
S ECPCE="U~"_$S($P(NODE,"^",14)]"":$P(NODE,"^",14),1:"N")
;S ECPTSTAT=$$INOUTPT^ECUTL0(ECDFN,+ECDT) ;pat stat may not need
I $P(ECPCE,"~",2)="OOS" D OOSCLIN ;139 If OOS type DSS unit, get clinic for sending data to PCE
I $G(EC4)="" D GETCLN^ECEDF
S ECID=$S(+EC4:$P($G(^SC(+EC4,0)),"^",7),1:""),ECINP=ECPTSTAT
I $P(ECPCE,"~",2)="A" D CHKDT(2) ;139
I +EC4 S ECRES=$$CLNCK^SDUTL2(+EC4,0) I 'ECRES D S ECERR=1
.S ^TMP($J,"ECMSG",1)=ECRES_" Clinic MUST be corrected before filing."
Q:ECERR I ECFLG D NEWIEN I $G(ECSOURCE)="STATE HOME" D TABLE("A",ECIEN) ;134 If state home record, add to table
S ECCPT=$S(ECP["ICPT":+ECP,1:$P($G(^EC(725,+ECP,0)),U,5))
;validate CPT value and handle HCPCS name to IEN conversion (HD223010)
S ECCPT=+$$CPT^ICPTCOD(ECCPT)
S ECCPT=$S(+ECCPT>0:ECCPT,1:0)
K DA,DR,DIE S DIE="^ECH(",(DA,ECFN)=ECIEN K ECIEN
S DR=".01////"_ECFN_";1////"_ECDFN_";3////"_ECL_";4////"_ECS
S DR=DR_";5////"_ECM_";6////"_ECD_";7////"_+ECC_";9////"_ECVOL
S $P(^ECH(ECFN,0),"^",9)=ECP
D ^DIE I $D(DTOUT) D RECDEL,MSG Q
K DA,DR,DIE S DIE="^ECH(" ;139
S DA=ECFN,DR="11////"_ECMN_";13////"_ECDUZ_";2////"_ECDT
;S ECPXREAS=$G(ECPXREAS) ;112
D CVTREAS Q:$G(ECERR) ;119 Convert reasons from entries in 720.4 to entries in 720.5 before storing.
S DR=DR_";19////"_$S(+ECCPT:ECCPT,1:"@")_";20////"_ECDX
S DR=DR_";26////"_$S($G(EC4):EC4,1:"")_";27////"_$G(ECID)_";29////"_ECPTSTAT ;126 allow EC4 to be null if no associated clinic
S DR=DR_";34////"_$S($G(ECPXREAS)="":"@",1:ECPXREAS) ;112
S DR=DR_";43////"_$S($G(ECPXREA2)="":"@",1:ECPXREA2) ;112
S DR=DR_";44////"_$S($G(ECPXREA3)="":"@",1:ECPXREA3) ;112
I $G(ECSOURCE)="STATE HOME" D ;139 Added section for state home records
.N STATUS,IMPDT
.S STATUS=$$STAT ;Determine if "late"
.S IMPDT=($E(ECSSID,5,6)-17)_$E(ECSSID,7,8)_$E(ECSSID,1,4)_"."_$E(ECSSID,9,14) ;Convert date to intermal FM format
.S DR=DR_";45////"_ECSOURCE_";46///"_STATUS_";47////"_IMPDT_";48////"_ECSSID_";49////"_$G(ECSHNAME) ;139,148 Add source, status, import date/time and spreadsheet ID - 148, add state home name
.Q
D ^DIE I $D(DTOUT) D RECDEL,MSG Q
I ECDX S ^DISV(DUZ,"^ICD9(")=ECDX ;last ICD9 code
S ECX=$O(ECPRV("A"),-1) I ECX'="" S ^DISV(DUZ,"^VA(200,")=+ECPRV(ECX)
;Remove Old CPT modifiers
I 'ECFLG D
. K OLDMOD S (ECDA,DA(1))=ECFN,DIK="^ECH("_DA(1)_",""MOD"",",DA=0
. F S DA=$O(^ECH(ECDA,"MOD",DA)) Q:'DA S OLDMOD(DA)="" D ^DIK
. K DA,ECDA,DIK,^ECH(ECFN,"MOD")
.;Remove old secondary diagnosis codes
. K OLDDXS S (ECDA,DA(1))=ECFN,DIK="^ECH("_DA(1)_",""DX"",",DA=0
. F S DA=$O(^ECH(ECDA,"DX",DA)) Q:'DA S OLDDXS(DA)="" D ^DIK
. K DA,ECDA,DIK,^ECH(ECFN,"DX")
I $D(DTOUT) D RECDEL,MSG Q
;File multiple providers
S ECFIL=$$FILPRV^ECPRVMUT(ECFN,.ECPRV,.ECOUT) K ECOUT
I 'ECFIL D RECDEL,MSG Q
;File CPT modifiers
I $G(ECMOD)'="" D
. S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,36,0),U,2)
. S DIC="^ECH("_DA(1)_","_"""MOD"""_","
. F ECX=1:1:$L(ECMOD,"^") S MODIEN=$P(ECMOD,U,ECX) I +MODIEN>0 D
. . K DD,DO S X=MODIEN D FILE^DICN
. K MODIEN,DIC
I $D(DTOUT) D RECDEL,MSG Q
; File multiple secondary diagnosis codes
I $G(ECDXS)'="" D
. S DXS="",DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,38,0),U,2)
. S DIC="^ECH("_DA(1)_","_"""DX"""_",",ECDXY=ECDX K ECDXX
. F ECX=1:1:$L(ECDXS,"^") S DXSIEN=$P(ECDXS,U,ECX) I +DXSIEN>0 D
. . ; Retrieve ICD data - Supported by ICR 5747
. . S DXCDE=$$ICDDX^ICDEX(DXSIEN,ECDT,+ECCS,"I") Q:+DXCDE<0 I '$P(DXCDE,U,10) Q
. . K DD,DO S X=DXSIEN D FILE^DICN
. . S DXCDE=$P(DXCDE,U,2),ECDXX(DXCDE)=DXSIEN
. . S ^DISV(DUZ,"^ICD9(")=DXSIEN ;last ICD9 code
. ; 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,DXS,DXSIEN,DIC,DXCDE,DA,DD,DO
I $D(DTOUT) D RECDEL,MSG Q
S DA=ECFN
;File classification AO^IR^SC^EC^MST^HNC^CV^SHAD
I $G(ECLASS)'="" D
. S CLSTR="21^22^24^23^35^39^40^41",DR=""
. F ECX=1:1:$L(CLSTR,"^") D
. . S DR=DR_$P(CLSTR,U,ECX)_"////"_$P(ECLASS,U,ECX)_";"
. S DR=$E(DR,1,($L(DR)-1)) D ^DIE
. K CLSTR,DR,DIE
I $D(DTOUT) D RECDEL,MSG Q
;
PCE ; format PCE data to send
I ($P(ECPCE,"~",2)="N") D Q ;139
.S ^TMP($J,"ECMSG",1)="1^Record Filed"
D:ECFLG PCE^ECBEN2U I 'ECFLG S EC(0)=^ECH(ECFN,0) D PCEE^ECBEN2U K EC
I $G(ECOUT)!(ECERR) D Q
. D RECDEL S STR=$S($G(^ECH(ECFN,"R")):^("R"),1:" PCE Data Missing")
. S ^TMP($J,"ECMSG",1)="0^Record Not Filed, "_STR K STR
S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_$G(ECIEN)
Q
;
NEWIEN ;Create new IEN in file #721
N DIC,DA,DD,DO,ECRN
RLCK L +^ECH(0):60 S ECRN=$P(^ECH(0),"^",3)+1
I $D(^ECH(ECRN)) S $P(^ECH(0),"^",3)=$P(^(0),"^",3)+1 L -^ECH(0) G RLCK
L -^ECH(0) S DIC(0)="L",DIC="^ECH(",X=ECRN
D FILE^DICN S ECIEN=+Y
Q
RECDEL ; Delete record
;restore old data
I 'ECFLG D Q
. I $O(OLDMOD("")) D
. . S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,36,0),U,2)
. . S DIC="^ECH("_DA(1)_","_"""MOD"""_",",ECX=0
. . F S ECX=$O(OLDMOD(ECX)) Q:'ECX I ECX>0 K DD,DO S X=ECX D FILE^DICN
. I $O(OLDDXS("")) D
. . S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,38,0),U,2)
. . S DIC="^ECH("_DA(1)_","_"""DX"""_",",ECX=0
. . F S ECX=$O(OLDDXS(ECX)) Q:'ECX I ECX>0 K DD,DO S X=ECX D FILE^DICN
. K DIC,DA,DD,DO,OLDMOD,OLDDXS,ECX
S DA=ECFN,DIK="^ECH(" D ^DIK K DA,DIK
D TABLE("D",ECFN) ;134 Delete record from table
Q
MSG ;Record not filed
S ^TMP($J,"ECMSG",1)="0^Record not Filed"
Q
CHKDT(FLG) ;Required Data Check
N I,C
S C=1
I FLG=1 D Q
.F I="ECD","ECC","ECL","ECDT","ECP","ECDFN","ECMN","ECDUZ","ECPTSTAT" D
..I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
.I $G(ECDEL),$D(ECIEN) K ^TMP($J,"ECMSG") S ECERR=0
;check PCE data
I FLG=2 D Q
.F I="EC4","ECDX" D Q
..I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key PCE data missing "_I,C=C+1,ECERR=1
Q
VALDATA ;validate data
N ECRRX
D CHK^DIE(721,1,,"`"_ECDFN,.ECRRX) I ECRRX'=ECDFN D Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Patient"
D CHK^DIE(721,2,,ECDT,.ECRRX) I ECRRX'=ECDT D Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Procedure Date"
D CHK^DIE(721,3,,"`"_ECL,.ECRRX) I ECRRX'=ECL D Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Location"
D CHK^DIE(721,6,,"`"_ECD,.ECRRX) I ECRRX'=ECD D Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid DSS Unit"
D CHK^DIE(721,7,,"`"_ECC,.ECRRX) I ECRRX'=ECC D Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Category"
D I ECERR Q
.I ECP["ICPT" S ECRRX=$$CPT^ICPTCOD(+ECP,ECDT) I +ECRRX>0,$P(ECRRX,U,7) Q
.I ECP["EC",$D(^EC(725,+ECP,0)) Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Procedure"
D CHK^DIE(721,11,,"`"_ECMN,.ECRRX) I ECRRX'=ECMN D Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Ordering Section"
D CHK^DIE(721,20,,"`"_ECDX,.ECRRX) I ECRRX'=ECDX D Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Primary Diagnosis"
I $G(EC4)'="" D CHK^DIE(721,26,,"`"_EC4,.ECRRX) I ECRRX'=EC4 D Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Associated Clinic"
Q
;
CVTREAS ;119 Section added to convert procedure reason IEN in 720.4 to EC Code Screen/Procedure reason link in file 720.5.
N SCREEN,SCREENID,I
S SCREEN=ECL_"-"_ECD_"-"_+$G(ECC,0)_"-"_ECP ;creates event code screen
S SCREENID=$O(^ECJ("B",SCREEN,0)) I '+SCREENID S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Event Code Screen" Q ;event code screen doesn't exist
F I="ECPXREAS","ECPXREA2","ECPXREA3" I $G(@I) S @I=$$GETVAL(SCREENID,@I)
Q
GETVAL(SCREENO,REASNO) ;119 section added to get link from 720.5 or add it if necessary
N LINK,DIC,X,Y
S LINK=$O(^ECL("AD",SCREENO,REASNO,0))
I $G(LINK) Q LINK ;Entry in 720.5 exists, return IEN
S DIC="^ECL(",DIC(0)="",X=REASNO,DIC("DR")=".02////"_SCREENO
K DD,DO D FILE^DICN
S LINK=$S(+Y:+Y,1:"") ;New IEN or null if not added
Q LINK
;
TABLE(OPTION,RECNO) ;134 Section added to add/delete state home records from XTMP table.
I '$$PATCH^XPDUTL("ECX*3.0*166") Q ;Don't start table maintenance until related patch in DSS is installed.
I $G(OPTION)=""!($G(RECNO)="") Q
I $G(OPTION)="A" S ^XTMP("ECEFPAT",RECNO)="" ;add to table
I $G(OPTION)="D" K ^XTMP("ECEFPAT",RECNO) ;delete from table
S ^XTMP("ECEFPAT",0)=$$FMADD^XLFDT($$DT^XLFDT,180)_"^"_$$DT^XLFDT_"^"_"Event capture state home records"
Q
;
STAT() ;139 Returns status of record
N LED
S LED=$$LED+.24 ;Set last extract date to midnight of that day
I ECDT'>LED Q "LATE"
Q ""
;
LED() ;139 Determine last extract date for Event Capture
N LAST,EXTNO,EXTNOLED
S EXTNO=$P($G(^XTMP("EC LED",0)),U,4) ;Get extract number associated with last extract date
F S EXTNO=$O(^ECX(727,"D","EVENT CAPTURE",EXTNO)) Q:'+EXTNO D
.S EXTNOLED=$$GET1^DIQ(727,EXTNO,4,"I") ;Get end date for extract
.S LAST=$P($G(^XTMP("EC LED",0)),U,5) ;Get last extract date if stored
.I EXTNOLED'<LAST D ;If extract end date is later than current last date then update
..S ^XTMP("EC LED",0)=$$FMADD^XLFDT($$DT^XLFDT,180)_"^"_$$DT^XLFDT_"^"_"Last event capture extract date"_"^"_EXTNO_"^"_EXTNOLED
Q +$P($G(^XTMP("EC LED",0)),U,5) ;Return last extract date
;
OOSCLIN ;139 Create an OOS related clinic for a location and DSS unit when DSS unit is an OOS type
N CLNAME,STOP,ECCLN
S STOP=$$GET1^DIQ(40.7,+$P(^ECD(ECD,0),U,10),1) ;Get stop code for DSS unit
S CLNAME="EC "_$$GET1^DIQ(4,ECL,99)_" OOS "_STOP ;Create clinic name as EC_STA6_OOS_Stop code number
S EC4=+$$FIND1^DIC(44,"","X",CLNAME) I EC4 Q ;If clinic exists, skip creation
S ECCLN=$$LOC^SCDXUAPI(CLNAME,ECL,STOP,"EC")
S EC4=+ECCLN ;Set EC4 (clinic) to newly created clinic
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECEFPAT 13092 printed Oct 16, 2024@17:58:09 Page 2
ECEFPAT ;ALB/JAM-Enter Event Capture Data Patient Filer ;9/6/19 15:40
+1 ;;2.0;EVENT CAPTURE;**25,32,39,42,47,49,54,65,72,95,76,112,119,114,126,134,139,148**;8 May 96;Build 4
+2 ;
+3 ; Reference to $$SINFO^ICDEX supported by ICR #5747
+4 ; Reference to $$ICDDX^ICDEX supported by ICR #5747
+5 ;
FILE ;Used by the RPC broker to file patient encounter in file #721
+1 ; Uses Supported IA 1995 - allow access to $$CPT^ICPTCOD
+2 ;
+3 ; Variables passed in
+4 ; ECIEN - IEN of #721, if editing
+5 ; ECDEL - Delete record. 1- YES; 0- 0, null or undefine for NO.
+6 ; ECDFN - Patient IEN for file #2
+7 ; ECDT - Date and time of procedure
+8 ; ECL - Location
+9 ; ECD - DSS Unit
+10 ; ECC - Category
+11 ; ECP - Procedure
+12 ; ECVOL - Volume
+13 ; ECU1..n - Provider (1 thru n), Prov 1 is required,other optional
+14 ; ECMN - Ordering Section
+15 ; ECDUZ - Entered/Edited by, pointer to #200
+16 ; ECDX - Primary Diagnosis
+17 ; ECDXS - Secondary Diagnosis; multiple, optional
+18 ; EC4 - Associated Clinic, required if sending data to PCE
+19 ; ECPTSTAT- Patient Status
+20 ; ECPXREAS- Procedure reason, optional
+21 ; ECPXREA2- Procedure reason #2, optional ;112
+22 ; ECPXREA3- Procedure reason #3, optional ;112
+23 ; ECMOD - CPT modifiers, optional
+24 ; ECLASS - Classification, optional
+25 ; ECELIG - Eligibility, optional
+26 ; ECSOURCE- Indicates source of input (e.g. STATE HOME)
+27 ; ECSSID - Unique Spread Sheet ID (ddmmyyyyhhmmss_hash)
+28 ; ECSHNAME- Name of State Home from spread sheet upload
+29 ;
+30 ; Variable return
+31 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #721^Message
+32 ;
+33 NEW NODE,ECS,ECM,ECID,ECCPT,ECINT,ECPCE,ECX,ECERR,ECOUT,ECFLG,ECRES
+34 NEW ECFIL,ECPRV,ECCS
+35 ; Determine Active Coding System based on Date of Interest
+36 SET ECCS=$SELECT($GET(ECDT)'="":ECDT,1:DT)
+37 ; Supported by ICR 5747
SET ECCS=$$SINFO^ICDEX("DIAG",ECCS)
+38 ;
+39 SET ECFLG=1
SET ECERR=0
DO CHKDT(1)
IF ECERR
QUIT
+40 FOR ECX=1:1
if '$DATA(@("ECU"_ECX))
QUIT
Begin DoDot:1
+41 IF @("ECU"_ECX)=""
QUIT
+42 ;134 Added check for DSS Unit's send to PCE setting. If set to "no" allow non-providers to be used.
SET NODE=$$GET^XUA4A72(@("ECU"_ECX),ECDT)
IF +NODE'>0&($PIECE($GET(^ECD(ECD,0)),U,14)'="N")
SET ECERR=1
Begin DoDot:2
+43 SET ^TMP($JOB,"ECMSG",1)="0^Provider doesn't have an active Person class"
End DoDot:2
QUIT
+44 SET ECPRV(ECX)=@("ECU"_ECX)_"^^"_$SELECT(ECX=1:"P",1:"S")
End DoDot:1
IF ECERR
QUIT
+45 IF $GET(ECIEN)'=""
SET ECFLG=0
Begin DoDot:1
+46 IF '$DATA(^ECH(ECIEN))
SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Pat IEN Not Found"
End DoDot:1
IF ECERR
QUIT
+47 IF $GET(ECDEL)
KILL ^TMP($JOB,"ECMSG")
Begin DoDot:1
+48 SET ECVST=$PIECE($GET(^ECH(ECIEN,0)),"^",21)
IF ECVST
Begin DoDot:2
+49 ;* Resend all EC records with same Visit file entry to PCE
+50 ;* Remove Visit entry from ^ECH( so DELVFILE will complete cleanup
+51 KILL EC2PCE
SET ECVAR1=$$FNDVST^ECUTL(ECVST,,.EC2PCE)
KILL ECVAR1
+52 ;Set VALQUIET to stop Amb Care validator from broadcasting to screen
+53 NEW ECPKG,ECSOU
+54 SET ECPKG=$ORDER(^DIC(9.4,"B","EVENT CAPTURE",0))
SET ECSOU="EVENT CAPTURE DATA"
+55 SET VALQUIET=1
SET ECVV=$$DELVFILE^PXAPI("ALL",ECVST,ECPKG,ECSOU)
KILL ECVST,VALQUIET
+56 ;- Send to PCE task
+57 DO PCETASK^ECPCEU(.EC2PCE)
KILL EC2PCE
End DoDot:2
+58 SET DA=ECIEN
SET DIK="^ECH("
DO ^DIK
KILL DA,DIK,ECVV
+59 ;134 Remove entry from table
DO TABLE("D",ECIEN)
+60 SET ^TMP($JOB,"ECMSG",1)="1^Procedure Deleted"
End DoDot:1
QUIT
+61 IF '$DATA(ECPRV)
SET ^TMP($JOB,"ECMSG",1)="0^No provider present"
QUIT
+62 SET ECDT=+ECDT
SET NODE=$GET(^ECD(ECD,0))
IF NODE=""
DO MSG
QUIT
+63 SET ECFN=$GET(ECIEN)
SET ECVOL=$GET(ECVOL,1)
SET ECS=$PIECE(NODE,U,2)
SET ECM=$PIECE(NODE,U,3)
+64 SET ECPCE="U~"_$SELECT($PIECE(NODE,"^",14)]"":$PIECE(NODE,"^",14),1:"N")
+65 ;S ECPTSTAT=$$INOUTPT^ECUTL0(ECDFN,+ECDT) ;pat stat may not need
+66 ;139 If OOS type DSS unit, get clinic for sending data to PCE
IF $PIECE(ECPCE,"~",2)="OOS"
DO OOSCLIN
+67 IF $GET(EC4)=""
DO GETCLN^ECEDF
+68 SET ECID=$SELECT(+EC4:$PIECE($GET(^SC(+EC4,0)),"^",7),1:"")
SET ECINP=ECPTSTAT
+69 ;139
IF $PIECE(ECPCE,"~",2)="A"
DO CHKDT(2)
+70 IF +EC4
SET ECRES=$$CLNCK^SDUTL2(+EC4,0)
IF 'ECRES
Begin DoDot:1
+71 SET ^TMP($JOB,"ECMSG",1)=ECRES_" Clinic MUST be corrected before filing."
End DoDot:1
SET ECERR=1
+72 ;134 If state home record, add to table
if ECERR
QUIT
IF ECFLG
DO NEWIEN
IF $GET(ECSOURCE)="STATE HOME"
DO TABLE("A",ECIEN)
+73 SET ECCPT=$SELECT(ECP["ICPT":+ECP,1:$PIECE($GET(^EC(725,+ECP,0)),U,5))
+74 ;validate CPT value and handle HCPCS name to IEN conversion (HD223010)
+75 SET ECCPT=+$$CPT^ICPTCOD(ECCPT)
+76 SET ECCPT=$SELECT(+ECCPT>0:ECCPT,1:0)
+77 KILL DA,DR,DIE
SET DIE="^ECH("
SET (DA,ECFN)=ECIEN
KILL ECIEN
+78 SET DR=".01////"_ECFN_";1////"_ECDFN_";3////"_ECL_";4////"_ECS
+79 SET DR=DR_";5////"_ECM_";6////"_ECD_";7////"_+ECC_";9////"_ECVOL
+80 SET $PIECE(^ECH(ECFN,0),"^",9)=ECP
+81 DO ^DIE
IF $DATA(DTOUT)
DO RECDEL
DO MSG
QUIT
+82 ;139
KILL DA,DR,DIE
SET DIE="^ECH("
+83 SET DA=ECFN
SET DR="11////"_ECMN_";13////"_ECDUZ_";2////"_ECDT
+84 ;S ECPXREAS=$G(ECPXREAS) ;112
+85 ;119 Convert reasons from entries in 720.4 to entries in 720.5 before storing.
DO CVTREAS
if $GET(ECERR)
QUIT
+86 SET DR=DR_";19////"_$SELECT(+ECCPT:ECCPT,1:"@")_";20////"_ECDX
+87 ;126 allow EC4 to be null if no associated clinic
SET DR=DR_";26////"_$SELECT($GET(EC4):EC4,1:"")_";27////"_$GET(ECID)_";29////"_ECPTSTAT
+88 ;112
SET DR=DR_";34////"_$SELECT($GET(ECPXREAS)="":"@",1:ECPXREAS)
+89 ;112
SET DR=DR_";43////"_$SELECT($GET(ECPXREA2)="":"@",1:ECPXREA2)
+90 ;112
SET DR=DR_";44////"_$SELECT($GET(ECPXREA3)="":"@",1:ECPXREA3)
+91 ;139 Added section for state home records
IF $GET(ECSOURCE)="STATE HOME"
Begin DoDot:1
+92 NEW STATUS,IMPDT
+93 ;Determine if "late"
SET STATUS=$$STAT
+94 ;Convert date to intermal FM format
SET IMPDT=($EXTRACT(ECSSID,5,6)-17)_$EXTRACT(ECSSID,7,8)_$EXTRACT(ECSSID,1,4)_"."_$EXTRACT(ECSSID,9,14)
+95 ;139,148 Add source, status, import date/time and spreadsheet ID - 148, add state home name
SET DR=DR_";45////"_ECSOURCE_";46///"_STATUS_";47////"_IMPDT_";48////"_ECSSID_";49////"_$GET(ECSHNAME)
+96 QUIT
End DoDot:1
+97 DO ^DIE
IF $DATA(DTOUT)
DO RECDEL
DO MSG
QUIT
+98 ;last ICD9 code
IF ECDX
SET ^DISV(DUZ,"^ICD9(")=ECDX
+99 SET ECX=$ORDER(ECPRV("A"),-1)
IF ECX'=""
SET ^DISV(DUZ,"^VA(200,")=+ECPRV(ECX)
+100 ;Remove Old CPT modifiers
+101 IF 'ECFLG
Begin DoDot:1
+102 KILL OLDMOD
SET (ECDA,DA(1))=ECFN
SET DIK="^ECH("_DA(1)_",""MOD"","
SET DA=0
+103 FOR
SET DA=$ORDER(^ECH(ECDA,"MOD",DA))
if 'DA
QUIT
SET OLDMOD(DA)=""
DO ^DIK
+104 KILL DA,ECDA,DIK,^ECH(ECFN,"MOD")
+105 ;Remove old secondary diagnosis codes
+106 KILL OLDDXS
SET (ECDA,DA(1))=ECFN
SET DIK="^ECH("_DA(1)_",""DX"","
SET DA=0
+107 FOR
SET DA=$ORDER(^ECH(ECDA,"DX",DA))
if 'DA
QUIT
SET OLDDXS(DA)=""
DO ^DIK
+108 KILL DA,ECDA,DIK,^ECH(ECFN,"DX")
End DoDot:1
+109 IF $DATA(DTOUT)
DO RECDEL
DO MSG
QUIT
+110 ;File multiple providers
+111 SET ECFIL=$$FILPRV^ECPRVMUT(ECFN,.ECPRV,.ECOUT)
KILL ECOUT
+112 IF 'ECFIL
DO RECDEL
DO MSG
QUIT
+113 ;File CPT modifiers
+114 IF $GET(ECMOD)'=""
Begin DoDot:1
+115 SET DIC(0)="L"
SET DA(1)=ECFN
SET DIC("P")=$PIECE(^DD(721,36,0),U,2)
+116 SET DIC="^ECH("_DA(1)_","_"""MOD"""_","
+117 FOR ECX=1:1:$LENGTH(ECMOD,"^")
SET MODIEN=$PIECE(ECMOD,U,ECX)
IF +MODIEN>0
Begin DoDot:2
+118 KILL DD,DO
SET X=MODIEN
DO FILE^DICN
End DoDot:2
+119 KILL MODIEN,DIC
End DoDot:1
+120 IF $DATA(DTOUT)
DO RECDEL
DO MSG
QUIT
+121 ; File multiple secondary diagnosis codes
+122 IF $GET(ECDXS)'=""
Begin DoDot:1
+123 SET DXS=""
SET DIC(0)="L"
SET DA(1)=ECFN
SET DIC("P")=$PIECE(^DD(721,38,0),U,2)
+124 SET DIC="^ECH("_DA(1)_","_"""DX"""_","
SET ECDXY=ECDX
KILL ECDXX
+125 FOR ECX=1:1:$LENGTH(ECDXS,"^")
SET DXSIEN=$PIECE(ECDXS,U,ECX)
IF +DXSIEN>0
Begin DoDot:2
+126 ; Retrieve ICD data - Supported by ICR 5747
+127 SET DXCDE=$$ICDDX^ICDEX(DXSIEN,ECDT,+ECCS,"I")
if +DXCDE<0
QUIT
IF '$PIECE(DXCDE,U,10)
QUIT
+128 KILL DD,DO
SET X=DXSIEN
DO FILE^DICN
+129 SET DXCDE=$PIECE(DXCDE,U,2)
SET ECDXX(DXCDE)=DXSIEN
+130 ;last ICD9 code
SET ^DISV(DUZ,"^ICD9(")=DXSIEN
End DoDot:2
+131 ; Update all procedures for an encounter with same primary & second dx
+132 SET PXUPD=$$PXUPD^ECUTL2(ECDFN,ECDT,ECL,EC4,ECDXY,.ECDXX,ECFN)
+133 KILL PXUPD,ECDXY,ECDXX,DXS,DXSIEN,DIC,DXCDE,DA,DD,DO
End DoDot:1
+134 IF $DATA(DTOUT)
DO RECDEL
DO MSG
QUIT
+135 SET DA=ECFN
+136 ;File classification AO^IR^SC^EC^MST^HNC^CV^SHAD
+137 IF $GET(ECLASS)'=""
Begin DoDot:1
+138 SET CLSTR="21^22^24^23^35^39^40^41"
SET DR=""
+139 FOR ECX=1:1:$LENGTH(CLSTR,"^")
Begin DoDot:2
+140 SET DR=DR_$PIECE(CLSTR,U,ECX)_"////"_$PIECE(ECLASS,U,ECX)_";"
End DoDot:2
+141 SET DR=$EXTRACT(DR,1,($LENGTH(DR)-1))
DO ^DIE
+142 KILL CLSTR,DR,DIE
End DoDot:1
+143 IF $DATA(DTOUT)
DO RECDEL
DO MSG
QUIT
+144 ;
PCE ; format PCE data to send
+1 ;139
IF ($PIECE(ECPCE,"~",2)="N")
Begin DoDot:1
+2 SET ^TMP($JOB,"ECMSG",1)="1^Record Filed"
End DoDot:1
QUIT
+3 if ECFLG
DO PCE^ECBEN2U
IF 'ECFLG
SET EC(0)=^ECH(ECFN,0)
DO PCEE^ECBEN2U
KILL EC
+4 IF $GET(ECOUT)!(ECERR)
Begin DoDot:1
+5 DO RECDEL
SET STR=$SELECT($GET(^ECH(ECFN,"R")):^("R"),1:" PCE Data Missing")
+6 SET ^TMP($JOB,"ECMSG",1)="0^Record Not Filed, "_STR
KILL STR
End DoDot:1
QUIT
+7 SET ^TMP($JOB,"ECMSG",1)="1^Record Filed"_U_$GET(ECIEN)
+8 QUIT
+9 ;
NEWIEN ;Create new IEN in file #721
+1 NEW DIC,DA,DD,DO,ECRN
RLCK LOCK +^ECH(0):60
SET ECRN=$PIECE(^ECH(0),"^",3)+1
+1 IF $DATA(^ECH(ECRN))
SET $PIECE(^ECH(0),"^",3)=$PIECE(^(0),"^",3)+1
LOCK -^ECH(0)
GOTO RLCK
+2 LOCK -^ECH(0)
SET DIC(0)="L"
SET DIC="^ECH("
SET X=ECRN
+3 DO FILE^DICN
SET ECIEN=+Y
+4 QUIT
RECDEL ; Delete record
+1 ;restore old data
+2 IF 'ECFLG
Begin DoDot:1
+3 IF $ORDER(OLDMOD(""))
Begin DoDot:2
+4 SET DIC(0)="L"
SET DA(1)=ECFN
SET DIC("P")=$PIECE(^DD(721,36,0),U,2)
+5 SET DIC="^ECH("_DA(1)_","_"""MOD"""_","
SET ECX=0
+6 FOR
SET ECX=$ORDER(OLDMOD(ECX))
if 'ECX
QUIT
IF ECX>0
KILL DD,DO
SET X=ECX
DO FILE^DICN
End DoDot:2
+7 IF $ORDER(OLDDXS(""))
Begin DoDot:2
+8 SET DIC(0)="L"
SET DA(1)=ECFN
SET DIC("P")=$PIECE(^DD(721,38,0),U,2)
+9 SET DIC="^ECH("_DA(1)_","_"""DX"""_","
SET ECX=0
+10 FOR
SET ECX=$ORDER(OLDDXS(ECX))
if 'ECX
QUIT
IF ECX>0
KILL DD,DO
SET X=ECX
DO FILE^DICN
End DoDot:2
+11 KILL DIC,DA,DD,DO,OLDMOD,OLDDXS,ECX
End DoDot:1
QUIT
+12 SET DA=ECFN
SET DIK="^ECH("
DO ^DIK
KILL DA,DIK
+13 ;134 Delete record from table
DO TABLE("D",ECFN)
+14 QUIT
MSG ;Record not filed
+1 SET ^TMP($JOB,"ECMSG",1)="0^Record not Filed"
+2 QUIT
CHKDT(FLG) ;Required Data Check
+1 NEW I,C
+2 SET C=1
+3 IF FLG=1
Begin DoDot:1
+4 FOR I="ECD","ECC","ECL","ECDT","ECP","ECDFN","ECMN","ECDUZ","ECPTSTAT"
Begin DoDot:2
+5 IF $GET(@I)=""
SET ^TMP($JOB,"ECMSG",C)="0^Key data missing "_I
SET C=C+1
SET ECERR=1
End DoDot:2
+6 IF $GET(ECDEL)
IF $DATA(ECIEN)
KILL ^TMP($JOB,"ECMSG")
SET ECERR=0
End DoDot:1
QUIT
+7 ;check PCE data
+8 IF FLG=2
Begin DoDot:1
+9 FOR I="EC4","ECDX"
Begin DoDot:2
+10 IF $GET(@I)=""
SET ^TMP($JOB,"ECMSG",C)="0^Key PCE data missing "_I
SET C=C+1
SET ECERR=1
End DoDot:2
QUIT
End DoDot:1
QUIT
+11 QUIT
VALDATA ;validate data
+1 NEW ECRRX
+2 DO CHK^DIE(721,1,,"`"_ECDFN,.ECRRX)
IF ECRRX'=ECDFN
Begin DoDot:1
+3 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Patient"
End DoDot:1
QUIT
+4 DO CHK^DIE(721,2,,ECDT,.ECRRX)
IF ECRRX'=ECDT
Begin DoDot:1
+5 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Procedure Date"
End DoDot:1
QUIT
+6 DO CHK^DIE(721,3,,"`"_ECL,.ECRRX)
IF ECRRX'=ECL
Begin DoDot:1
+7 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Location"
End DoDot:1
QUIT
+8 DO CHK^DIE(721,6,,"`"_ECD,.ECRRX)
IF ECRRX'=ECD
Begin DoDot:1
+9 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid DSS Unit"
End DoDot:1
QUIT
+10 DO CHK^DIE(721,7,,"`"_ECC,.ECRRX)
IF ECRRX'=ECC
Begin DoDot:1
+11 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Category"
End DoDot:1
QUIT
+12 Begin DoDot:1
+13 IF ECP["ICPT"
SET ECRRX=$$CPT^ICPTCOD(+ECP,ECDT)
IF +ECRRX>0
IF $PIECE(ECRRX,U,7)
QUIT
+14 IF ECP["EC"
IF $DATA(^EC(725,+ECP,0))
QUIT
+15 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Procedure"
End DoDot:1
IF ECERR
QUIT
+16 DO CHK^DIE(721,11,,"`"_ECMN,.ECRRX)
IF ECRRX'=ECMN
Begin DoDot:1
+17 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Ordering Section"
End DoDot:1
QUIT
+18 DO CHK^DIE(721,20,,"`"_ECDX,.ECRRX)
IF ECRRX'=ECDX
Begin DoDot:1
+19 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Primary Diagnosis"
End DoDot:1
QUIT
+20 IF $GET(EC4)'=""
DO CHK^DIE(721,26,,"`"_EC4,.ECRRX)
IF ECRRX'=EC4
Begin DoDot:1
+21 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Associated Clinic"
End DoDot:1
QUIT
+22 QUIT
+23 ;
CVTREAS ;119 Section added to convert procedure reason IEN in 720.4 to EC Code Screen/Procedure reason link in file 720.5.
+1 NEW SCREEN,SCREENID,I
+2 ;creates event code screen
SET SCREEN=ECL_"-"_ECD_"-"_+$GET(ECC,0)_"-"_ECP
+3 ;event code screen doesn't exist
SET SCREENID=$ORDER(^ECJ("B",SCREEN,0))
IF '+SCREENID
SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Event Code Screen"
QUIT
+4 FOR I="ECPXREAS","ECPXREA2","ECPXREA3"
IF $GET(@I)
SET @I=$$GETVAL(SCREENID,@I)
+5 QUIT
GETVAL(SCREENO,REASNO) ;119 section added to get link from 720.5 or add it if necessary
+1 NEW LINK,DIC,X,Y
+2 SET LINK=$ORDER(^ECL("AD",SCREENO,REASNO,0))
+3 ;Entry in 720.5 exists, return IEN
IF $GET(LINK)
QUIT LINK
+4 SET DIC="^ECL("
SET DIC(0)=""
SET X=REASNO
SET DIC("DR")=".02////"_SCREENO
+5 KILL DD,DO
DO FILE^DICN
+6 ;New IEN or null if not added
SET LINK=$SELECT(+Y:+Y,1:"")
+7 QUIT LINK
+8 ;
TABLE(OPTION,RECNO) ;134 Section added to add/delete state home records from XTMP table.
+1 ;Don't start table maintenance until related patch in DSS is installed.
IF '$$PATCH^XPDUTL("ECX*3.0*166")
QUIT
+2 IF $GET(OPTION)=""!($GET(RECNO)="")
QUIT
+3 ;add to table
IF $GET(OPTION)="A"
SET ^XTMP("ECEFPAT",RECNO)=""
+4 ;delete from table
IF $GET(OPTION)="D"
KILL ^XTMP("ECEFPAT",RECNO)
+5 SET ^XTMP("ECEFPAT",0)=$$FMADD^XLFDT($$DT^XLFDT,180)_"^"_$$DT^XLFDT_"^"_"Event capture state home records"
+6 QUIT
+7 ;
STAT() ;139 Returns status of record
+1 NEW LED
+2 ;Set last extract date to midnight of that day
SET LED=$$LED+.24
+3 IF ECDT'>LED
QUIT "LATE"
+4 QUIT ""
+5 ;
LED() ;139 Determine last extract date for Event Capture
+1 NEW LAST,EXTNO,EXTNOLED
+2 ;Get extract number associated with last extract date
SET EXTNO=$PIECE($GET(^XTMP("EC LED",0)),U,4)
+3 FOR
SET EXTNO=$ORDER(^ECX(727,"D","EVENT CAPTURE",EXTNO))
if '+EXTNO
QUIT
Begin DoDot:1
+4 ;Get end date for extract
SET EXTNOLED=$$GET1^DIQ(727,EXTNO,4,"I")
+5 ;Get last extract date if stored
SET LAST=$PIECE($GET(^XTMP("EC LED",0)),U,5)
+6 ;If extract end date is later than current last date then update
IF EXTNOLED'<LAST
Begin DoDot:2
+7 SET ^XTMP("EC LED",0)=$$FMADD^XLFDT($$DT^XLFDT,180)_"^"_$$DT^XLFDT_"^"_"Last event capture extract date"_"^"_EXTNO_"^"_EXTNOLED
End DoDot:2
End DoDot:1
+8 ;Return last extract date
QUIT +$PIECE($GET(^XTMP("EC LED",0)),U,5)
+9 ;
OOSCLIN ;139 Create an OOS related clinic for a location and DSS unit when DSS unit is an OOS type
+1 NEW CLNAME,STOP,ECCLN
+2 ;Get stop code for DSS unit
SET STOP=$$GET1^DIQ(40.7,+$PIECE(^ECD(ECD,0),U,10),1)
+3 ;Create clinic name as EC_STA6_OOS_Stop code number
SET CLNAME="EC "_$$GET1^DIQ(4,ECL,99)_" OOS "_STOP
+4 ;If clinic exists, skip creation
SET EC4=+$$FIND1^DIC(44,"","X",CLNAME)
IF EC4
QUIT
+5 SET ECCLN=$$LOC^SCDXUAPI(CLNAME,ECL,STOP,"EC")
+6 ;Set EC4 (clinic) to newly created clinic
SET EC4=+ECCLN
+7 QUIT
