| 1 | ECXUD ;ALB/JAP,BIR/DMA,PTD-Extract from UNIT DOSE EXTRACT DATA File (#728.904) ; 10/31/07 1:58pm
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**10,8,24,33,39,46,49,71,84,92,107,105**;Dec 22, 1997;Build 70
|
|---|
| 3 | BEG ;entry point from option
|
|---|
| 4 | I '$O(^ECX(728.904,"A",0)) W !,"There are no unit dose orders to extract",!! R X:5 K X Q
|
|---|
| 5 | D SETUP I ECFILE="" Q
|
|---|
| 6 | D ^ECXTRAC,^ECXKILL
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | START ;start package specific extract
|
|---|
| 10 | S QFLG=0
|
|---|
| 11 | S ECED=ECED+.3
|
|---|
| 12 | F ECD=ECSD1:0 S ECD=$O(^ECX(728.904,"A",ECD)) Q:'ECD Q:ECD>ECED Q:QFLG D
|
|---|
| 13 | .S ECXJ=0 F S ECXJ=$O(^ECX(728.904,"A",ECD,ECXJ)) Q:'ECXJ Q:QFLG I $D(^ECX(728.904,ECXJ,0)) D
|
|---|
| 14 | ..S DATA=^ECX(728.904,ECXJ,0),^(1)=$P(EC23,U,2),^ECX(728.904,"AC",$P(EC23,U,2),ECXJ)="" D STUFF
|
|---|
| 15 | K ^TMP($J,"ECXP")
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | STUFF ;get data
|
|---|
| 19 | N X,W,OK,P1,P3,PSTAT,PT,ECXPHA,ON,ECDRG
|
|---|
| 20 | S ECXDFN=$P(DATA,U,2),ECDRG=$P(DATA,U,4)
|
|---|
| 21 | ;
|
|---|
| 22 | ;get patient specific data
|
|---|
| 23 | S ECXERR="" D PAT(ECXDFN,ECD,.ECXERR)
|
|---|
| 24 | Q:ECXERR
|
|---|
| 25 | ;
|
|---|
| 26 | S ECXPRO=$P(DATA,U,7),ECPROIEN=+ECXPRO,ECXPRO=$E($P(ECXPRO,";",2))_$P(ECXPRO,";")
|
|---|
| 27 | S ECXPRNPI=$$NPI^XUSNPI("Individual_ID",ECPROIEN,ECD)
|
|---|
| 28 | S:+ECXPRNPI'>0 ECXPRNPI="" S ECXPRNPI=$P(ECXPRNPI,U)
|
|---|
| 29 | S W=$P(DATA,U,6)
|
|---|
| 30 | S ECXDIV=$P($G(^DIC(42,+W,0)),U,11),ECXW=$P($G(^DIC(42,+W,44)),U)
|
|---|
| 31 | S ECXUDDT=$$ECXDATE^ECXUTL($P(DATA,U,3),ECXYM)
|
|---|
| 32 | S ECXUDTM=$E($P($P(DATA,U,3),".",2)_"000000",1,6)
|
|---|
| 33 | S ECXQTY=$P(DATA,U,5),ECXCOST=$P(DATA,U,8),ON=$P(DATA,U,10)
|
|---|
| 34 | ;call pharmacy drug file (#50) api via ecxutl5
|
|---|
| 35 | S ECXPHA=$$PHAAPI^ECXUTL5(ECDRG)
|
|---|
| 36 | S ECCAT=$P(ECXPHA,U,2),ECINV=$P(ECXPHA,U,4)
|
|---|
| 37 | S ECINV=$S(ECINV["I":"I",1:"")
|
|---|
| 38 | S ECNDC=$P(ECXPHA,U,3)
|
|---|
| 39 | S ECNFC=$$RJ^XLFSTR($P(ECNDC,"-"),6,0)_$$RJ^XLFSTR($P(ECNDC,"-",2),4,0)_$$RJ^XLFSTR($P(ECNDC,"-",3),2,0),ECNFC=$TR(ECNFC,"*",0)
|
|---|
| 40 | S P1=$P(ECXPHA,U,5),P3=$P(ECXPHA,U,6),X="PSNAPIS"
|
|---|
| 41 | X ^%ZOSF("TEST") I $T S ECNFC=$$DSS^PSNAPIS(P1,P3,ECXYM)_ECNFC
|
|---|
| 42 | I $L(ECNFC)=12 S ECNFC=$$RJ^XLFSTR(P1,4,0)_$$RJ^XLFSTR(P3,3,0)_ECNFC
|
|---|
| 43 | ; - Department and National Production Division
|
|---|
| 44 | ;- Use of DSS Department postponed [S ECXDSSD=$$UDP^ECXDEPT(ECXDIV)]
|
|---|
| 45 | S ECXDSSD=""
|
|---|
| 46 | S ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV)
|
|---|
| 47 | ;- Observation patient indicator (YES/NO)
|
|---|
| 48 | S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS)
|
|---|
| 49 | ;- Ordering Date, Ordering Stop Code
|
|---|
| 50 | S ECXORDDT=$TR($$FMTE^XLFDT($P(DATA,U,9),"7DF")," /","0")
|
|---|
| 51 | S ECXORDST="" I ECXA="O" D
|
|---|
| 52 | .;Get ordering stop code based on FY 2006 logic for outpatient
|
|---|
| 53 | .S ECXORDST=$$DOUDO^ECXUTL5(ECXDFN,ON)
|
|---|
| 54 | ;Ordering Provider Person Class
|
|---|
| 55 | S ECXOPPC=$$PRVCLASS^ECXUTL($E(ECXPRO,2,999),$P(DATA,U,9))
|
|---|
| 56 | ;BCMA data (place holder)
|
|---|
| 57 | S (ECXBCDD,ECXBCDG,ECXBCUA,ECXBCIF)=""
|
|---|
| 58 | ;- Set national patient record flag if exist
|
|---|
| 59 | D NPRF^ECXUTL5
|
|---|
| 60 | ;- If no encounter number don't file record
|
|---|
| 61 | S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADM,$P(DATA,U,3),ECXTS,ECXOBS,ECHEAD,,)
|
|---|
| 62 | D:ECXENC'="" FILE
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | PAT(ECXDFN,ECXDATE,ECXERR) ;get demographics from patient file
|
|---|
| 66 | ;init variables
|
|---|
| 67 | S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP,ECXOEF,ECXOEFDT)=""
|
|---|
| 68 | ;get patient data if saved
|
|---|
| 69 | I $D(^TMP($J,"ECXP",ECXDFN)) D
|
|---|
| 70 | .S PT=^TMP($J,"ECXP",ECXDFN),ECXPNM=$P(PT,U),ECXSSN=$P(PT,U,2)
|
|---|
| 71 | .S ECXMPI=$P(PT,U,3),ECXDOB=$P(PT,U,4)
|
|---|
| 72 | .S ECXELIG=$P(PT,U,5),ECXSEX=$P(PT,U,6)
|
|---|
| 73 | .S ECXSTATE=$P(PT,U,7),ECXCNTY=$P(PT,U,8),ECXZIP=$P(PT,U,9)
|
|---|
| 74 | .S ECXVET=$P(PT,U,10),ECXPOS=$P(PT,U,11),ECXPST=$P(PT,U,12)
|
|---|
| 75 | .S ECXPLOC=$P(PT,U,13),ECXRST=$P(PT,U,14),ECXAST=$P(PT,U,15)
|
|---|
| 76 | .S ECXAOL=$P(PT,U,16),ECXPHI=$P(PT,U,17),ECXMST=$P(PT,U,18)
|
|---|
| 77 | .S ECXENRL=$P(PT,U,19),ECXCNHU=$P(PT,U,20),ECXCAT=$P(PT,U,21)
|
|---|
| 78 | .S ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23),ECXHNCI=$P(PT,U,24)
|
|---|
| 79 | .S ECXETH=$P(PT,U,25),ECXRC1=$P(PT,U,26),ECXMTST=$P(PT,U,27)
|
|---|
| 80 | .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2),ECXOEF=$P(PT1,U,3),ECXOEFDT=$P(PT1,U,4)
|
|---|
| 81 | .I $$ENROLLM^ECXUTL2(ECXDFN)
|
|---|
| 82 | ;set patient data
|
|---|
| 83 | I '$D(^TMP($J,"ECXP",ECXDFN)) D Q:'OK
|
|---|
| 84 | .K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECXDATE,"."),"1;2;3;5",.ECXPAT)
|
|---|
| 85 | .I 'OK K ECXPAT S ECXERR=1 Q
|
|---|
| 86 | .S ECXPNM=ECXPAT("NAME"),ECXSSN=ECXPAT("SSN"),ECXMPI=ECXPAT("MPI")
|
|---|
| 87 | .S ECXDOB=ECXPAT("DOB"),ECXELIG=ECXPAT("ELIG"),ECXSEX=ECXPAT("SEX")
|
|---|
| 88 | .S ECXSTATE=ECXPAT("STATE"),ECXCNTY=ECXPAT("COUNTY")
|
|---|
| 89 | .S ECXZIP=ECXPAT("ZIP"),ECXVET=ECXPAT("VET")
|
|---|
| 90 | .S ECXPOS=ECXPAT("POS"),ECXPST=ECXPAT("POW STAT")
|
|---|
| 91 | .S ECXPLOC=ECXPAT("POW LOC"),ECXRST=ECXPAT("IR STAT")
|
|---|
| 92 | .S ECXAST=ECXPAT("AO STAT"),ECXAOL=ECXPAT("AOL")
|
|---|
| 93 | .S ECXPHI=ECXPAT("PHI"),ECXMST=ECXPAT("MST STAT")
|
|---|
| 94 | .S ECXENRL=ECXPAT("ENROLL LOC"),ECXMTST=ECXPAT("MEANS")
|
|---|
| 95 | .;OEF/OIF data
|
|---|
| 96 | .S ECXOEF=ECXPAT("ECXOEF")
|
|---|
| 97 | .S ECXOEFDT=ECXPAT("ECXOEFDT")
|
|---|
| 98 | .;get CNHU status
|
|---|
| 99 | .S ECXCNHU=$$CNHSTAT^ECXUTL4(ECXDFN)
|
|---|
| 100 | .;get enrollment data (category, status and priority)
|
|---|
| 101 | .I $$ENROLLM^ECXUTL2(ECXDFN)
|
|---|
| 102 | .; - Head and Neck Cancer Indicator
|
|---|
| 103 | .S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
|
|---|
| 104 | .; - Race and Ethnicity
|
|---|
| 105 | .S ECXETH=ECXPAT("ETHNIC")
|
|---|
| 106 | .S ECXRC1=ECXPAT("RACE1")
|
|---|
| 107 | .;get emergency response indicator (FEMA)
|
|---|
| 108 | .S ECXERI=ECXPAT("ERI")
|
|---|
| 109 | .S ECXEST=ECXPAT("EC STAT")
|
|---|
| 110 | .;save for later
|
|---|
| 111 | .S ^TMP($J,"ECXP",ECXDFN)=ECXPNM_U_ECXSSN_U_ECXMPI_U_ECXDOB_U_ECXELIG_U_ECXSEX_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST
|
|---|
| 112 | .S ^TMP($J,"ECXP",ECXDFN)=^TMP($J,"ECXP",ECXDFN)_U_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXENRL_U_ECXCNHU_U_ECXCAT_U_ECXSTAT_U_ECXPRIOR_U_ECXHNCI_U_ECXETH_U_ECXRC1_U_ECXMTST
|
|---|
| 113 | .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST_U_ECXOEF_U_ECXOEFDT
|
|---|
| 114 | ;
|
|---|
| 115 | ;get inpatient data
|
|---|
| 116 | S X=$$INP^ECXUTL2(ECXDFN,ECXDATE),ECXA=$P(X,U),ECXMN=$P(X,U,2)
|
|---|
| 117 | S ECXTS=$P(X,U,3),ECXADM=$P(X,U,4),ECXDOM=$P(X,U,10)
|
|---|
| 118 | ;
|
|---|
| 119 | ;get primary care data
|
|---|
| 120 | S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,"."))
|
|---|
| 121 | S ECPTTM=$P(X,U),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4)
|
|---|
| 122 | S ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7)
|
|---|
| 123 | Q
|
|---|
| 124 | ;
|
|---|
| 125 | FILE ;file record
|
|---|
| 126 | ;node0
|
|---|
| 127 | ;facility^dfn^ssn^name^in/out^day^drug category^quantity^ward^
|
|---|
| 128 | ;provider^cost^mov #^treat spec^ndc^new feeder key^investigational^
|
|---|
| 129 | ;udp time^adm date^adm time
|
|---|
| 130 | ;node1
|
|---|
| 131 | ;mpi^dss dept^provider npi^dom^observ pat ind^encounter num^
|
|---|
| 132 | ;prod div code^means tst^elig^dob^sex^state^county^zip+4^vet^
|
|---|
| 133 | ;period of svc^pow stat^pow loc^ir status^ao status^ao loc^
|
|---|
| 134 | ;purple heart ind.^mst status^cnh/sh status^enrollment loc^
|
|---|
| 135 | ;enrollment cat^enrollment status^enrollment priority^pc team^
|
|---|
| 136 | ;pc provider^pc provider npi^pc provider p.class^assoc. pc provider^
|
|---|
| 137 | ;assoc. pc provider npi^assoc. pc provider p.class
|
|---|
| 138 | ;node2
|
|---|
| 139 | ;ordering date^ordering stop code^head & neck cancer ind.^ethnicity^
|
|---|
| 140 | ;race1^bcma drug dispensed^bcma dose given^bcma unit of
|
|---|
| 141 | ;administration^bcma icu flag^ordering provider person class^
|
|---|
| 142 | ;^enrollment priority ECXPRIOR_enrollment subgroup
|
|---|
| 143 | ;ECXSBGRP^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet
|
|---|
| 144 | ;elig ECXCVE^combat vet elig end date ECXCVEDT^enc cv eligible
|
|---|
| 145 | ;ECXCVENC^national patient record flag ECXNPRFI^emerg resp indic(FEMA)
|
|---|
| 146 | ;ECXERI^environ contamin ECXEST^OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT^associate pc provider npi ECASNPI^primary care provider npi ECPTNPI^provider npi ECXPRNPI
|
|---|
| 147 | N DA,DIK
|
|---|
| 148 | S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
|
|---|
| 149 | S ECODE=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
|
|---|
| 150 | S ECODE=ECODE_ECXUDDT_U_ECCAT_U_ECXQTY_U_ECXW_U_ECXPRO_U_ECXCOST_U
|
|---|
| 151 | S ECODE=ECODE_ECXMN_U_ECXTS_U_ECNDC_U_ECNFC_U_ECINV_U_ECXUDTM_U
|
|---|
| 152 | ;convert specialty to PTF Code for transmission
|
|---|
| 153 | N ECXDATA
|
|---|
| 154 | S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA)
|
|---|
| 155 | S ECXTS=$G(ECXDATA(7))
|
|---|
| 156 | ;done
|
|---|
| 157 | S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXADM,ECXYM)_U
|
|---|
| 158 | S ECODE=ECODE_$$ECXTIME^ECXUTL(ECXADM)_U
|
|---|
| 159 | S ECODE1=ECXMPI_U_ECXDSSD_U_U_ECXDOM_U_ECXOBS_U_ECXENC_U
|
|---|
| 160 | S ECODE1=ECODE1_ECXPDIV_U_ECXMTST_U_ECXELIG_U_ECXDOB_U_ECXSEX_U
|
|---|
| 161 | S ECODE1=ECODE1_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U
|
|---|
| 162 | S ECODE1=ECODE1_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST_U
|
|---|
| 163 | S ECODE1=ECODE1_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXCNHU_U_ECXENRL_U
|
|---|
| 164 | S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECPTTM_U_ECPTPR_U
|
|---|
| 165 | S ECODE1=ECODE1_U_ECCLAS_U_ECASPR_U_U_ECCLAS2_U
|
|---|
| 166 | S ECODE2=ECXORDDT_U_ECXORDST_U_ECXHNCI_U_ECXETH_U_ECXRC1
|
|---|
| 167 | I ECXLOGIC>2003 S ECODE2=ECODE2_U_ECXBCDD_U_ECXBCDG_U_ECXBCUA_U_ECXBCIF_U_ECXOPPC
|
|---|
| 168 | I ECXLOGIC>2004 S ECODE2=ECODE2_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
|
|---|
| 169 | I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXEST
|
|---|
| 170 | I ECXLOGIC>2007 S ECODE2=ECODE2_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_ECXPRNPI
|
|---|
| 171 | S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1
|
|---|
| 172 | S ^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1
|
|---|
| 173 | S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
|
|---|
| 174 | I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
|
|---|
| 175 | Q
|
|---|
| 176 | ;
|
|---|
| 177 | SETUP ;Set required input for ECXTRAC
|
|---|
| 178 | S ECHEAD="UDP"
|
|---|
| 179 | D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
|
|---|
| 180 | Q
|
|---|
| 181 | ;
|
|---|
| 182 | QUE ; entry point for the background requeuing handled by ECXTAUTO
|
|---|
| 183 | D SETUP,QUE^ECXTAUTO,^ECXKILL
|
|---|
| 184 | Q
|
|---|
