| 1 | ECUERPC1 ;ALB/JAM;Event Capture Data Entry Broker Util ; 5/21/01 7:30pm
 | 
|---|
| 2 |  ;;2.0; EVENT CAPTURE ;**25,33,42,46,47,54,72**;8 May 96
 | 
|---|
| 3 | PATINF(RESULTS,ECARY) ;
 | 
|---|
| 4 |  ;Broker entry point to get various types of data from EVENT CAPTURE 
 | 
|---|
| 5 |  ;PATIENT FILE #721
 | 
|---|
| 6 |  ;        RPC: EC GETPATINFO
 | 
|---|
| 7 |  ;INPUTS   ECARY  - Contains the following subscripted elements
 | 
|---|
| 8 |  ;          ECIEN - Event Capture Patient ien
 | 
|---|
| 9 |  ;          ECTYP - Data type to return
 | 
|---|
| 10 |  ;
 | 
|---|
| 11 |  ;OUTPUTS  RESULTS - Array of Event Capture Patient data
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 |  N ECTYP,ECIEN
 | 
|---|
| 14 |  S ECARY=$G(ECARY),ECIEN=$P(ECARY,U),ECTYP=$P(ECARY,U,2) I ECIEN="" Q
 | 
|---|
| 15 |  I '$D(^ECH(ECIEN)) Q
 | 
|---|
| 16 |  D SETENV^ECUMRPC
 | 
|---|
| 17 |  I ECTYP="DXS" D PATDXS(ECIEN) Q
 | 
|---|
| 18 |  I ECTYP="MOD" D PATMOD(ECIEN) Q
 | 
|---|
| 19 |  I ECTYP="CLASS" D PATCLASS(ECIEN) Q
 | 
|---|
| 20 |  I ECTYP="OTH" D PATOTH(ECIEN) Q
 | 
|---|
| 21 |  I ECTYP="PRV" D PATPRV^ECUERPC2(ECIEN) Q
 | 
|---|
| 22 |  Q
 | 
|---|
| 23 | PATDXS(ECIEN) ;
 | 
|---|
| 24 |  ;Returns to broker a patient secondary DXs entries from EVENT 
 | 
|---|
| 25 |  ;CAPTURE PATIENT FILE #721
 | 
|---|
| 26 |  ;INPUTS   ECIEN - Event Capture Patient ien
 | 
|---|
| 27 |  ;
 | 
|---|
| 28 |  ;OUTPUTS  RESULTS - Array of Event Capture Patient file contains
 | 
|---|
| 29 |  ;          721 IEN^secondary dx ien #80^secondary dx code^dx description
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 |  N DXS,DXSIEN,DXSD,CNT
 | 
|---|
| 32 |  I '$D(^ECH(ECIEN,"DX")) Q
 | 
|---|
| 33 |  K ^TMP($J,"ECDXS")
 | 
|---|
| 34 |  S (CNT,DXS)=0 F  S DXS=$O(^ECH(ECIEN,"DX",DXS)) Q:'DXS  D
 | 
|---|
| 35 |  . S DXSIEN=$G(^ECH(ECIEN,"DX",DXS,0)) I DXSIEN="" Q
 | 
|---|
| 36 |  . S DXSD=$$ICDDX^ICDCODE(DXSIEN,$P($G(^ECH(ECIEN,0)),U,3))
 | 
|---|
| 37 |  . S DXSD=$P(DXSD,U,2)_"   "_$P(DXSD,U,4)
 | 
|---|
| 38 |  . S CNT=CNT+1,^TMP($J,"ECDXS",CNT)=ECIEN_U_DXSIEN_U_DXSD
 | 
|---|
| 39 |  S RESULTS=$NA(^TMP($J,"ECDXS"))
 | 
|---|
| 40 |  Q
 | 
|---|
| 41 | PATMOD(ECIEN) ;
 | 
|---|
| 42 |  ;Returns to broker a patient procedure modifier from EVENT CAPTURE
 | 
