| 1 | ECXLBB ;DALOI/KML - DSS BLOOD BANK EXTRACT ; 10/17/07 10:33am
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**78,84,90,92,104,105**;Dec 22, 1997;Build 70
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | ; access to the LAB DATA file (#63) is supported by
|
|---|
| 5 | ; controlled subscription to IA 525 (global root ^LR)
|
|---|
| 6 | ; access to the BLOOD PRODUCT (#66) is supported by IA 4510
|
|---|
| 7 | BEG ;entry point from option
|
|---|
| 8 | D SETUP I ECFILE="" Q
|
|---|
| 9 | D ^ECXTRAC,^ECXKILL
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | START ; Entry point from tasked job
|
|---|
| 13 | ; begin package specific extract
|
|---|
| 14 | N ECTRSP,ECADMT,ECTODT,ECENCTR,ECPAT,ECLRDFN,ECXPHY,ECXPHYPC,ECPHYNPI
|
|---|
| 15 | N ECD,ECXDFN,ECARRY,EC66,ECERR,ECTRFDT,ECTRFTM,ECX,ECINOUT,ECXINST
|
|---|
| 16 | ;variables ECFILE,EC23,ECXYM,ECINST,ECSD,ECSD1,ECED passed in
|
|---|
| 17 | ; by taskmanager
|
|---|
| 18 | ; ECED defined in ^ECXTRAC - it represents the end date of the extract
|
|---|
| 19 | ; sort process. TRANSFUSION DATE should be within start and end dates
|
|---|
| 20 | ; ECED and ECSD were assigned with input provided by the user interface
|
|---|
| 21 | ; and ECSD1 = ECSD-.1
|
|---|
| 22 | ; Read through the TRANSFUSION RECORD sub-file (63.017) of
|
|---|
| 23 | ; the LAB DATA file (#63)
|
|---|
| 24 | ;the global nodes containing transfusion record entries are constructed
|
|---|
| 25 | ; by calculating the TRANSFUSION DATE/TIME (.01)
|
|---|
| 26 | ; into its reverse date/time representation and then DINUM'd when
|
|---|
| 27 | ;filing the record entry
|
|---|
| 28 | ; ECD equals the reverse date/time of ECED+.3 and will need to be
|
|---|
| 29 | ; reset for each DFN.
|
|---|
| 30 | I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 Q ;quit if tasked and user sends stop request (QFLG assigned in ECXTRAC)
|
|---|
| 31 | AUDRPT ; entry point for pre-extract audit report
|
|---|
| 32 | S ECTODT=9999999-ECSD1,ECLRDFN=0
|
|---|
| 33 | F S ECLRDFN=$O(^LR(ECLRDFN)) Q:'ECLRDFN S ECXDFN=$$GETDFN(ECLRDFN),ECERR=$$PAT(ECXDFN) S ECD=9999999-(ECED+.3) F S ECD=$O(^LR(ECLRDFN,1.6,ECD)) Q:ECERR Q:'ECD!(ECD>ECTODT) S EC0=^LR(ECLRDFN,1.6,ECD,0) D
|
|---|
| 34 | .; ECARRY(1)=TRANSFUSION DATE AND TIME,
|
|---|
| 35 | .; ECARRY(3)=COMPONENT, ECARRY(4)=COMPONENT ABBREVIATION
|
|---|
| 36 | .; ECARRY(5)=UNITS POOLED, ECARRY(6)=TRANSFUSION REACTION,
|
|---|
| 37 | .; ECARRY(7)=VOLUME TRANSFUSED, ECARRY(8)=TRANSFUSION REACTION TYPE
|
|---|
| 38 | .; ECARRY(9)=REQUESTING PROVIDER, ECARRY(10)=REQUEST. PROV. PERSON CLASS
|
|---|
| 39 | .; ECARRY(11)=UNIT MODIFIED,ECARRY(12)=UNIT MODIFICATION
|
|---|
| 40 | .; ECARRY(13)=PRODUCTION DIVISION CODE
|
|---|
| 41 | . S ECARRY(1)=$P(EC0,"^"),EC66=$G(^LAB(66,$P(EC0,"^",2),0))
|
|---|
| 42 | . S ECARRY(3)=$E($P(EC66,"^"),1,15),ECARRY(4)=$P(EC66,"^",2)
|
|---|
| 43 | . S ECARRY(5)=$S(+$P(EC0,"^",7)=0:1,1:+$P(EC0,"^",7))
|
|---|
| 44 | . S ECARRY(6)=$S($P(EC0,"^",8)=1:"Y",1:"N"),ECARRY(7)=$P(EC0,"^",10)
|
|---|
| 45 | . S ECARRY(8)=$E($P($G(^LAB(65.4,+$P(EC0,"^",11),0)),"^"),1,10)
|
|---|
| 46 | . S (ECARRY(9),ECARRY(10),ECARRY(13))="" D GETRPRV
|
|---|
| 47 | . S ECARRY(11)=$$MODIFIED(),(ECXPHY,ECXPHYPC,ECPHYNPI)=""
|
|---|
| 48 | . S ECARRY(12)=$S(ECARRY(11)="Y":$$UNITMODS(),1:"")
|
|---|
| 49 | . D GETDATA
|
|---|
| 50 | . K ECARRY
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | UNITMODS() ; Get modification criteria from fields #.06 and #3 from file #66
|
|---|
| 54 | N MODARY,MO,EC66A,MODSTR,STR3
|
|---|
| 55 | S MODARY("DIVIDED")="D",MODARY("POOLED")="P",MODARY("WASHED")="W"
|
|---|
| 56 | S MODARY("FROZEN")="F",MODARY("LEUKOCYTE POOR")="L"
|
|---|
| 57 | S MODARY("REJUVENATED")="R",MODARY("DEGLYCEROLIZED")="G"
|
|---|
| 58 | S MODARY("IRRADIATED")="I",MODARY("SEPARATED")="S"
|
|---|
| 59 | ;if modification criteria is null determine value from description
|
|---|
| 60 | S MODSTR=$S($P(EC66,U,6)'="":$P(EC66,U,6),1:$$CHKMOD^ECXLBB1($P(EC66,"^")))
|
|---|
| 61 | ;get modification criteria for entries at field #3 in file #66
|
|---|
| 62 | S MOD=0 F S MOD=$O(^LAB(66,$P(EC0,"^",2),3,MOD)) Q:'MOD D
|
|---|
| 63 | .S EC66A=$G(^LAB(66,MOD,0)) I EC66A="" Q
|
|---|
| 64 | .S STR3=$S($P(EC66A,U,6)'="":$P(EC66A,U,6),1:$$CHKMOD^ECXLBB1($P(EC66A,"^")))
|
|---|
| 65 | .I STR3'="",MODSTR'[STR3 S MODSTR=MODSTR_STR3
|
|---|
| 66 | Q MODSTR
|
|---|
| 67 | ;
|
|---|
| 68 | MODIFIED() ; Was unit modified
|
|---|
| 69 | ; Init variables
|
|---|
| 70 | N XMATCH,UNIT,MOD,COMPID,MODNODE,MODTO
|
|---|
| 71 | S (XMATCH,UNIT)=0,MOD=""
|
|---|
| 72 | ; Check input
|
|---|
| 73 | Q:'$G(ECLRDFN)!'$P(EC0,U,2) "N"
|
|---|
| 74 | ;Find xmatch for blood component request
|
|---|
| 75 | S XMATCH=$O(^LR(ECLRDFN,1.8,$P(EC0,U,2),1,XMATCH)) Q:'XMATCH "N"
|
|---|
| 76 | ;Get blood inventory file (#65) pointer
|
|---|
| 77 | S UNIT=$P($G(^LR(ECLRDFN,1.8,$P(EC0,"^",2),1,XMATCH,0)),U)
|
|---|
| 78 | ;Look at disposition field (#4.1) in blood inventory file (#65)
|
|---|
| 79 | S MOD=$P($G(^LRD(65,+XMATCH,4)),U),COMPID=$P(EC66,U,3)
|
|---|
| 80 | ; Get 'the modified to' entry pointer to blood inventory file (#66)
|
|---|
| 81 | I MOD="MO" S MODTO=0 F S MODTO=$O(^LRD(65,+XMATCH,9,MODTO)) Q:'MODTO D
|
|---|
| 82 | .S MODNODE=$G(^LRD(65,+XMATCH,9,MODTO,0)) Q:$P(^(0),U,3)'>1
|
|---|
| 83 | .Q:$P(MODNODE,U,2)'=COMPID
|
|---|
| 84 | .; Set the modify to unit ien for file (#66)
|
|---|
| 85 | Q $S(MOD="MO":"Y",1:"N")
|
|---|
| 86 | ;
|
|---|
| 87 | GETRPRV ; get requesting provider, requesting provider person class and
|
|---|
| 88 | ; production division code
|
|---|
| 89 | ; input: ECD =INVERTED DATE SUBSCRIPT
|
|---|
| 90 | ; ECARRY(1)=TRANSFUSION DATE AND TIME
|
|---|
| 91 | ; note: Accessioned data in file #68 is stored up to 90 days.
|
|---|
| 92 | N ECXBNOD,ACC,ACCDT,ACCNODE,PERCLS
|
|---|
| 93 | I ECARRY(1)="" Q ;there is no transfusion date
|
|---|
| 94 | ;get BLOOD BANK record, field #1, in file #63 located on "BB" node
|
|---|
| 95 | ;since there is a slight time lapse, $O will find the BB record
|
|---|
| 96 | S ECXBNOD=$O(^LR(ECLRDFN,"BB",ECD)) I ECXBNOD="" Q
|
|---|
| 97 | S ECXBNOD=^LR(ECLRDFN,"BB",ECXBNOD,0) I ECXBNOD="" Q
|
|---|
| 98 | ;Compose accession number,originating from field #.06 subfile #63.01
|
|---|
| 99 | ; ex. ACC=BB 0528 27
|
|---|
| 100 | S ACC=$P(ECXBNOD,U,6),ACC=$TR($P(ACC," ",2,99)," ")
|
|---|
| 101 | S ACCDT=$E(ECARRY(1),1,3)_$E(ACC,1,4),NUM=$E(ACC,5,99)
|
|---|
| 102 | ;Get field #2 from file #68, field #1 from subfile #68.01 which is
|
|---|
| 103 | ;subfile #68.02. Look at 29=blood bank ien, from 0th node, get fields
|
|---|
| 104 | ;#6.5 PROVIDER and #26 DIV
|
|---|
| 105 | I (ACCDT)=""!(NUM="") Q
|
|---|
| 106 | ; identify bb accession area the patient was in to get the right DIV
|
|---|
| 107 | S AREA=$$AREA
|
|---|
| 108 | S ACCNODE=$G(^LRO(68,+AREA,1,ACCDT,1,NUM,0))
|
|---|
| 109 | S ECARRY(9)=$P(ACCNODE,U,8) I ECARRY(9)'="" D
|
|---|
| 110 | . S PERCLS=$$GET^XUA4A72(ECARRY(9),ACCDT)
|
|---|
| 111 | . I +PERCLS>0 S ECARRY(10)=$P(PERCLS,U,7)
|
|---|
| 112 | . S ECREQNPI=$$NPI^XUSNPI("Individual_ID",ECARRY(9),ACCDT)
|
|---|
| 113 | . S:+ECREQNPI'>0 ECREQNPI="" S ECREQNPI=$P(ECREQNPI,U)
|
|---|
| 114 | . S ECARRY(9)=2_ECARRY(9)
|
|---|
| 115 | S DIV=$P($G(^LRO(68,+AREA,1,ACCDT,1,NUM,.4)),U)
|
|---|
| 116 | I DIV'="" S ECARRY(13)=$$RADDIV^ECXDEPT(DIV)
|
|---|
| 117 | Q
|
|---|
| 118 | ;
|
|---|
| 119 | AREA() ; resolve accession area's ien to use and validate
|
|---|
| 120 | ; Accession number
|
|---|
| 121 | ; Patient LRDFN
|
|---|
| 122 | ; note: if there is only one accession area use '29'
|
|---|
| 123 | N A,CNT,BBLIST,DFN,ACC,AREA,DATE,TDATE,ACCNODE
|
|---|
| 124 | S (CNT,FLAG,A)=0,DFN=""
|
|---|
| 125 | ; set the date from the "bb" node in file (#63)
|
|---|
| 126 | S DATE=$P(ECXBNOD,U)
|
|---|
| 127 | ; setup array for bb accession areas if more than one
|
|---|
| 128 | F S A=$O(^LRO(68,A)) Q:'A I $P($G(^LRO(68,A,0)),"^",2)="BB" D
|
|---|
| 129 | . S BBLIST(A)=""
|
|---|
| 130 | . S CNT=CNT+1
|
|---|
| 131 | I CNT'>1 Q 29
|
|---|
| 132 | S AREA=0 F S AREA=$O(BBLIST(AREA)) Q:'AREA D Q:FLAG
|
|---|
| 133 | . ; get additional accession information for validation
|
|---|
| 134 | . S ACCNODE=$G(^LRO(68,AREA,1,$P(DATE,"."),1,NUM,0))
|
|---|
| 135 | . S ACC=$G(^LRO(68,AREA,1,$P(DATE,"."),1,NUM,.2))
|
|---|
| 136 | . S DFN=$P($G(ACCNODE),U)
|
|---|
| 137 | . S TDATE=$P($G(^LRO(68,AREA,1,$P(DATE,"."),1,NUM,3)),U)
|
|---|
| 138 | . I (DFN=ECLRDFN)&(ACC=$P(ECXBNOD,U,6))&(DATE=TDATE) S FLAG=1
|
|---|
| 139 | Q AREA
|
|---|
| 140 | ;
|
|---|
| 141 | GETDATA ; gather rest of extract data that will be recorded in an
|
|---|
| 142 | ; entry in file 727.829
|
|---|
| 143 | S ECTRFDT=$$ECXDOB^ECXUTL(ECARRY(1)),ECTRFTM=$$ECXTIME^ECXUTL(ECARRY(1))
|
|---|
| 144 | S ECX=$$INP^ECXUTL2(ECXDFN,ECARRY(1)),ECINOUT=$P(ECX,U),ECTRSP=$P(ECX,U,3),ECADMT=$P(ECX,U,4) ; [FLD #5]
|
|---|
| 145 | ;
|
|---|
| 146 | ;- Observation patient indicator (YES/NO)
|
|---|
| 147 | S ECXOBS=$$OBSPAT^ECXUTL4(ECINOUT,ECTRSP)
|
|---|
| 148 | ;- If no encounter number don't file record
|
|---|
| 149 | S ECENCTR=$$ENCNUM^ECXUTL4(ECINOUT,ECPAT("SSN"),ECADMT,ECARRY(1),ECTRSP,ECXOBS,ECHEAD,,) ; [FLD #6]
|
|---|
| 150 | Q:ECENCTR=""
|
|---|
| 151 | ;get emergency response indicator (FEMA)
|
|---|
| 152 | S ECXERI=ECPAT("ERI")
|
|---|
| 153 | ;
|
|---|
| 154 | S ECXSTR=$G(EC23)_"^"_ECINST_"^"_ECXDFN_"^"_ECPAT("SSN")_"^"_ECPAT("NAME")_"^"_ECINOUT_"^"_ECENCTR_"^"_ECTRFDT_"^"_ECTRFTM_"^"_ECARRY(3)_"^"_ECARRY(4)_"^"_ECARRY(5)_"^"_ECARRY(7)_"^"_ECARRY(6)_"^"_ECARRY(8)_"^BB"_ECARRY(13)_"^^"
|
|---|
| 155 | I $G(ECXLOGIC)>2005 S ECXSTR=ECXSTR_U_ECXPHY_U_ECXPHYPC
|
|---|
| 156 | I $G(ECXLOGIC)>2006 D
|
|---|
| 157 | .S ECXSTR=ECXSTR_U_ECXERI_U_ECARRY(11)_U_ECARRY(12)_U_ECARRY(9)_U_ECARRY(10)_U_ECARRY(13)_U
|
|---|
| 158 | I '$D(ECXRPT) D FILE(ECXSTR) Q
|
|---|
| 159 | S ^TMP("ECXLBB",$J,ECXDFN,ECD)=ECXSTR ;temporary global array
|
|---|
| 160 | ; used in ECXPLBB (pre-extract audit report)
|
|---|
| 161 | Q
|
|---|
| 162 | ;
|
|---|
| 163 | GETDFN(ECXLRDFN) ;
|
|---|
| 164 | ; INPUT - LRDFN
|
|---|
| 165 | ; OUTPUT - DFN
|
|---|
| 166 | ; Obtains DFN (Patient ID) from LRDFN (Lab Patient ID).
|
|---|
| 167 | ; If no valid DFN exists, 0 is returned.
|
|---|
| 168 | S ECXLRDFN=+$G(ECXLRDFN)
|
|---|
| 169 | I $P($G(^LR(ECXLRDFN,0)),"^",2)'=2 Q 0
|
|---|
| 170 | Q +$P(^LR(ECXLRDFN,0),"^",3)
|
|---|
| 171 | ;
|
|---|
| 172 | PAT(ECXDFN) ;get/set patient data
|
|---|
| 173 | ; INPUT - ECXDFN = patient ien (DFN)
|
|---|
| 174 | ; OUTPUT - ECPAT array:
|
|---|
| 175 | ; ECPAT("SSN")
|
|---|
| 176 | ; ECPAT("NAME")
|
|---|
| 177 | ; returns 0 or 1 in ECXERR - 0=successful
|
|---|
| 178 | ; 1=error condition
|
|---|
| 179 | N X,OK,ECXERR
|
|---|
| 180 | ;get data
|
|---|
| 181 | S ECXERR=0
|
|---|
| 182 | K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,"","1;3",.ECPAT)
|
|---|
| 183 | I 'OK S ECXERR=1
|
|---|
| 184 | Q ECXERR
|
|---|
| 185 | ;
|
|---|
| 186 | FILE(ECODE) ;
|
|---|
| 187 | ; Input - ECODE = extract record
|
|---|
| 188 | ;
|
|---|
| 189 | ; record the extract record at a global node in file 727.829
|
|---|
| 190 | ; sequence #^year/month of extract^extract #^facility^patient dfn^SSN^
|
|---|
| 191 | ; name^i/o pt indicator^encounter #^date of transfusion^time of
|
|---|
| 192 | ; transfusion^component^component abbrev^# of units^volume in mm^
|
|---|
| 193 | ; reaction^reaction type^feeder location^DSS product dept^DSS IP #
|
|---|
| 194 | ; ordering physician^ordering physician pc^emergency response indicator
|
|---|
| 195 | ; (FEMA)^unit modified^unit modification^requesting provider^request.
|
|---|
| 196 | ; provider person class^ordering provider npi ECPHYNPI
|
|---|
| 197 | ;ECODE1- requesting provider npi ECREQNPI
|
|---|
| 198 | ;note: DSS product dept and DSS IP # are dependent on the release of
|
|---|
| 199 | ; ECX*3*61
|
|---|
| 200 | N DA,DIK,EC7
|
|---|
| 201 | S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
|
|---|
| 202 | S ECODE=EC7_"^"_ECODE
|
|---|
| 203 | I ECXLOGIC>2007 D
|
|---|
| 204 | .S ECODE=ECODE_ECPHYNPI_U
|
|---|
| 205 | .S ECODE1=$G(ECREQNPI)
|
|---|
| 206 | S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=$G(ECODE1),ECRN=ECRN+1
|
|---|
| 207 | S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
|
|---|
| 208 | Q
|
|---|
| 209 | ;
|
|---|
| 210 | ;
|
|---|
| 211 | SETUP ;Set required input for ECXTRAC.
|
|---|
| 212 | S ECHEAD="LBB"
|
|---|
| 213 | D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
|
|---|
| 214 | Q
|
|---|
| 215 | ;
|
|---|
| 216 | LOCAL ; to extract nightly for local use not to be transmitted to TSI
|
|---|
| 217 | ; should be queued with a 1D frequency
|
|---|
| 218 | D SETUP,^ECXTLOCL,^ECXKILL Q
|
|---|
| 219 | ;
|
|---|
| 220 | QUE ; entry point for the background requeuing handled by ECXTAUTO
|
|---|
| 221 | D SETUP,QUE^ECXTAUTO,^ECXKILL
|
|---|
| 222 | Q
|
|---|
| 223 | ;
|
|---|
| 224 | ;ECXLBB
|
|---|
