152 lines
5.6 KiB
Mathematica
152 lines
5.6 KiB
Mathematica
ECUTL2 ;ALB/JAM - Event Capture Diagnosis Code Selection ;11 Jan 2000
|
|
;;2.0; EVENT CAPTURE ;**23,33,47,63,72**;8 May 96
|
|
DIAG ;ask dx question (primary and multiple secondary)
|
|
;check for primary dx and display message
|
|
D PDXMSG
|
|
;ask for primary dx
|
|
D PDX I ECOUT Q
|
|
;ask for secondary dx
|
|
D SDX I ECOUT Q
|
|
I $D(DTOUT)!$D(DUOUT) W:$P(ECPCE,"~",2)'="N" !!,"Please note that this record cannot be sent to PCE without a diagnosis.",!!
|
|
Q
|
|
PDXMSG ; Check for existence of primary diagnoses and display message
|
|
N TXT,ECPDX
|
|
S (ECDX,ECDXN,ECDXO)="" K ECDXS
|
|
;Check if primary dx exist in file #721
|
|
S ECPDX=$$PDXCK(ECDFN,ECDT,ECL,EC4)
|
|
I +ECPDX W ! D
|
|
. W !?5,"WARNING: Primary Diagnoses already on File for this encounter."
|
|
. W !?5,"If changed, all procedures will be updated. ("_ECDXN_")"
|
|
. S ECDXO=ECDX
|
|
I $P(ECPDX,U,2) D
|
|
. S TXT="WARNING: Primary diagnoses already sent to PCE. If changed,"
|
|
. S TXT=TXT_" all procedures"
|
|
. W !!?5,TXT
|
|
. S TXT="associated with this encounter will be updated and resent "
|
|
. S TXT=TXT_"to PCE."
|
|
. W !?5,TXT
|
|
Q
|
|
PDXCK(ECDFN,ECDTX,ECLX,EC4X) ;Get primary dx frm file #721 for pat encounter
|
|
; Input: ECDFN = Patient ien
|
|
; ECDTX = Date/time of procedure
|
|
; ECLX = Location ien
|
|
; EC4X = Clinic ien
|
|
;
|
|
; Output: PDXF^PCEF = primary dx flag (1/0)^dx sent to PCE flag (1/0)
|
|
; ECDX = Primary diagnoses ien
|
|
; ECDXN = Primary diagnoses code
|
|
; ECDXIEN = Array of encounter IENs w primary dx
|
|
;
|
|
N PDXF,PCEF,DA,DXIEN,DXS,DXN
|
|
S (PDXF,PCEF)=0,DA="" K ECDXIEN
|
|
I $G(ECDFN)=""!($G(ECDTX)="")!($G(ECLX)="")!($G(EC4X)="") Q PDXF_U_PCEF
|
|
I $O(^ECH("APAT",ECDFN,ECDTX,""))="" Q PDXF_U_PCEF
|
|
F S DA=$O(^ECH("APAT",ECDFN,ECDTX,DA)) Q:DA="" D
|
|
. I EC4X'=$P($G(^ECH(DA,0)),U,19) Q
|
|
. S ECDX=$P($G(^ECH(DA,"P")),U,2) I ECDX="" Q
|
|
. S ECDXN=$P($$ICDDX^ICDCODE(ECDX,ECDTX),U,2)
|
|
. S ECDXIEN(DA)=ECDXN_U_ECDX,PDXF=1
|
|
. I $D(^ECH(DA,"SEND")),^("SEND")="" S PCEF=1
|
|
. I $D(^ECH(DA,"DX")) D
|
|
. . S DXS=0 F S DXS=$O(^ECH(DA,"DX",DXS)) Q:'DXS D
|
|
...S DXIEN=$P($G(^ECH(DA,"DX",DXS,0)),U)
|
|
...S DXN=$P($$ICDDX^ICDCODE(DXIEN,ECDTX),U,2) S:DXN'="" ECDXS(DXN)=DXIEN
|
|
Q PDXF_U_PCEF
|
|
PDX ;Ask primary diagnoses code
|
|
; Variables: ECDX = Primary diagnoses ien
|
|
; ECDXN = Primary diagnoses code, default if define
|
|
; ECOUT = Error flag (1/0)
|
|
;
|
|
N DIC,X,Y,DTOUT,DUOUT,DEFX,ECODE,PROMPT
|
|
S ECDX=$G(ECDX),ECDXN=$G(ECDXN),PROMPT="Primary ICD-9 Code: "
|
|
S:ECDXN'="" DEFX=ECDXN
|
|
F D LEX Q:$G(ECOUT) D I $D(ECODE) Q
|
|
.I X="" W !,"This is a required response. Enter '^' to exit" Q
|
|
.S ECDXN=ECODE,ECDX=+$$ICDDX^ICDCODE(ECODE,$G(ECDT))
|
|
Q
|
|
SDX ;Ask secondary diagnoses code
|
|
; Variables: ECDX = Primary diagnoses ien, default if define
|
|
; ECDXN = Primary diagnoses code
|
|
; ECOUT = Error flag (1/0)
|
|
; ECDXS = Array with secondary diagnosis code
|
|
; subscript=dx code and set equal to dx ien
|
|
;
|
|
N Y,X,DEFX,DIC,DTOUT,DUOUT,ECODE
|
|
S ECOUT=$G(ECOUT),PROMPT="Secondary ICD-9 Code: "
|
|
F D LSTDXS,LEX Q:Y<0 D I ECOUT Q
|
|
.I ECODE="" Q
|
|
.I ECODE=$G(ECDXN) W " Already exist as primary dx." Q
|
|
.I $D(ECDXS(ECODE)) D DELDUP Q
|
|
.S ECDXS(ECODE)=+$$ICDDX^ICDCODE(ECODE,$G(ECDT))
|
|
Q
|
|
DELDUP ;Delete secondary diagnosis code from list
|
|
N DIR,DIRUT,DTOUT,DUOUT,DIROUT
|
|
S DIR("A")="Delete "_ECODE_" Code from List"
|
|
S DIR(0)="Y"
|
|
D ^DIR
|
|
I $D(DIRUT)!($D(DIROUT)) S ECOUT=1 Q
|
|
I Y K ECDXS(ECODE)
|
|
Q
|
|
LEX ;ICD code from LEX database
|
|
;K X,Y
|
|
S X=$G(DEFX)
|
|
;LEX DBIA1577
|
|
D CONFIG^LEXSET("ICD",,$G(ECDT))
|
|
S DIC="757.01",DIC(0)=$S('$L($G(X)):"A",1:"")_"EQM",DIC("A")=PROMPT
|
|
D ^DIC
|
|
I $D(DTOUT)!$D(DUOUT) S ECOUT=1 Q
|
|
I X="" Q
|
|
I Y<0 S ECOUT=1 Q
|
|
S ECODE=$G(Y(1))
|
|
Q
|
|
LSTDXS ;list icd9-code
|
|
N DXS
|
|
I $D(ECDXS) D
|
|
. W !?1,"Secondary ICD-9 code entered:"
|
|
. S DXS=""
|
|
. F S DXS=$O(ECDXS(DXS)) Q:DXS="" W !,?4,DXS,?15,$P($$ICDDX^ICDCODE(DXS,$G(ECDT)),"^",4)
|
|
Q
|
|
PXUPD(ECDFN,ECDT,ECL,EC4,ECDXP,ECDXX,ECXIEN) ; Update all associated
|
|
; procedures for an EC Patient encounter with the same primary and
|
|
; secondary dx codes
|
|
;
|
|
; Input: ECDFN = Patient ien
|
|
; ECDT = Date/time of procedure
|
|
; ECL = Location ien
|
|
; EC4 = Clinic ien
|
|
; ECDXP = Primary diagnoses code
|
|
; ECDXX = Array of secondary diagnoses codes
|
|
; ECXIEN = 721 ien, if define don't process
|
|
;
|
|
; Output: ECERR 0 - Process completed
|
|
;
|
|
N ECIEN,ECERR,DIE,DR,DA,DTOUT,DIROUT,ECDXIEN,ECPDX,ECDX,ECDXN,DIC,X
|
|
N ECVST,ECVAR1,VALQUIET,DXN,DXSIEN,DIK,ECDXS
|
|
S ECERR=0
|
|
I $D(ECDXP)="" Q ECERR
|
|
S ECPDX=$$PDXCK(ECDFN,ECDT,ECL,EC4)
|
|
I '$D(ECDXIEN) Q ECERR
|
|
S ECIEN="",DIE="^ECH("
|
|
F S ECIEN=$O(ECDXIEN(ECIEN)) Q:ECIEN="" D
|
|
. I $G(ECXIEN)'="",ECXIEN=ECIEN Q
|
|
. S ECNODE=$G(^ECH(ECIEN,"P")) I ECNODE="" Q
|
|
. I ECDXP'=$P(ECNODE,U,2) D
|
|
. . S DA=ECIEN,DR="20////"_ECDXP D ^DIE
|
|
. . S $P(^ECH(ECIEN,"PCE"),"~",11)=ECDXP
|
|
. ;delete all secondary diagnosis codes
|
|
. S DA(1)=ECIEN,DIK="^ECH("_DA(1)_",""DX"",",DA=0
|
|
. F S DA=$O(^ECH(ECIEN,"DX",DA)) Q:'DA D ^DIK
|
|
. I $D(^ECH(ECIEN,"DX")) K ^ECH(ECIEN,"DX")
|
|
. ;update secondary diagnosis codes on procedure
|
|
. S DXN="" F S DXN=$O(ECDXX(DXN)) Q:DXN="" D
|
|
. . S DXSIEN=$P(ECDXX(DXN),U) 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
|
|
. ;delete visit and resend to PCE
|
|
. S ECVST=+$P($G(^ECH(ECIEN,0)),"^",21) I 'ECVST Q
|
|
. ;* Prepare all EC records with same Visit file entry to resend to PCE
|
|
. S ECVAR1=$$FNDVST^ECUTL(ECVST)
|
|
. ;- Set VALQUIET to stop Amb Care validator from broadcasting to screen
|
|
. S VALQUIET=1,ECVV=$$DELVFILE^PXAPI("ALL",ECVST)
|
|
Q ECERR
|