|---|
| 43 |  ;PATIENT FILE #721
 | 
|---|
| 44 |  ;INPUTS   ECIEN - Event Capture Patient ien
 | 
|---|
| 45 |  ;
 | 
|---|
| 46 |  ;OUTPUTS  RESULTS - Array of procedure modifiers
 | 
|---|
| 47 |  ;          721 IEN^modifier ien #81.3^modifier^modifier name
 | 
|---|
| 48 |  ;
 | 
|---|
| 49 |  N MOD,MODIEN,CNT,MODS
 | 
|---|
| 50 |  I '$D(^ECH(ECIEN,"MOD")) Q
 | 
|---|
| 51 |  K ^TMP($J,"ECMOD")
 | 
|---|
| 52 |  S (CNT,MOD)=0 F  S MOD=$O(^ECH(ECIEN,"MOD",MOD)) Q:'MOD  D
 | 
|---|
| 53 |  . S MODIEN=$G(^ECH(ECIEN,"MOD",MOD,0)) I MODIEN="" Q
 | 
|---|
| 54 |  . S MODS=$$MOD^ICPTMOD(MODIEN,"I",$P($G(^ECH(ECIEN,0)),U,3)) I +MODS<0 Q
 | 
|---|
| 55 |  . S CNT=CNT+1
 | 
|---|
| 56 |  . S ^TMP($J,"ECMOD",CNT)=ECIEN_U_$P(MODS,U,1,2)_"  "_$P(MODS,U,3)
 | 
|---|
| 57 |  S RESULTS=$NA(^TMP($J,"ECMOD"))
 | 
|---|
| 58 |  Q
 | 
|---|
| 59 | PATCLASS(ECIEN) ;
 | 
|---|
| 60 |  ;Returns to broker a patient classification & eligibility data from 
 | 
|---|
| 61 |  ;EVENT CAPTURE PATIENT FILE #721
 | 
|---|
| 62 |  ; INPUTS   ECIEN - Event Capture Patient ien
 | 
|---|
| 63 |  ; OUTPUTS  RESULTS - Array of procedure modifiers
 | 
|---|
| 64 |  ;  721 IEN^agent orange^radiation exposure^service connect^environmental
 | 
|---|
| 65 |  ;  contaminants^military sexual trauma^eligibility code #8^eligibility
 | 
|---|
| 66 |  ;  description^head/neck cancer^combat veteran
 | 
|---|
| 67 |  ;
 | 
|---|
| 68 |  N CLA,ELIG,ELCOD,ECAO,ECIR,ECEC,ECSC,ECMST,STR,ECHNC,ECCV
 | 
|---|
| 69 |  I '$D(^ECH(ECIEN,"P")),'$D(^ECH(ECIEN,"PCE")) Q
 | 
|---|
| 70 |  K ^TMP($J,"ECLASS")
 | 
|---|
| 71 |  S ELIG=$P($G(^ECH(ECIEN,"PCE")),"~",17),ELCOD="",CLA=$G(^ECH(ECIEN,"P"))
 | 
|---|
| 72 |  S:ELIG'="" ELCOD=$P($G(^DIC(8,ELIG,0)),U)
 | 
|---|
| 73 |  S ECAO=$P(CLA,U,3),ECIR=$P(CLA,U,4),ECEC=$P(CLA,U,5),ECSC=$P(CLA,U,6)
 | 
|---|
| 74 |  S ECMST=$P(CLA,U,9),ECHNC=$P(CLA,U,10),ECCV=$P(CLA,U,11)
 | 
|---|
| 75 |  S STR=ECIEN_U_ECAO_U_ECIR_U_ECSC_U_ECEC_U_ECMST
 | 
|---|
| 76 |  S STR=STR_U_ELIG_U_ELCOD_U_ECHNC_U_ECCV,^TMP($J,"ECLASS",1)=STR
 | 
|---|
| 77 |  S RESULTS=$NA(^TMP($J,"ECLASS"))
 | 
