ECUERPC1.m

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 ---ECUERPC1   11308     printed  Mar 13, 2025@21:03:54                                                                                                                                                                                                   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