| [613] | 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
|
|---|
