| 1 | ECXLBB1 ;ALB/JRC - DSS VBECS EXTRACT ; 7/24/08 12:01pm
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**105,102**;Dec 22, 1997;Build 17
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | ; access to the VBECS EXTRACT file (#6002.03) is supported by
|
|---|
| 5 | ; controlled subscription to IA #4953 (global root ^VBECS(6002.03)
|
|---|
| 6 | BEG ;entry point from option
|
|---|
| 7 | D SETUP I ECFILE="" Q
|
|---|
| 8 | D ^ECXTRAC,^ECXKILL
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | START ; Entry point from tasked job
|
|---|
| 12 | ; begin package specific extract
|
|---|
| 13 | N ECTRSP,ECADMT,ECTODT,ECENCTR,ECPAT,ECLRDFN,ECXPHY,ECXPHYPC
|
|---|
| 14 | N ECD,ECXDFN,ECARRY,EC66,ECERR,ECTRFDT,ECTRFTM,ECX,ECINOUT,ECXINST
|
|---|
| 15 | N ECPHYNPI,ECREQNPI
|
|---|
| 16 | ;variables ECFILE,EC23,ECXYM,ECINST,ECSD,ECSD1,ECED passed in
|
|---|
| 17 | ; by taskmanager
|
|---|
| 18 | ; ECED defined in ^ECXTRAC - end date of the extract
|
|---|
| 19 | ; TRANSFUSION DATE should be within start and end dates
|
|---|
| 20 | ; ECED and ECSD input provided by the user interface
|
|---|
| 21 | ; and ECSD1 = ECSD-.1
|
|---|
| 22 | ; Read through the VBECS DSS EXTRACT file (6002.03)
|
|---|
| 23 | I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 Q ;quit if tasked and user sends stop request (QFLG assigned in ECXTRAC)
|
|---|
| 24 | ;
|
|---|
| 25 | AUDRPT ; entry point for pre-extract audit report
|
|---|
| 26 | S RECORD=0,ECD=ECSD-.1,ECTODT=ECED+.9
|
|---|
| 27 | F S ECD=$O(^VBEC(6002.03,"C",ECD)) Q:'ECD!(ECD>ECTODT) S RECORD=0 F S RECORD=$O(^VBEC(6002.03,"C",ECD,RECORD)) Q:RECORD'>0 S EC0=^VBEC(6002.03,RECORD,0) D
|
|---|
| 28 | .; ECARRY(1)=TRANSFUSION DATE AND TIME, ECARRY(3)=COMPONENT
|
|---|
| 29 | .; ECARRY(4)=COMPONENT ABBREVIATION, ECARRY(5)=UNITS POOLED
|
|---|
| 30 | .; ECARRY(6)=TRANSFUSION REACTION,ECARRY(7)=VOLUME TRANSFUSED
|
|---|
| 31 | .; ECARRY(8)=TRANSFUSION REACTION TYPE, ECARRY(9)=REQUESTING PROVIDER
|
|---|
| 32 | .; ECARRY(10)=REQUEST. PROV. PERSON CLASS, ECARRY(11)=UNIT MODIFIED
|
|---|
| 33 | .; ECARRY(12)=UNIT MODIFICATION, ECARRY(13)=PRODUCTION DIVISION CODE
|
|---|
| 34 | .;
|
|---|
| 35 | . S ECXDFN=$P(EC0,U,2),ECERR=$$PAT(ECXDFN) Q:ECERR
|
|---|
| 36 | . S ECARRY(1)=$P(EC0,U,10),ECARRY(3)=$P(EC0,U,7),ECARRY(4)=$P(EC0,U,8),ECARRY(5)=$S(+$P(EC0,U,9)=0:1,1:+$P(EC0,U,9)),ECARRY(6)=$S($P(EC0,U,15):"Y",1:"N"),ECARRY(7)=$P(EC0,"^",12),ECARRY(8)=$P(EC0,U,13)
|
|---|
| 37 | . S ECARRY(9)=$P(EC0,U,6),ECINST=$P(EC0,U,3),ECARRY(12)=$P(EC0,U,14),ECARRY(11)=$S(ECARRY(12)'="":"Y",1:"N"),ECARRY(13)=$P(EC0,U,4)
|
|---|
| 38 | . ;get requesting and ordering providers and their person class
|
|---|
| 39 | . S ECXPHY=$P(EC0,U,5),(ECXPHYPC,ECARRY(10),ECPHYNPI,ECREQNPI)=""
|
|---|
| 40 | . I ECXPHY]"" S ECXPHY=$O(^VA(200,"B",ECXPHY,0))
|
|---|
| 41 | . I ECXPHY>0 D
|
|---|
| 42 | .. N PERCLS S PERCLS=$$GET^XUA4A72(ECXPHY,ECD)
|
|---|
| 43 | .. I +PERCLS>0 S ECXPHYPC=$P(PERCLS,U,7)
|
|---|
| 44 | .. S ECPHYNPI=$$NPI^XUSNPI("Individual_ID",ECXPHY,ECD)
|
|---|
| 45 | .. S:+ECPHYNPI'>0 ECPHYNPI="" S ECPHYNPI=$P(ECPHYNPI,U)
|
|---|
| 46 | .. S ECXPHY=2_ECXPHY
|
|---|
| 47 | . I ECARRY(9)>0 D
|
|---|
| 48 | .. N PERCLS S PERCLS=$$GET^XUA4A72(ECARRY(9),ECD)
|
|---|
| 49 | .. I +PERCLS>0 S ECARRY(10)=$P(PERCLS,U,7)
|
|---|
| 50 | .. S ECREQNPI=$$NPI^XUSNPI("Individual_ID",ECARRY(9),ECD)
|
|---|
| 51 | .. S:+ECREQNPI'>0 ECREQNPI="" S ECREQNPI=$P(ECREQNPI,U)
|
|---|
| 52 | .. S ECARRY(9)=2_ECARRY(9)
|
|---|
| 53 | . D GETDATA
|
|---|
| 54 | . K ECARRY
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | GETDATA ; gather rest of extract data that will be recorded in an
|
|---|
| 58 | ; entry in file 727.829
|
|---|
| 59 | S ECTRFDT=$$ECXDOB^ECXUTL(ECARRY(1)),ECTRFTM=$$ECXTIME^ECXUTL(ECARRY(1))
|
|---|
| 60 | S ECX=$$INP^ECXUTL2(ECXDFN,ECARRY(1)),ECINOUT=$P(ECX,U),ECTRSP=$P(ECX,U,3),ECADMT=$P(ECX,U,4)
|
|---|
| 61 | ;
|
|---|
| 62 | ;- Observation patient indicator (YES/NO)
|
|---|
| 63 | S ECXOBS=$$OBSPAT^ECXUTL4(ECINOUT,ECTRSP)
|
|---|
| 64 | ;- If no encounter number don't file record
|
|---|
| 65 | S ECENCTR=$$ENCNUM^ECXUTL4(ECINOUT,ECPAT("SSN"),ECADMT,ECARRY(1),ECTRSP,ECXOBS,ECHEAD,,) ; [FLD #6]
|
|---|
| 66 | Q:ECENCTR=""
|
|---|
| 67 | ;get emergency response indicator (FEMA)
|
|---|
| 68 | S ECXERI=$G(ECPAT("ERI"))
|
|---|
| 69 | ;
|
|---|
| 70 | 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)_"^^"
|
|---|
| 71 | I $G(ECXLOGIC)>2005 S ECXSTR=ECXSTR_U_ECXPHY_U_ECXPHYPC
|
|---|
| 72 | I $G(ECXLOGIC)>2006 D
|
|---|
| 73 | .S ECXSTR=ECXSTR_U_ECXERI_U_ECARRY(11)_U_ECARRY(12)_U_ECARRY(9)_U_ECARRY(10)_U_ECARRY(13)_U
|
|---|
| 74 | I '$D(ECXRPT) D FILE(ECXSTR) Q
|
|---|
| 75 | S ^TMP("ECXLBB",$J,ECXDFN,ECD)=ECXSTR ;temporary global array
|
|---|
| 76 | ; used in ECXPLBB (pre-extract audit report)
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | PAT(ECXDFN) ;get/set patient data
|
|---|
| 80 | ; INPUT - ECXDFN = patient ien (DFN)
|
|---|
| 81 | ; OUTPUT - ECPAT array:
|
|---|
| 82 | ; ECPAT("SSN")
|
|---|
| 83 | ; ECPAT("NAME")
|
|---|
| 84 | ; returns 0 or 1 in ECXERR - 0=successful
|
|---|
| 85 | ; 1=error condition
|
|---|
| 86 | N X,OK,ECXERR
|
|---|
| 87 | ;get data
|
|---|
| 88 | S ECXERR=0
|
|---|
| 89 | K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,"","1;3",.ECPAT)
|
|---|
| 90 | I 'OK S ECXERR=1
|
|---|
| 91 | Q ECXERR
|
|---|
| 92 | ;
|
|---|
| 93 | FILE(ECODE) ;
|
|---|
| 94 | ; Input - ECODE = extract record
|
|---|
| 95 | ;
|
|---|
| 96 | ; record the extract record at a global node in file 727.829
|
|---|
| 97 | ; sequence #^year/month of extract^extract #^facility^patient dfn^SSN^
|
|---|
| 98 | ; name^i/o pt indicator^encounter #^date of transfusion^time of
|
|---|
| 99 | ; transfusion^component^component abbrev^# of units^volume in mm^
|
|---|
| 100 | ; reaction^reaction type^feeder location^DSS product dept^DSS IP #
|
|---|
| 101 | ; ordering physician^ordering physician pc^emergency response indicator
|
|---|
| 102 | ; (FEMA)^unit modified^unit modification^requesting provider^request.
|
|---|
| 103 | ; provider person class^ordering provider npi ECPHYNPI
|
|---|
| 104 | ;ECODE1- requesting provider npi ECREQNPI
|
|---|
| 105 | ;note: DSS product dept and DSS IP # are dependent on the release of
|
|---|
| 106 | ; ECX*3*61
|
|---|
| 107 | N DA,DIK,EC7
|
|---|
| 108 | S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
|
|---|
| 109 | S ECODE=EC7_"^"_ECODE
|
|---|
| 110 | I ECXLOGIC>2007 D
|
|---|
| 111 | .S ECODE=ECODE_ECPHYNPI_U
|
|---|
| 112 | .S ECODE1=$G(ECREQNPI)
|
|---|
| 113 | S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=$G(ECODE1),ECRN=ECRN+1
|
|---|
| 114 | S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
|
|---|
| 115 | Q
|
|---|
| 116 | ;
|
|---|
| 117 | SETUP ;Set required input for ECXTRAC.
|
|---|
| 118 | S ECHEAD="LBB"
|
|---|
| 119 | D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | LOCAL ; to extract nightly for local use not to be transmitted to TSI
|
|---|
| 123 | ; should be queued with a 1D frequency
|
|---|
| 124 | D SETUP,^ECXTLOCL,^ECXKILL Q
|
|---|
| 125 | ;
|
|---|
| 126 | CHKMOD(MD) ;check if modifier is contained in string
|
|---|
| 127 | N RES,MODX
|
|---|
| 128 | I MD="" Q ""
|
|---|
| 129 | S (RES,MODX)="" F S MODX=$O(MODARY(MODX)) Q:MODX="" D I RES'="" Q
|
|---|
| 130 | .I MD[MODX S RES=MODARY(MODX)
|
|---|
| 131 | Q RES
|
|---|
| 132 | ;
|
|---|
| 133 | QUE ; entry point for the background requeuing handled by ECXTAUTO
|
|---|
| 134 | D SETUP,QUE^ECXTAUTO,^ECXKILL
|
|---|
| 135 | Q
|
|---|
| 136 | ;
|
|---|
| 137 | ;ECXLBB
|
|---|
