ECUERPC1 ;ALB/JAM - Event Capture Data Entry Broker Util ;1/24/12 16:19
;;2.0;EVENT CAPTURE;**25,33,42,46,47,54,72,76,110,112,114**;8 May 96;Build 20
;
; Reference to $$SINFO^ICDEX supported by ICR #5747
; Reference to $$ICDDX^ICDEX supported by ICR5747
;
PATINF(RESULTS,ECARY) ;
;Broker entry point to get various types of data from EVENT CAPTURE
;PATIENT FILE #721
; RPC: EC GETPATINFO
;INPUTS ECARY - Contains the following subscripted elements
; ECIEN - Event Capture Patient ien
; ECTYP - Data type to return
;
;OUTPUTS RESULTS - Array of Event Capture Patient data
;
N ECTYP,ECIEN
S ECARY=$G(ECARY),ECIEN=$P(ECARY,U),ECTYP=$P(ECARY,U,2) I ECIEN="" Q
I '$D(^ECH(ECIEN)) Q
D SETENV^ECUMRPC
I ECTYP="DXS" D PATDXS(ECIEN) Q
I ECTYP="MOD" D PATMOD(ECIEN) Q
I ECTYP="CLASS" D PATCLASS(ECIEN) Q
I ECTYP="OTH" D PATOTH(ECIEN) Q
I ECTYP="PRV" D PATPRV^ECUERPC2(ECIEN) Q
Q
PATDXS(ECIEN) ;
;Returns to broker a patient secondary DXs entries from EVENT
;CAPTURE PATIENT FILE #721
;INPUTS ECIEN - Event Capture Patient ien
;
;OUTPUTS RESULTS - Array of Event Capture Patient file contains
; 721 IEN^secondary dx ien #80^secondary dx code^dx description (ICD Code Set)
;
N CNT,DXS,DXSIEN,DXSD,ECCS,ECDT
I '$D(^ECH(ECIEN,"DX")) Q
K ^TMP($J,"ECDXS")
S (CNT,DXS)=0 F S DXS=$O(^ECH(ECIEN,"DX",DXS)) Q:'DXS D
. S DXSIEN=$G(^ECH(ECIEN,"DX",DXS,0)) I DXSIEN="" Q
. ; ICD10 Changes
. S ECDT=$P($G(^ECH(ECIEN,0)),U,3) ; DATE/TIME OF PROCEDURE field (#2)
. ; Determine Active Coding System Based on Date of Interest
. S ECCS=$$SINFO^ICDEX("DIAG",ECDT)
. ; Load the ICD code info
. S DXSD=$$ICDDX^ICDEX(DXSIEN,ECDT,+ECCS,"I") ; Supported by ICR 5747
. S ECCS=$P(ECCS,U,2),ECCS=" ("_$P(ECCS,"-",1)_$P(ECCS,"-",2)_")"
. S DXSD=$P(DXSD,U,2)_" "_$P(DXSD,U,4)_ECCS
. S CNT=CNT+1,^TMP($J,"ECDXS",CNT)=ECIEN_U_DXSIEN_U_DXSD
S RESULTS=$NA(^TMP($J,"ECDXS"))
Q
PATMOD(ECIEN) ;
;Returns to broker a patient procedure modifier from EVENT CAPTURE
;PATIENT FILE #721
;INPUTS ECIEN - Event Capture Patient ien
;
;OUTPUTS RESULTS - Array of procedure modifiers
; 721 IEN^modifier ien #81.3^modifier^modifier name
;
N MOD,MODIEN,CNT,MODS
I '$D(^ECH(ECIEN,"MOD")) Q
K ^TMP($J,"ECMOD")
S (CNT,MOD)=0 F S MOD=$O(^ECH(ECIEN,"MOD",MOD)) Q:'MOD D
. S MODIEN=$G(^ECH(ECIEN,"MOD",MOD,0)) I MODIEN="" Q
. S MODS=$$MOD^ICPTMOD(MODIEN,"I",$P($G(^ECH(ECIEN,0)),U,3)) I +MODS<0 Q
. S CNT=CNT+1
. S ^TMP($J,"ECMOD",CNT)=ECIEN_U_$P(MODS,U,1,2)_" "_$P(MODS,U,3)
S RESULTS=$NA(^TMP($J,"ECMOD"))
Q
PATCLASS(ECIEN) ;
;Returns to broker a patient classification & eligibility data from
;EVENT CAPTURE PATIENT FILE #721
; INPUTS ECIEN - Event Capture Patient ien
; OUTPUTS RESULTS - Array of procedure modifiers
; 721 IEN^agent orange^radiation exposure^service connect^environmental
; contaminants/SWAC^military sexual trauma^eligibility code #8^
; eligibility description^head/neck cancer^combat veteran^P112/SHAD
;
N CLA,ELIG,ELCOD,ECAO,ECIR,ECEC,ECSC,ECMST,STR,ECHNC,ECCV,ECSHAD
I '$D(^ECH(ECIEN,"P")),'$D(^ECH(ECIEN,"PCE")) Q
K ^TMP($J,"ECLASS")
S ELIG=$P($G(^ECH(ECIEN,"PCE")),"~",17),ELCOD="",CLA=$G(^ECH(ECIEN,"P"))
S:ELIG'="" ELCOD=$P($G(^DIC(8,ELIG,0)),U)
S ECAO=$P(CLA,U,3),ECIR=$P(CLA,U,4),ECEC=$P(CLA,U,5),ECSC=$P(CLA,U,6)
S ECMST=$P(CLA,U,9),ECHNC=$P(CLA,U,10),ECCV=$P(CLA,U,11),ECSHAD=$P(CLA,U,12)
S STR=ECIEN_U_ECAO_U_ECIR_U_ECSC_U_ECEC_U_ECMST
S STR=STR_U_ELIG_U_ELCOD_U_ECHNC_U_ECCV_U_ECSHAD,^TMP($J,"ECLASS",1)=STR
S RESULTS=$NA(^TMP($J,"ECLASS"))
Q
PATOTH(ECIEN) ;
;Returns to broker a patient remaining data from EVENT CAPTURE
;PATIENT FILE #721
;INPUTS ECIEN - Event Capture Patient ien
;
;OUTPUTS RESULTS - Array of procedure modifiers
; 721 IEN^procedure reason
;
N REAS,ECX
K ^TMP($J,"ECOTH")
S ECX=^ECH(ECIEN,0)
D GETS^DIQ(721,ECIEN_",","34;43;44","E","REAS") ;112
S ^TMP($J,"ECOTH",1)=$G(REAS(721,ECIEN_",",34,"E"))_"^"_$G(REAS(721,ECIEN_",",43,"E"))_"^"_$G(REAS(721,ECIEN_",",44,"E")) ;112
S RESULTS=$NA(^TMP($J,"ECOTH"))
Q
PATCLAST(RESULTS,ECARY) ;
;Returns to broker a patient status (in/out) and classification
; RPC: EC GETPATCLASTAT
;INPUTS ECARY - Contains the following subscripted elements
; ECDFN - Patient ien (#2)
; ECD - DSS Unit ien (#724)
; ECDT - Procedure date and time (fileman format)
;OUTPUTS RESULTS - Patient status and classifications delimited by (^)
; Patient Status: I for inpatient or O for outpatient
; Classification: 2- Agent Orange, 3- Ionizing Radiation
; 4- SC Condition, 5- Environment Contaminants/SWAC 6- Military
; Sexual Trauma 7- Head/Neck Cancer 8- Combat Veteran
; 9- Project 112/SHAD
; Data after the '~' refers to those class. that must be asked
; by Delphi appl. when the answer to SC=No.
; Data after "~" 1- Agent Orange 2- Ionizing Radi. 3- Env Cont/SWAC
N ECDFN,ECDT,ECX,I,ECCLARY,SCDAT,PATSTAT,% ;112
D SETENV^ECUMRPC
S ECDFN=$P(ECARY,U),ECD=$P(ECARY,U,2),ECDT=$P(ECARY,U,3) Q:ECDFN=""
I ECDT="" D NOW^%DTC S ECDT=%
S PATSTAT=$$INOUTPT^ECUTL0(ECDFN,ECDT),RESULTS="^^^^^^",SCDAT=";;;"
;
; Removed in EC*110 so inpatient data can be answered for transmission to Austin
; This was to be consistent with VHA Directive 2009-002
;
; I PATSTAT="I" D Q
; .S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
I '$$CHKDSS^ECUTL0(+$G(ECD),PATSTAT) D Q
.S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
D CL^SDCO21(ECDFN,ECDT,"",.ECCLARY) F ECX=3,1,2,4,5,6,7,8 D
.I ECX=1,$P($G(^DPT(ECDFN,.321)),"^",2)'="Y" Q
.I ECX=2,$P($G(^DPT(ECDFN,.321)),"^",3)'="Y" Q
.I ECX=4,$P($G(^DPT(ECDFN,.322)),"^",13)'="Y",'$$EC^SDCO22(ECDFN,"") Q
.I ECX=3,$D(ECCLARY(ECX)) F I=1,2,4 S ECCLARY(I)="SC"
.I '$D(ECCLARY(ECX)) Q
.;Check SC, if answer to SC is NO then these questions will be asked
.I ECCLARY(ECX)="SC" S $P(SCDAT,";",ECX)="E"
.E S $P(RESULTS,"^",ECX)="E"
S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
Q
ENCDXS(RESULTS,ECARY) ;
;Broker call returns a patient encounter primary & secondary dx (#721)
; RPC: EC GETENCDXS
;INPUTS ECDFN - Patient ien (#2)
; ECDT - Procedure date and time (fileman format)
; ECL - Location ien
; EC4 - Clinic ien
;
;OUTPUTS RESULTS - array of patient encounter diagnosis
; primary/secondary flag^(ICD Code Set) DX ien^DX code DX description.
;
N ECDFN,ECDT,ECL,EC4,ECPDX,ECDX,ECDXN,ECDXS,CNT,STR,ECPDX,SDXCNT,% ;112
N ECCS,ECICD
D SETENV^ECUMRPC
K ^TMP($J,"ECENCDXS")
S ECDFN=$P(ECARY,U),ECDT=+$P(ECARY,U,2),ECL=$P(ECARY,U,3)
S EC4=$P(ECARY,U,4) I ECDT="" D NOW^%DTC S ECDT=%
I ECDFN=""!(ECL="")!(EC4="") Q
S (ECDX,ECDXN)="",ECPDX=$$PDXCK^ECUTL2(ECDFN,ECDT,ECL,EC4) I ECDX="" Q
; Changes for ICD10
; Determine Active Coding System Based on Date of Interest
S ECCS=$$SINFO^ICDEX("DIAG",ECDT) ; Supported by ICR 5747
; Load the ICD code info
S ECICD=$$ICDDX^ICDEX(ECDX,ECDT,+ECCS,"I") ; Supported by ICR 5747
S ECCS=$P(ECCS,U,2),ECCS=" ("_$P(ECCS,"-",1)_$P(ECCS,"-",2)_")"
S IEN="",STR=1_U_ECDX_U_ECDXN_" "_$P(ECICD,U,4)_ECCS
S CNT=1,^TMP($J,"ECENCDXS",CNT)=STR
;*ACS concat description to 2nd diag code, in the order entered by the user
F S IEN=$O(ECDXS(IEN)) Q:IEN="" D
. S ECICD=$$ICDDX^ICDEX(ECDXS(IEN),ECDT,+ECCS,"I") ; Supported by ICR 5747
. S CNT=CNT+1,^TMP($J,"ECENCDXS",CNT)=0_U_ECDXS(IEN)_U_IEN_" "_$P(ECICD,U,4)_ECCS
S RESULTS=$NA(^TMP($J,"ECENCDXS"))
Q
;
PROCBAT(RESULTS,ECARY) ;
;Broker call returns the entries from EVENT CAPTURE PATIENT FILE #721
;for patients for a specific procedure
; RPC: EC GETBATPROCS
;INPUTS ECARY - Contains the following subscripted elements
; ECLOC - Location ien
; ECUNT - DSS unit ien
; ECC - Category ien
; ECP - Procedure ien
; ECSD - Start Date
; ECED - End Date
;
;OUTPUTS RESULTS - Array of Event Capture Patient data containing:-
; 721 IEN^Patient name^Procedure Date/Time^(Primary Dx Code set) Primary Dx
; ^Ordering Section^Associated Clinic
; ^SSN^DOB^Procedure Date and Time
;
N IEN,CNT,ECCS,ECLOC,ECUNT,NODE,DATA,PXDT,ECV,ECC,ECP,ECSD,ECED,DATE,DFN
N CAT,ECI,VADM,ORC,ASC,ECDX
S ECV="ECLOC^ECUNT^ECC^ECP^ECSD^ECED"
D PARSE^ECUERPC(ECV,ECARY)
I (ECLOC="")!(ECUNT="")!(ECC="")!(ECP="") Q
D SETENV^ECUMRPC K ^TMP($J,"ECBATPX") S CNT=0
S %DT="STX" F ECI="ECSD","ECED" S X=@ECI D ^%DT S @ECI=Y
S ECSD=$S(ECSD=-1:DT,1:ECSD)-.0001,ECED=$S(ECED=-1:DT,1:ECED)+.9999
Q:ECED'>ECSD S DATE=ECSD
F S DATE=$O(^ECH("AC1",ECLOC,DATE)) Q:'DATE!(DATE>ECED) S IEN=0 D
. F S IEN=$O(^ECH("AC1",ECLOC,DATE,IEN)) Q:'IEN D
. . S NODE=$G(^ECH(IEN,0)) Q:NODE="" Q:$P(NODE,U,7)'=ECUNT
. . Q:$P(NODE,U,8)'=ECC Q:$P(NODE,U,9)'=ECP
. . S ECDX=$P($G(^ECH(IEN,"P")),U,2) I ECDX'="" D
. . . ; Updates for ICD10
. . . ; Load the ICD code info
. . . S ECCS=$$SINFO^ICDEX("DIAG",DATE) ; Supported by ICR 5747
. . . ; Load the ICD code info
. . . S ECDX=$$ICDDX^ICDEX(ECDX,DATE,+ECCS,"I") ; Supported by ICR 5747
. . . S ECCS=$P(ECCS,U,2),ECCS=" ("_$P(ECCS,"-",1)_$P(ECCS,"-",2)_")"
. . . S ECDX=$P(ECDX,U,2)_" "_$P(ECDX,U,4)_ECCS
. . S ASC=$P(NODE,U,19) S:ASC'="" ASC=$$GET1^DIQ(44,ASC,.01,"I")
. . S ORC=$P(NODE,U,12) S:ORC'="" ORC=$$GET1^DIQ(723,ORC,.01,"I")
. . S Y=DATE X ^DD("DD") S PXDT=Y,DFN=$P(NODE,U,2) D DEM^VADPT
. . S DATA=$E(VADM(1),1,30)_U_PXDT_U_ECDX_U_ORC_U_ASC
. . S CNT=CNT+1,^TMP($J,"ECBATPX",CNT)=IEN_U_DATA
S RESULTS=$NA(^TMP($J,"ECBATPX"))
Q
;
CLHLP(RESULTS,ECARY) ;RPC Broker entry point for classification help
; RPC: EC CLASHELP
;INPUTS ECARY - Contains the following elements for report printing
; ECDFN - Patient DFN from file (#2)
; ECKY - Key to provide help on
;
;OUTPUTS RESULTS - Array of help text for classification
;
N ECFILER,ECERR,ECDIRY,ECUFILE,ECDFN,ECKY,ECHNDL
D SETENV^ECUMRPC
K ^TMP("ECMSG",$J)
S ECERR=0,ECDFN=$P(ECARY,U),ECKY=$P(ECARY,U,2) D I ECERR D CLEND Q
.I ECDFN="" S ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not defined" Q
.I ECKY="" S ECERR=1,^TMP("ECMSG",$J,1)="0^Help Key not defined" Q
.S DIC=2,DIC(0)="NMZX",X=ECDFN D ^DIC I Y<0 D
..S ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not found"
S ECHNDL="ECLASHLP" D HFSOPEN^ECRRPC(ECHNDL) I ECERR D CLEND Q
U IO
I ECKY="SC" D SC^SDCO23(ECDFN)
D HFSCLOSE^ECRRPC(ECFILER)
CLEND ;
I $D(^TMP("ECMSG",$J)) S RESULTS=$NA(^TMP("ECMSG",$J)) Q
S RESULTS=$NA(^TMP($J))
Q
ECDEF(RESULTS,ECARY) ;RPC Broker entry point to get a default for space bar
; RPC: EC SPACEBAR
;INPUTS ECARY - Contains the following elements for report printing
; ECFILE - File to obtain value from
;
;OUTPUTS RESULTS - IEN^Description of Text
;
N DIC,ECFILE,X,Y
D SETENV^ECUMRPC
S ECFILE=$P(ECARY,U)
I ECFILE="" S ECERR=1,RESULTS="0^File not defined" Q
S X=" ",DIC(0)="MZX",DIC=ECFILE D ^DIC I Y<0 D I ECERR Q
. S ECERR=1,RESULTS="0^Nothing found"
S RESULTS=Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUERPC1 11308 printed Oct 16, 2024@17:59:47 Page 2
ECUERPC1 ;ALB/JAM - Event Capture Data Entry Broker Util ;1/24/12 16:19
+1 ;;2.0;EVENT CAPTURE;**25,33,42,46,47,54,72,76,110,112,114**;8 May 96;Build 20
+2 ;
+3 ; Reference to $$SINFO^ICDEX supported by ICR #5747
+4 ; Reference to $$ICDDX^ICDEX supported by ICR5747
+5 ;
PATINF(RESULTS,ECARY) ;
+1 ;Broker entry point to get various types of data from EVENT CAPTURE
+2 ;PATIENT FILE #721
+3 ; RPC: EC GETPATINFO
+4 ;INPUTS ECARY - Contains the following subscripted elements
+5 ; ECIEN - Event Capture Patient ien
+6 ; ECTYP - Data type to return
+7 ;
+8 ;OUTPUTS RESULTS - Array of Event Capture Patient data
+9 ;
+10 NEW ECTYP,ECIEN
+11 SET ECARY=$GET(ECARY)
SET ECIEN=$PIECE(ECARY,U)
SET ECTYP=$PIECE(ECARY,U,2)
IF ECIEN=""
QUIT
+12 IF '$DATA(^ECH(ECIEN))
QUIT
+13 DO SETENV^ECUMRPC
+14 IF ECTYP="DXS"
DO PATDXS(ECIEN)
QUIT
+15 IF ECTYP="MOD"
DO PATMOD(ECIEN)
QUIT
+16 IF ECTYP="CLASS"
DO PATCLASS(ECIEN)
QUIT
+17 IF ECTYP="OTH"
DO PATOTH(ECIEN)
QUIT
+18 IF ECTYP="PRV"
DO PATPRV^ECUERPC2(ECIEN)
QUIT
+19 QUIT
PATDXS(ECIEN) ;
+1 ;Returns to broker a patient secondary DXs entries from EVENT
+2 ;CAPTURE PATIENT FILE #721
+3 ;INPUTS ECIEN - Event Capture Patient ien
+4 ;
+5 ;OUTPUTS RESULTS - Array of Event Capture Patient file contains
+6 ; 721 IEN^secondary dx ien #80^secondary dx code^dx description (ICD Code Set)
+7 ;
+8 NEW CNT,DXS,DXSIEN,DXSD,ECCS,ECDT
+9 IF '$DATA(^ECH(ECIEN,"DX"))
QUIT
+10 KILL ^TMP($JOB,"ECDXS")
+11 SET (CNT,DXS)=0
FOR
SET DXS=$ORDER(^ECH(ECIEN,"DX",DXS))
if 'DXS
QUIT
Begin DoDot:1
+12 SET DXSIEN=$GET(^ECH(ECIEN,"DX",DXS,0))
IF DXSIEN=""
QUIT
+13 ; ICD10 Changes
+14 ; DATE/TIME OF PROCEDURE field (#2)
SET ECDT=$PIECE($GET(^ECH(ECIEN,0)),U,3)
+15 ; Determine Active Coding System Based on Date of Interest
+16 SET ECCS=$$SINFO^ICDEX("DIAG",ECDT)
+17 ; Load the ICD code info
+18 ; Supported by ICR 5747
SET DXSD=$$ICDDX^ICDEX(DXSIEN,ECDT,+ECCS,"I")
+19 SET ECCS=$PIECE(ECCS,U,2)
SET ECCS=" ("_$PIECE(ECCS,"-",1)_$PIECE(ECCS,"-",2)_")"
+20 SET DXSD=$PIECE(DXSD,U,2)_" "_$PIECE(DXSD,U,4)_ECCS
+21 SET CNT=CNT+1
SET ^TMP($JOB,"ECDXS",CNT)=ECIEN_U_DXSIEN_U_DXSD
End DoDot:1
+22 SET RESULTS=$NAME(^TMP($JOB,"ECDXS"))
+23 QUIT
PATMOD(ECIEN) ;
+1 ;Returns to broker a patient procedure modifier from EVENT CAPTURE
+2 ;PATIENT FILE #721
+3 ;INPUTS ECIEN - Event Capture Patient ien
+4 ;
+5 ;OUTPUTS RESULTS - Array of procedure modifiers
+6 ; 721 IEN^modifier ien #81.3^modifier^modifier name
+7 ;
+8 NEW MOD,MODIEN,CNT,MODS
+9 IF '$DATA(^ECH(ECIEN,"MOD"))
QUIT
+10 KILL ^TMP($JOB,"ECMOD")
+11 SET (CNT,MOD)=0
FOR
SET MOD=$ORDER(^ECH(ECIEN,"MOD",MOD))
if 'MOD
QUIT
Begin DoDot:1
+12 SET MODIEN=$GET(^ECH(ECIEN,"MOD",MOD,0))
IF MODIEN=""
QUIT
+13 SET MODS=$$MOD^ICPTMOD(MODIEN,"I",$PIECE($GET(^ECH(ECIEN,0)),U,3))
IF +MODS<0
QUIT
+14 SET CNT=CNT+1
+15 SET ^TMP($JOB,"ECMOD",CNT)=ECIEN_U_$PIECE(MODS,U,1,2)_" "_$PIECE(MODS,U,3)
End DoDot:1
+16 SET RESULTS=$NAME(^TMP($JOB,"ECMOD"))
+17 QUIT
PATCLASS(ECIEN) ;
+1 ;Returns to broker a patient classification & eligibility data from
+2 ;EVENT CAPTURE PATIENT FILE #721
+3 ; INPUTS ECIEN - Event Capture Patient ien
+4 ; OUTPUTS RESULTS - Array of procedure modifiers
+5 ; 721 IEN^agent orange^radiation exposure^service connect^environmental
+6 ; contaminants/SWAC^military sexual trauma^eligibility code #8^
+7 ; eligibility description^head/neck cancer^combat veteran^P112/SHAD
+8 ;
+9 NEW CLA,ELIG,ELCOD,ECAO,ECIR,ECEC,ECSC,ECMST,STR,ECHNC,ECCV,ECSHAD
+10 IF '$DATA(^ECH(ECIEN,"P"))
IF '$DATA(^ECH(ECIEN,"PCE"))
QUIT
+11 KILL ^TMP($JOB,"ECLASS")
+12 SET ELIG=$PIECE($GET(^ECH(ECIEN,"PCE")),"~",17)
SET ELCOD=""
SET CLA=$GET(^ECH(ECIEN,"P"))
+13 if ELIG'=""
SET ELCOD=$PIECE($GET(^DIC(8,ELIG,0)),U)
+14 SET ECAO=$PIECE(CLA,U,3)
SET ECIR=$PIECE(CLA,U,4)
SET ECEC=$PIECE(CLA,U,5)
SET ECSC=$PIECE(CLA,U,6)
+15 SET ECMST=$PIECE(CLA,U,9)
SET ECHNC=$PIECE(CLA,U,10)
SET ECCV=$PIECE(CLA,U,11)
SET ECSHAD=$PIECE(CLA,U,12)
+16 SET STR=ECIEN_U_ECAO_U_ECIR_U_ECSC_U_ECEC_U_ECMST
+17 SET STR=STR_U_ELIG_U_ELCOD_U_ECHNC_U_ECCV_U_ECSHAD
SET ^TMP($JOB,"ECLASS",1)=STR
+18 SET RESULTS=$NAME(^TMP($JOB,"ECLASS"))
+19 QUIT
PATOTH(ECIEN) ;
+1 ;Returns to broker a patient remaining data from EVENT CAPTURE
+2 ;PATIENT FILE #721
+3 ;INPUTS ECIEN - Event Capture Patient ien
+4 ;
+5 ;OUTPUTS RESULTS - Array of procedure modifiers
+6 ; 721 IEN^procedure reason
+7 ;
+8 NEW REAS,ECX
+9 KILL ^TMP($JOB,"ECOTH")
+10 SET ECX=^ECH(ECIEN,0)
+11 ;112
DO GETS^DIQ(721,ECIEN_",","34;43;44","E","REAS")
+12 ;112
SET ^TMP($JOB,"ECOTH",1)=$GET(REAS(721,ECIEN_",",34,"E"))_"^"_$GET(REAS(721,ECIEN_",",43,"E"))_"^"_$GET(REAS(721,ECIEN_",",44,"E"))
+13 SET RESULTS=$NAME(^TMP($JOB,"ECOTH"))
+14 QUIT
PATCLAST(RESULTS,ECARY) ;
+1 ;Returns to broker a patient status (in/out) and classification
+2 ; RPC: EC GETPATCLASTAT
+3 ;INPUTS ECARY - Contains the following subscripted elements
+4 ; ECDFN - Patient ien (#2)
+5 ; ECD - DSS Unit ien (#724)
+6 ; ECDT - Procedure date and time (fileman format)
+7 ;OUTPUTS RESULTS - Patient status and classifications delimited by (^)
+8 ; Patient Status: I for inpatient or O for outpatient
+9 ; Classification: 2- Agent Orange, 3- Ionizing Radiation
+10 ; 4- SC Condition, 5- Environment Contaminants/SWAC 6- Military
+11 ; Sexual Trauma 7- Head/Neck Cancer 8- Combat Veteran
+12 ; 9- Project 112/SHAD
+13 ; Data after the '~' refers to those class. that must be asked
+14 ; by Delphi appl. when the answer to SC=No.
+15 ; Data after "~" 1- Agent Orange 2- Ionizing Radi. 3- Env Cont/SWAC
+16 ;112
NEW ECDFN,ECDT,ECX,I,ECCLARY,SCDAT,PATSTAT,%
+17 DO SETENV^ECUMRPC
+18 SET ECDFN=$PIECE(ECARY,U)
SET ECD=$PIECE(ECARY,U,2)
SET ECDT=$PIECE(ECARY,U,3)
if ECDFN=""
QUIT
+19 IF ECDT=""
DO NOW^%DTC
SET ECDT=%
+20 SET PATSTAT=$$INOUTPT^ECUTL0(ECDFN,ECDT)
SET RESULTS="^^^^^^"
SET SCDAT=";;;"
+21 ;
+22 ; Removed in EC*110 so inpatient data can be answered for transmission to Austin
+23 ; This was to be consistent with VHA Directive 2009-002
+24 ;
+25 ; I PATSTAT="I" D Q
+26 ; .S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
+27 IF '$$CHKDSS^ECUTL0(+$GET(ECD),PATSTAT)
Begin DoDot:1
+28 SET RESULTS=PATSTAT_"^"_RESULTS_$SELECT(SCDAT'="":"~"_SCDAT,1:"")
End DoDot:1
QUIT
+29 DO CL^SDCO21(ECDFN,ECDT,"",.ECCLARY)
FOR ECX=3,1,2,4,5,6,7,8
Begin DoDot:1
+30 IF ECX=1
IF $PIECE($GET(^DPT(ECDFN,.321)),"^",2)'="Y"
QUIT
+31 IF ECX=2
IF $PIECE($GET(^DPT(ECDFN,.321)),"^",3)'="Y"
QUIT
+32 IF ECX=4
IF $PIECE($GET(^DPT(ECDFN,.322)),"^",13)'="Y"
IF '$$EC^SDCO22(ECDFN,"")
QUIT
+33 IF ECX=3
IF $DATA(ECCLARY(ECX))
FOR I=1,2,4
SET ECCLARY(I)="SC"
+34 IF '$DATA(ECCLARY(ECX))
QUIT
+35 ;Check SC, if answer to SC is NO then these questions will be asked
+36 IF ECCLARY(ECX)="SC"
SET $PIECE(SCDAT,";",ECX)="E"
+37 IF '$TEST
SET $PIECE(RESULTS,"^",ECX)="E"
End DoDot:1
+38 SET RESULTS=PATSTAT_"^"_RESULTS_$SELECT(SCDAT'="":"~"_SCDAT,1:"")
+39 QUIT
ENCDXS(RESULTS,ECARY) ;
+1 ;Broker call returns a patient encounter primary & secondary dx (#721)
+2 ; RPC: EC GETENCDXS
+3 ;INPUTS ECDFN - Patient ien (#2)
+4 ; ECDT - Procedure date and time (fileman format)
+5 ; ECL - Location ien
+6 ; EC4 - Clinic ien
+7 ;
+8 ;OUTPUTS RESULTS - array of patient encounter diagnosis
+9 ; primary/secondary flag^(ICD Code Set) DX ien^DX code DX description.
+10 ;
+11 ;112
NEW ECDFN,ECDT,ECL,EC4,ECPDX,ECDX,ECDXN,ECDXS,CNT,STR,ECPDX,SDXCNT,%
+12 NEW ECCS,ECICD
+13 DO SETENV^ECUMRPC
+14 KILL ^TMP($JOB,"ECENCDXS")
+15 SET ECDFN=$PIECE(ECARY,U)
SET ECDT=+$PIECE(ECARY,U,2)
SET ECL=$PIECE(ECARY,U,3)
+16 SET EC4=$PIECE(ECARY,U,4)
IF ECDT=""
DO NOW^%DTC
SET ECDT=%
+17 IF ECDFN=""!(ECL="")!(EC4="")
QUIT
+18 SET (ECDX,ECDXN)=""
SET ECPDX=$$PDXCK^ECUTL2(ECDFN,ECDT,ECL,EC4)
IF ECDX=""
QUIT
+19 ; Changes for ICD10
+20 ; Determine Active Coding System Based on Date of Interest
+21 ; Supported by ICR 5747
SET ECCS=$$SINFO^ICDEX("DIAG",ECDT)
+22 ; Load the ICD code info
+23 ; Supported by ICR 5747
SET ECICD=$$ICDDX^ICDEX(ECDX,ECDT,+ECCS,"I")
+24 SET ECCS=$PIECE(ECCS,U,2)
SET ECCS=" ("_$PIECE(ECCS,"-",1)_$PIECE(ECCS,"-",2)_")"
+25 SET IEN=""
SET STR=1_U_ECDX_U_ECDXN_" "_$PIECE(ECICD,U,4)_ECCS
+26 SET CNT=1
SET ^TMP($JOB,"ECENCDXS",CNT)=STR
+27 ;*ACS concat description to 2nd diag code, in the order entered by the user
+28 FOR
SET IEN=$ORDER(ECDXS(IEN))
if IEN=""
QUIT
Begin DoDot:1
+29 ; Supported by ICR 5747
SET ECICD=$$ICDDX^ICDEX(ECDXS(IEN),ECDT,+ECCS,"I")
+30 SET CNT=CNT+1
SET ^TMP($JOB,"ECENCDXS",CNT)=0_U_ECDXS(IEN)_U_IEN_" "_$PIECE(ECICD,U,4)_ECCS
End DoDot:1
+31 SET RESULTS=$NAME(^TMP($JOB,"ECENCDXS"))
+32 QUIT
+33 ;
PROCBAT(RESULTS,ECARY) ;
+1 ;Broker call returns the entries from EVENT CAPTURE PATIENT FILE #721
+2 ;for patients for a specific procedure
+3 ; RPC: EC GETBATPROCS
+4 ;INPUTS ECARY - Contains the following subscripted elements
+5 ; ECLOC - Location ien
+6 ; ECUNT - DSS unit ien
+7 ; ECC - Category ien
+8 ; ECP - Procedure ien
+9 ; ECSD - Start Date
+10 ; ECED - End Date
+11 ;
+12 ;OUTPUTS RESULTS - Array of Event Capture Patient data containing:-
+13 ; 721 IEN^Patient name^Procedure Date/Time^(Primary Dx Code set) Primary Dx
+14 ; ^Ordering Section^Associated Clinic
+15 ; ^SSN^DOB^Procedure Date and Time
+16 ;
+17 NEW IEN,CNT,ECCS,ECLOC,ECUNT,NODE,DATA,PXDT,ECV,ECC,ECP,ECSD,ECED,DATE,DFN
+18 NEW CAT,ECI,VADM,ORC,ASC,ECDX
+19 SET ECV="ECLOC^ECUNT^ECC^ECP^ECSD^ECED"
+20 DO PARSE^ECUERPC(ECV,ECARY)
+21 IF (ECLOC="")!(ECUNT="")!(ECC="")!(ECP="")
QUIT
+22 DO SETENV^ECUMRPC
KILL ^TMP($JOB,"ECBATPX")
SET CNT=0
+23 SET %DT="STX"
FOR ECI="ECSD","ECED"
SET X=@ECI
DO ^%DT
SET @ECI=Y
+24 SET ECSD=$SELECT(ECSD=-1:DT,1:ECSD)-.0001
SET ECED=$SELECT(ECED=-1:DT,1:ECED)+.9999
+25 if ECED'>ECSD
QUIT
SET DATE=ECSD
+26 FOR
SET DATE=$ORDER(^ECH("AC1",ECLOC,DATE))
if 'DATE!(DATE>ECED)
QUIT
SET IEN=0
Begin DoDot:1
+27 FOR
SET IEN=$ORDER(^ECH("AC1",ECLOC,DATE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+28 SET NODE=$GET(^ECH(IEN,0))
if NODE=""
QUIT
if $PIECE(NODE,U,7)'=ECUNT
QUIT
+29 if $PIECE(NODE,U,8)'=ECC
QUIT
if $PIECE(NODE,U,9)'=ECP
QUIT
+30 SET ECDX=$PIECE($GET(^ECH(IEN,"P")),U,2)
IF ECDX'=""
Begin DoDot:3
+31 ; Updates for ICD10
+32 ; Load the ICD code info
+33 ; Supported by ICR 5747
SET ECCS=$$SINFO^ICDEX("DIAG",DATE)
+34 ; Load the ICD code info
+35 ; Supported by ICR 5747
SET ECDX=$$ICDDX^ICDEX(ECDX,DATE,+ECCS,"I")
+36 SET ECCS=$PIECE(ECCS,U,2)
SET ECCS=" ("_$PIECE(ECCS,"-",1)_$PIECE(ECCS,"-",2)_")"
+37 SET ECDX=$PIECE(ECDX,U,2)_" "_$PIECE(ECDX,U,4)_ECCS
End DoDot:3
+38 SET ASC=$PIECE(NODE,U,19)
if ASC'=""
SET ASC=$$GET1^DIQ(44,ASC,.01,"I")
+39 SET ORC=$PIECE(NODE,U,12)
if ORC'=""
SET ORC=$$GET1^DIQ(723,ORC,.01,"I")
+40 SET Y=DATE
XECUTE ^DD("DD")
SET PXDT=Y
SET DFN=$PIECE(NODE,U,2)
DO DEM^VADPT
+41 SET DATA=$EXTRACT(VADM(1),1,30)_U_PXDT_U_ECDX_U_ORC_U_ASC
+42 SET CNT=CNT+1
SET ^TMP($JOB,"ECBATPX",CNT)=IEN_U_DATA
End DoDot:2
End DoDot:1
+43 SET RESULTS=$NAME(^TMP($JOB,"ECBATPX"))
+44 QUIT
+45 ;
CLHLP(RESULTS,ECARY) ;RPC Broker entry point for classification help
+1 ; RPC: EC CLASHELP
+2 ;INPUTS ECARY - Contains the following elements for report printing
+3 ; ECDFN - Patient DFN from file (#2)
+4 ; ECKY - Key to provide help on
+5 ;
+6 ;OUTPUTS RESULTS - Array of help text for classification
+7 ;
+8 NEW ECFILER,ECERR,ECDIRY,ECUFILE,ECDFN,ECKY,ECHNDL
+9 DO SETENV^ECUMRPC
+10 KILL ^TMP("ECMSG",$JOB)
+11 SET ECERR=0
SET ECDFN=$PIECE(ECARY,U)
SET ECKY=$PIECE(ECARY,U,2)
Begin DoDot:1
+12 IF ECDFN=""
SET ECERR=1
SET ^TMP("ECMSG",$JOB,1)="0^Patient IEN not defined"
QUIT
+13 IF ECKY=""
SET ECERR=1
SET ^TMP("ECMSG",$JOB,1)="0^Help Key not defined"
QUIT
+14 SET DIC=2
SET DIC(0)="NMZX"
SET X=ECDFN
DO ^DIC
IF Y<0
Begin DoDot:2
+15 SET ECERR=1
SET ^TMP("ECMSG",$JOB,1)="0^Patient IEN not found"
End DoDot:2
End DoDot:1
IF ECERR
DO CLEND
QUIT
+16 SET ECHNDL="ECLASHLP"
DO HFSOPEN^ECRRPC(ECHNDL)
IF ECERR
DO CLEND
QUIT
+17 USE IO
+18 IF ECKY="SC"
DO SC^SDCO23(ECDFN)
+19 DO HFSCLOSE^ECRRPC(ECFILER)
CLEND ;
+1 IF $DATA(^TMP("ECMSG",$JOB))
SET RESULTS=$NAME(^TMP("ECMSG",$JOB))
QUIT
+2 SET RESULTS=$NAME(^TMP($JOB))
+3 QUIT
ECDEF(RESULTS,ECARY) ;RPC Broker entry point to get a default for space bar
+1 ; RPC: EC SPACEBAR
+2 ;INPUTS ECARY - Contains the following elements for report printing
+3 ; ECFILE - File to obtain value from
+4 ;
+5 ;OUTPUTS RESULTS - IEN^Description of Text
+6 ;
+7 NEW DIC,ECFILE,X,Y
+8 DO SETENV^ECUMRPC
+9 SET ECFILE=$PIECE(ECARY,U)
+10 IF ECFILE=""
SET ECERR=1
SET RESULTS="0^File not defined"
QUIT
+11 SET X=" "
SET DIC(0)="MZX"
SET DIC=ECFILE
DO ^DIC
IF Y<0
Begin DoDot:1
+12 SET ECERR=1
SET RESULTS="0^Nothing found"
End DoDot:1
IF ECERR
QUIT
+13 SET RESULTS=Y
+14 QUIT
