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
 ;
 
ECTYP,ECIEN
 
ECARY=$G(ECARY),ECIEN=$P(ECARY,U),ECTYP=$P(ECARY,U,2) ECIEN="" Q
 I 
'$D(^ECH(ECIEN)) Q
 D 
SETENV^ECUMRPC
 
ECTYP="DXS" PATDXS(ECIENQ
 I 
ECTYP="MOD" PATMOD(ECIENQ
 I 
ECTYP="CLASS" PATCLASS(ECIENQ
 I 
ECTYP="OTH" PATOTH(ECIENQ
 I 
ECTYP="PRV" PATPRV^ECUERPC2(ECIENQ
 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)
 ;
 
CNT,DXS,DXSIEN,DXSD,ECCS,ECDT
 
'$D(^ECH(ECIEN,"DX")) Q
 K 
^TMP($J,"ECDXS")
 
(CNT,DXS)=0 F  S DXS=$O(^ECH(ECIEN,"DX",DXS)) Q:'DXS  D
 
DXSIEN=$G(^ECH(ECIEN,"DX",DXS,0)) DXSIEN="" Q
 
; ICD10 Changes
 
ECDT=$P($G(^ECH(ECIEN,0)),U,3) ; DATE/TIME OF PROCEDURE field (#2)
 
; Determine Active Coding System Based on Date of Interest
 
ECCS=$$SINFO^ICDEX("DIAG",ECDT)
 . 
; Load the ICD code info
 
DXSD=$$ICDDX^ICDEX(DXSIEN,ECDT,+ECCS,"I"; Supported by ICR 5747
 
ECCS=$P(ECCS,U,2),ECCS=" ("_$P(ECCS,"-",1)_$P(ECCS,"-",2)_")"
 
DXSD=$P(DXSD,U,2)_" "_$P(DXSD,U,4)_ECCS
 
CNT=CNT+1,^TMP($J,"ECDXS",CNT)=ECIEN_U_DXSIEN_U_DXSD
 
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
 ;
 
MOD,MODIEN,CNT,MODS
 
'$D(^ECH(ECIEN,"MOD")) Q
 K 
^TMP($J,"ECMOD")
 
(CNT,MOD)=0 F  S MOD=$O(^ECH(ECIEN,"MOD",MOD)) Q:'MOD  D
 
MODIEN=$G(^ECH(ECIEN,"MOD",MOD,0)) MODIEN="" Q
 
MODS=$$MOD^ICPTMOD(MODIEN,"I",$P($G(^ECH(ECIEN,0)),U,3)) +MODS<0 Q
 
CNT=CNT+1
 . 
^TMP($J,"ECMOD",CNT)=ECIEN_U_$P(MODS,U,1,2)_"  "_$P(MODS,U,3)
 
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
 ;
 
CLA,ELIG,ELCOD,ECAO,ECIR,ECEC,ECSC,ECMST,STR,ECHNC,ECCV,ECSHAD
 
'$D(^ECH(ECIEN,"P")),'$D(^ECH(ECIEN,"PCE")) Q
 K 
^TMP($J,"ECLASS")
 
ELIG=$P($G(^ECH(ECIEN,"PCE")),"~",17),ELCOD="",CLA=$G(^ECH(ECIEN,"P"))
 
S:ELIG'="" ELCOD=$P($G(^DIC(8,ELIG,0)),U)
 
ECAO=$P(CLA,U,3),ECIR=$P(CLA,U,4),ECEC=$P(CLA,U,5),ECSC=$P(CLA,U,6)
 
ECMST=$P(CLA,U,9),ECHNC=$P(CLA,U,10),ECCV=$P(CLA,U,11),ECSHAD=$P(CLA,U,12)
 
STR=ECIEN_U_ECAO_U_ECIR_U_ECSC_U_ECEC_U_ECMST
 
STR=STR_U_ELIG_U_ELCOD_U_ECHNC_U_ECCV_U_ECSHAD,^TMP($J,"ECLASS",1)=STR
 
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
 ;
 
REAS,ECX
 
^TMP($J,"ECOTH")
 
ECX=^ECH(ECIEN,0)
 
GETS^DIQ(721,ECIEN_",","34;43;44","E","REAS";112
 
^TMP($J,"ECOTH",1)=$G(REAS(721,ECIEN_",",34,"E"))_"^"_$G(REAS(721,ECIEN_",",43,"E"))_"^"_$G(REAS(721,ECIEN_",",44,"E")) ;112
 
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
 
ECDFN,ECDT,ECX,I,ECCLARY,SCDAT,PATSTAT,;112
 
SETENV^ECUMRPC
 
ECDFN=$P(ECARY,U),ECD=$P(ECARY,U,2),ECDT=$P(ECARY,U,3) Q:ECDFN=""
 
ECDT="" NOW^%DTC ECDT=%
 
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:"") 
 
'$$CHKDSS^ECUTL0(+$G(ECD),PATSTATD  Q
 
.RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
 
CL^SDCO21(ECDFN,ECDT,"",.ECCLARYECX=3,1,2,4,5,6,7,8 D
 
.ECX=1,$P($G(^DPT(ECDFN,.321)),"^",2)'="Y" Q
 
.ECX=2,$P($G(^DPT(ECDFN,.321)),"^",3)'="Y" Q
 
.ECX=4,$P($G(^DPT(ECDFN,.322)),"^",13)'="Y",'$$EC^SDCO22(ECDFN,""Q
 
.ECX=3,$D(ECCLARY(ECX)) I=1,2,4 ECCLARY(I)="SC"
 
.'$D(ECCLARY(ECX)) Q
 
.;Check SC, if answer to SC is NO then these questions will be asked
 
.ECCLARY(ECX)="SC" S $P(SCDAT,";",ECX)="E"
 
.E  S $P(RESULTS,"^",ECX)="E"
 
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.
 ;
 
ECDFN,ECDT,ECL,EC4,ECPDX,ECDX,ECDXN,ECDXS,CNT,STR,ECPDX,SDXCNT,;112
 
ECCS,ECICD
 
SETENV^ECUMRPC
 
^TMP($J,"ECENCDXS")
 
ECDFN=$P(ECARY,U),ECDT=+$P(ECARY,U,2),ECL=$P(ECARY,U,3)
 
EC4=$P(ECARY,U,4) ECDT="" NOW^%DTC ECDT=%
 
ECDFN=""!(ECL="")!(EC4=""Q
 S 
(ECDX,ECDXN)="",ECPDX=$$PDXCK^ECUTL2(ECDFN,ECDT,ECL,EC4ECDX="" Q
 
; Changes for ICD10
 ; Determine Active Coding System Based on Date of Interest
 
ECCS=$$SINFO^ICDEX("DIAG",ECDT; Supported by ICR 5747
 ; Load the ICD code info
 
ECICD=$$ICDDX^ICDEX(ECDX,ECDT,+ECCS,"I"; Supported by ICR 5747
 
ECCS=$P(ECCS,U,2),ECCS=" ("_$P(ECCS,"-",1)_$P(ECCS,"-",2)_")"
 
IEN="",STR=1_U_ECDX_U_ECDXN_" "_$P(ECICD,U,4)_ECCS
 
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
 
ECICD=$$ICDDX^ICDEX(ECDXS(IEN),ECDT,+ECCS,"I"; Supported by ICR 5747
 
CNT=CNT+1,^TMP($J,"ECENCDXS",CNT)=0_U_ECDXS(IEN)_U_IEN_" "_$P(ECICD,U,4)_ECCS
 
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
 ;
 
IEN,CNT,ECCS,ECLOC,ECUNT,NODE,DATA,PXDT,ECV,ECC,ECP,ECSD,ECED,DATE,DFN
 
CAT,ECI,VADM,ORC,ASC,ECDX
 
ECV="ECLOC^ECUNT^ECC^ECP^ECSD^ECED"
 
PARSE^ECUERPC(ECV,ECARY)
 
(ECLOC="")!(ECUNT="")!(ECC="")!(ECP=""Q
 D 
SETENV^ECUMRPC ^TMP($J,"ECBATPX"CNT=0
 
%DT="STX" ECI="ECSD","ECED" X=@ECI ^%DT @ECI=Y
 
ECSD=$S(ECSD=-1:DT,1:ECSD)-.0001,ECED=$S(ECED=-1:DT,1:ECED)+.9999
 
Q:ECED'>ECSD  DATE=ECSD
 
F  S DATE=$O(^ECH("AC1",ECLOC,DATE)) Q:'DATE!(DATE>ECED)  IEN=0 D
 
F  S IEN=$O(^ECH("AC1",ECLOC,DATE,IEN)) Q:'IEN  D
 
. . 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
 
. . ECDX=$P($G(^ECH(IEN,"P")),U,2) ECDX'="" D
 
. . . ; Updates for ICD10
 
. . . ; Load the ICD code info
 
. . . ECCS=$$SINFO^ICDEX("DIAG",DATE; Supported by ICR 5747
 
. . . ; Load the ICD code info
 
. . . ECDX=$$ICDDX^ICDEX(ECDX,DATE,+ECCS,"I"; Supported by ICR 5747
 
. . . ECCS=$P(ECCS,U,2),ECCS=" ("_$P(ECCS,"-",1)_$P(ECCS,"-",2)_")"
 
. . . ECDX=$P(ECDX,U,2)_" "_$P(ECDX,U,4)_ECCS
 
. . ASC=$P(NODE,U,19) S:ASC'="" ASC=$$GET1^DIQ(44,ASC,.01,"I")
 . . 
ORC=$P(NODE,U,12) S:ORC'="" ORC=$$GET1^DIQ(723,ORC,.01,"I")
 . . 
Y=DATE ^DD("DD"PXDT=Y,DFN=$P(NODE,U,2) DEM^VADPT
 . . 
DATA=$E(VADM(1),1,30)_U_PXDT_U_ECDX_U_ORC_U_ASC
 
. . CNT=CNT+1,^TMP($J,"ECBATPX",CNT)=IEN_U_DATA
 
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
 ;
 
ECFILER,ECERR,ECDIRY,ECUFILE,ECDFN,ECKY,ECHNDL
 
SETENV^ECUMRPC
 
^TMP("ECMSG",$J)
 
ECERR=0,ECDFN=$P(ECARY,U),ECKY=$P(ECARY,U,2) D  I ECERR CLEND Q
 
.ECDFN="" ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not defined" Q
 
.ECKY="" ECERR=1,^TMP("ECMSG",$J,1)="0^Help Key not defined" Q
 
.DIC=2,DIC(0)="NMZX",X=ECDFN ^DIC Y<0 D
 
..ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not found"
 
ECHNDL="ECLASHLP" HFSOPEN^ECRRPC(ECHNDLECERR CLEND Q
 U 
IO
 
ECKY="SC" SC^SDCO23(ECDFN)
 
HFSCLOSE^ECRRPC(ECFILER)
CLEND ;
 
I $D(^TMP("ECMSG",$J)) 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
 ;
 
DIC,ECFILE,X,Y
 
SETENV^ECUMRPC
 
ECFILE=$P(ECARY,U)
 
ECFILE="" ECERR=1,RESULTS="0^File not defined" Q
 S 
X=" ",DIC(0)="MZX",DIC=ECFILE ^DIC Y<0 D  I ECERR Q
 
ECERR=1,RESULTS="0^Nothing found"
 
RESULTS=Y
 
Q