|---|
| 78 |  Q
 | 
|---|
| 79 | PATOTH(ECIEN) ;
 | 
|---|
| 80 |  ;Returns to broker a patient remaining data from EVENT CAPTURE
 | 
|---|
| 81 |  ;PATIENT FILE #721
 | 
|---|
| 82 |  ;INPUTS   ECIEN - Event Capture Patient ien
 | 
|---|
| 83 |  ;
 | 
|---|
| 84 |  ;OUTPUTS  RESULTS - 
 | 
|---|
| 85 |  ;          721 IEN^procedure reason
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 |  N REAS,ECX
 | 
|---|
| 88 |  K ^TMP($J,"ECOTH")
 | 
|---|
| 89 |  S ECX=^ECH(ECIEN,0)
 | 
|---|
| 90 |  S REAS=$$GET1^DIQ(721,ECIEN,34,"E")
 | 
|---|
| 91 |  S ^TMP($J,"ECOTH",1)=REAS
 | 
|---|
| 92 |  S RESULTS=$NA(^TMP($J,"ECOTH"))
 | 
|---|
| 93 |  Q
 | 
|---|
| 94 | PATCLAST(RESULTS,ECARY) ;
 | 
|---|
| 95 |  ;Returns to broker a patient status (in/out) and classification
 | 
|---|
| 96 |  ;     RPC: EC GETPATCLASTAT
 | 
|---|
| 97 |  ;INPUTS  ECARY  - Contains the following subscripted elements  
 | 
|---|
| 98 |  ;         ECDFN - Patient ien (#2)
 | 
|---|
| 99 |  ;         ECD   - DSS Unit ien (#724)
 | 
|---|
| 100 |  ;         ECDT  - Procedure date and time (fileman format)
 | 
|---|
| 101 |  ;OUTPUTS  RESULTS - Patient status and classifications delimited by (^)
 | 
|---|
| 102 |  ;         Patient Status: I for inpatient or O for outpatient
 | 
|---|
| 103 |  ;         Classification: 2- Agent Orange, 3- Ionizing Radiation
 | 
|---|
| 104 |  ;          4- SC Condition, 5- Environmental Contaminants 6- Military
 | 
|---|
| 105 |  ;          Sexual Trauma    7- Head/Neck Cancer 8- Combat Veteran
 | 
|---|
| 106 |  ;         Data after the '~' refers to those class. that must be asked 
 | 
|---|
| 107 |  ;         by Delphi appl. when the answer to SC=No.
 | 
|---|
| 108 |  ;         Data after "~"  1- Agent Orange  2- Ionizing Radi. 3- Env Cont
 | 
|---|
| 109 |  N ECDFN,ECDT,ECX,I,ECCLARY,SCDAT,PATSTAT
 | 
|---|
| 110 |  D SETENV^ECUMRPC
 | 
|---|
| 111 |  S ECDFN=$P(ECARY,U),ECD=$P(ECARY,U,2),ECDT=$P(ECARY,U,3) Q:ECDFN=""
 | 
|---|
| 112 |  I ECDT="" D NOW^%DTC S ECDT=%
 | 
|---|
| 113 |  S PATSTAT=$$INOUTPT^ECUTL0(ECDFN,ECDT),RESULTS="^^^^^^",SCDAT=";;;"
 | 
|---|
| 114 |  I PATSTAT="I" D  Q  ;added to be consistent w roll-n-scroll 11/25/03 JAM
 | 
|---|
| 115 |  .S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
 | 
|---|
| 116 |  I '$$CHKDSS^ECUTL0(+$G(ECD),PATSTAT) D  Q
 | 
|---|
| 117 |  .S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
 | 
|---|
| 118 |  D CL^SDCO21(ECDFN,ECDT,"",.ECCLARY) F ECX=3,1,2,4,5,6,7 D
 | 
|---|
| 119 |  .I ECX=1,$P($G(^DPT(ECDFN,.321)),"^",2)'="Y" Q
 | 
|---|
| 120 |  .I ECX=2,$P($G(^DPT(ECDFN,.321)),"^",3)'="Y" Q
 | 
|---|
| 121 |  .I ECX=4,$P($G(^DPT(ECDFN,.322)),"^",13)'="Y",'$$EC^SDCO22(ECDFN,"") Q
 | 
|---|
| 122 |  .I ECX=3,$D(ECCLARY(ECX)) F I=1,2,4 S ECCLARY(I)="SC"
 | 
|---|
| 123 |  .I '$D(ECCLARY(ECX)) Q
 | 
|---|
| 124 |  .;Check SC, if answer to SC is NO then these questions will be asked
 | 
|---|
| 125 |  .I ECCLARY(ECX)="SC" S $P(SCDAT,";",ECX)="E"
 | 
|---|
| 126 |  .E  S $P(RESULTS,"^",ECX)="E"
 | 
|---|
| 127 |  S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"")
 | 
|---|
| 128 |  Q
 | 
|---|
| 129 | ENCDXS(RESULTS,ECARY) ;
 | 
|---|
| 130 |  ;Broker call returns a patient encounter primary & secondary dx (#721)
 | 
|---|
| 131 |  ;     RPC: EC GETENCDXS
 | 
|---|
| 132 |  ;INPUTS   ECDFN - Patient ien (#2)
 | 
|---|
| 133 |  ;         ECDT  - Procedure date and time (fileman format)
 | 
|---|
| 134 |  ;         ECL   - Location ien
 | 
|---|
| 135 |  ;         EC4   - Clinic ien
 | 
|---|
| 136 |  ;
 | 
|---|
| 137 |  ;OUTPUTS  RESULTS - array of patient encounter diagnosis
 | 
|---|
| 138 |  ;         primary/secondary flag^DX ien^DX code  DX description.
 | 
|---|
| 139 |  ;
 | 
|---|
| 140 |  N ECDFN,ECDT,ECL,EC4,ECPDX,ECDX,ECDXN,ECDXS,CNT,STR,ECPDX,SDXCNT
 | 
|---|
| 141 |  D SETENV^ECUMRPC
 | 
|---|
| 142 |  K ^TMP($J,"ECENCDXS")
 | 
|---|
| 143 |  S ECDFN=$P(ECARY,U),ECDT=+$P(ECARY,U,2),ECL=$P(ECARY,U,3)
 | 
|---|
| 144 |  S EC4=$P(ECARY,U,4) I ECDT="" D NOW^%DTC S ECDT=%
 | 
|---|
| 145 |  I ECDFN=""!(ECL="")!(EC4="") Q
 | 
|---|
| 146 |  S (ECDX,ECDXN)="",ECPDX=$$PDXCK^ECUTL2(ECDFN,ECDT,ECL,EC4) I ECDX="" Q
 | 
|---|
| 147 |  S IEN="",STR=1_U_ECDX_U_ECDXN_"   "_$P($$ICDDX^ICDCODE(ECDX,ECDT),U,4)
 | 
|---|
| 148 |  S CNT=1,^TMP($J,"ECENCDXS",CNT)=STR
 | 
|---|
| 149 |  ;*ACS concat description to 2nd diag code, in the order entered by the user
 | 
|---|
| 150 |  F  S IEN=$O(ECDXS(IEN)) Q:IEN=""  D
 | 
|---|
| 151 |  . S CNT=CNT+1,^TMP($J,"ECENCDXS",CNT)=0_U_ECDXS(IEN)_U_IEN_"   "_$P($$ICDDX^ICDCODE(ECDXS(IEN),ECDT),U,4)
 | 
|---|
| 152 |  S RESULTS=$NA(^TMP($J,"ECENCDXS"))
 | 
|---|
| 153 |  Q
 | 
|---|
| 154 |  ;
 | 
|---|
| 155 | PROCBAT(RESULTS,ECARY) ;
 | 
|---|
| 156 |  ;Broker call returns the entries from EVENT CAPTURE PATIENT FILE #721
 | 
|---|
| 157 |  ;for patients for a specific procedure
 | 
|---|
| 158 |  ;        RPC: EC GETBATPROCS
 | 
|---|
| 159 |  ;INPUTS   ECARY - Contains the following subscripted elements
 | 
|---|
| 160 |  ;          ECLOC - Location ien
 | 
|---|
| 161 |  ;          ECUNT - DSS unit ien
 | 
|---|
| 162 |  ;          ECC   - Category ien
 | 
|---|
| 163 |  ;          ECP   - Procedure ien
 | 
|---|
| 164 |  ;          ECSD  - Start Date
 | 
|---|
| 165 |  ;          ECED  - End Date
 | 
|---|
| 166 |  ;
 | 
|---|
| 167 |  ;OUTPUTS  RESULTS - Array of Event Capture Patient data containing:-
 | 
|---|
| 168 |  ;          721 IEN^Patient name^Procedure Date/Time^Primary Dx
 | 
|---|
| 169 |  ;          ^Ordering Section^Associated Clinic
 | 
|---|
| 170 |  ;^SSN^DOB^Procedure Date and Time
 | 
|---|
| 171 |  N IEN,CNT,ECLOC,ECUNT,NODE,DATA,PXDT,ECV,ECC,ECP,ECSD,ECED,DATE,DFN
 | 
|---|
| 172 |  N CAT,ECI,VADM,ORC,ASC,ECDX
 | 
|---|
| 173 |  S ECV="ECLOC^ECUNT^ECC^ECP^ECSD^ECED"
 | 
|---|
| 174 |  D PARSE^ECUERPC(ECV,ECARY)
 | 
|---|
| 175 |  I (ECLOC="")!(ECUNT="")!(ECC="")!(ECP="") Q
 | 
|---|
| 176 |  D SETENV^ECUMRPC K ^TMP($J,"ECBATPX") S CNT=0
 | 
|---|
| 177 |  S %DT="STX" F ECI="ECSD","ECED" S X=@ECI D ^%DT S @ECI=Y
 | 
|---|
| 178 |  S ECSD=$S(ECSD=-1:DT,1:ECSD)-.0001,ECED=$S(ECED=-1:DT,1:ECED)+.9999
 | 
|---|
| 179 |  Q:ECED'>ECSD  S DATE=ECSD
 | 
|---|
| 180 |  F  S DATE=$O(^ECH("AC1",ECLOC,DATE)) Q:'DATE!(DATE>ECED)  S IEN=0 D
 | 
|---|
| 181 |  . F  S IEN=$O(^ECH("AC1",ECLOC,DATE,IEN)) Q:'IEN  D
 | 
|---|
| 182 |  . . S NODE=$G(^ECH(IEN,0))  Q:NODE=""  Q:$P(NODE,U,7)'=ECUNT
 | 
|---|
| 183 |  . . Q:$P(NODE,U,8)'=ECC  Q:$P(NODE,U,9)'=ECP
 | 
|---|
| 184 |  . . S ECDX=$P($G(^ECH(IEN,"P")),U,2) I ECDX'="" D
 | 
|---|
| 185 |  . . . S ECDX=$$ICDDX^ICDCODE(ECDX,DATE)
 | 
|---|
| 186 |  . . . S ECDX=$P(ECDX,U,2)_"  "_$P(ECDX,U,4)
 | 
|---|
| 187 |  . . S ASC=$P(NODE,U,19) S:ASC'="" ASC=$$GET1^DIQ(44,ASC,.01,"I")
 | 
|---|
| 188 |  . . S ORC=$P(NODE,U,12) S:ORC'="" ORC=$$GET1^DIQ(723,ORC,.01,"I")
 | 
|---|
| 189 |  . . S Y=DATE X ^DD("DD") S PXDT=Y,DFN=$P(NODE,U,2) D DEM^VADPT
 | 
|---|
| 190 |  . . S DATA=$E(VADM(1),1,30)_U_PXDT_U_ECDX_U_ORC_U_ASC
 | 
|---|
| 191 |  . . S CNT=CNT+1,^TMP($J,"ECBATPX",CNT)=IEN_U_DATA
 | 
|---|
| 192 |  S RESULTS=$NA(^TMP($J,"ECBATPX"))
 | 
|---|
| 193 |  Q
 | 
|---|
| 194 |  ;
 | 
|---|
| 195 | CLHLP(RESULTS,ECARY) ;RPC Broker entry point for classification help
 | 
|---|
| 196 |  ;        RPC: EC CLASHELP
 | 
|---|
| 197 |  ;INPUTS   ECARY - Contains the following elements for report printing
 | 
|---|
| 198 |  ;          ECDFN  - Patient DFN from file (#2)
 | 
|---|
| 199 |  ;          ECKY   - Key to provide help on
 | 
|---|
| 200 |  ;
 | 
|---|
| 201 |  ;OUTPUTS  RESULTS - Array of help text for classification
 | 
|---|
| 202 |  ;
 | 
|---|
| 203 |  N ECFILER,ECERR,ECDIRY,ECUFILE,ECDFN,ECKY,ECHNDL
 | 
|---|
| 204 |  D SETENV^ECUMRPC
 | 
|---|
| 205 |  K ^TMP("ECMSG",$J)
 | 
|---|
| 206 |  S ECERR=0,ECDFN=$P(ECARY,U),ECKY=$P(ECARY,U,2) D  I ECERR D CLEND Q
 | 
|---|
| 207 |  .I ECDFN="" S ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not defined" Q
 | 
|---|
| 208 |  .I ECKY="" S ECERR=1,^TMP("ECMSG",$J,1)="0^Help Key not defined" Q
 | 
|---|
| 209 |  .S DIC=2,DIC(0)="NMZX",X=ECDFN D ^DIC I Y<0 D
 | 
|---|
| 210 |  ..S ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not found"
 | 
|---|
| 211 |  S ECHNDL="ECLASHLP" D HFSOPEN^ECRRPC(ECHNDL) I ECERR D CLEND Q
 | 
|---|
| 212 |  U IO
 | 
|---|
| 213 |  I ECKY="SC" D SC^SDCO23(ECDFN)
 | 
|---|
| 214 |  D HFSCLOSE^ECRRPC(ECFILER)
 | 
|---|
| 215 | CLEND ;
 | 
|---|
| 216 |  I $D(^TMP("ECMSG",$J)) S RESULTS=$NA(^TMP("ECMSG",$J)) Q
 | 
|---|
| 217 |  S RESULTS=$NA(^TMP($J))
 | 
|---|
| 218 |  Q
 | 
|---|
| 219 | ECDEF(RESULTS,ECARY) ;RPC Broker entry point to get a default for space bar
 | 
|---|
| 220 |  ;        RPC: EC SPACEBAR
 | 
|---|
| 221 |  ;INPUTS   ECARY - Contains the following elements for report printing
 | 
|---|
| 222 |  ;          ECFILE - File to obtain value from
 | 
|---|
| 223 |  ;
 | 
|---|
| 224 |  ;OUTPUTS  RESULTS - IEN^Description of Text
 | 
|---|
| 225 |  ;
 | 
|---|
| 226 |  N DIC,ECFILE,X,Y
 | 
|---|
| 227 |  D SETENV^ECUMRPC
 | 
|---|
| 228 |  S ECFILE=$P(ECARY,U)
 | 
|---|
| 229 |  I ECFILE="" S ECERR=1,RESULTS="0^File not defined" Q
 | 
|---|
| 230 |  S X=" ",DIC(0)="MZX",DIC=ECFILE D ^DIC I Y<0 D  I ECERR Q
 | 
|---|
| 231 |  . S ECERR=1,RESULTS="0^Nothing found"
 | 
|---|
| 232 |  S RESULTS=Y
 | 
|---|
| 233 |  Q
 | 
|---|