[623] | 1 | ECXADM ;ALB/JAP,BIR/DMA,CML,PTD-Admissions Extract ; 04/12/2007
|
---|
| 2 | ;;3.0;DSS EXTRACTS;**1,4,11,8,13,24,33,39,46,71,84,92,107**;Dec 22, 1997;Build 9
|
---|
| 3 | BEG ;entry point from option
|
---|
| 4 | D SETUP I ECFILE="" Q
|
---|
| 5 | D ^ECXTRAC,^ECXKILL
|
---|
| 6 | Q
|
---|
| 7 | ;
|
---|
| 8 | START ; start package specific extract
|
---|
| 9 | S QFLG=0
|
---|
| 10 | S ECED=ECED+.3,ECD=ECSD1
|
---|
| 11 | F S ECD=$O(^DGPM("ATT1",ECD)),ECDA=0 Q:('ECD)!(ECD>ECED) D
|
---|
| 12 | .F S ECDA=$O(^DGPM("ATT1",ECD,ECDA)) Q:ECDA="" D
|
---|
| 13 | ..I $D(^DGPM(ECDA,0)) D
|
---|
| 14 | ...S EC=^DGPM(ECDA,0),ECXDFN=$P(EC,U,3) D GET
|
---|
| 15 | Q
|
---|
| 16 | ;
|
---|
| 17 | GET ;gather extract data
|
---|
| 18 | N ADM,W,X,ECXNPRFI,ECXATTPC,ECXPRVPC,ECXEST
|
---|
| 19 | ;patient demographics
|
---|
| 20 | S ECXERR=0 D PAT(ECXDFN,ECD,.ECXERR)
|
---|
| 21 | Q:ECXERR
|
---|
| 22 | I $$ENROLLM^ECXUTL2(ECXDFN)
|
---|
| 23 | S ECXFAC=$P($G(^DIC(42,+$P(EC,U,6),0)),U,11)
|
---|
| 24 | S ECXPDIV=$$GETDIV^ECXDEPT(ECXFAC) ;Get production division
|
---|
| 25 | ;admission data
|
---|
| 26 | S ELGA=$P($G(^DIC(8,+$P(EC,U,20),0)),U,9)
|
---|
| 27 | I ELGA S ELGA=$$ELIG^ECXUTL3(ELGA,ECXSVC)
|
---|
| 28 | S (ECDRG,ECDIA,ECXSADM)="",ECPTF=+$P(EC,U,16) I ECPTF,$D(^DGPT(ECPTF,"M")) D PTF
|
---|
| 29 | ;get encounter classification
|
---|
| 30 | S (ECXAO,ECXECE,ECXIR,ECXMIL,ECXHNC)="",ECXVISIT=$P(EC,U,27)
|
---|
| 31 | I ECXVISIT'="" D
|
---|
| 32 | .D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR Q
|
---|
| 33 | .S ECXAO=$G(ECXVIST("AO")),ECXIR=$G(ECXVIST("IR"))
|
---|
| 34 | .S ECXMIL=$G(ECXVIST("MST")),ECXHNC=$G(ECXVIST("HNC"))
|
---|
| 35 | .S ECXECE=$G(ECXVIST("PGE"))
|
---|
| 36 | ;use movement record date & time
|
---|
| 37 | S ADM=$$INP^ECXUTL2(ECXDFN,ECD)
|
---|
| 38 | S ECXA=$P(ADM,U),ECXMN=$P(ADM,U,2),ECXSPC=$P(ADM,U,3)
|
---|
| 39 | S (ECXADMDT,ECXDATE)=$P(ADM,U,4)
|
---|
| 40 | ;if movement# doesn't match cross-ref ien, then quit
|
---|
| 41 | Q:ECXMN'=ECDA
|
---|
| 42 | S ECTM=$$ECXTIME^ECXUTL(ECXDATE)
|
---|
| 43 | S ECXDATE=$$ECXDATE^ECXUTL(ECXDATE,ECXYM)
|
---|
| 44 | S W=$P(ADM,U,9)
|
---|
| 45 | S ECXWRD=$P(W,";",1),ECXFAC=$P(W,";",2),ECXDSSD=$P(W,";",3)
|
---|
| 46 | S ECXPRV=$P(ADM,U,7),ECXPRNPI="",ECXATT=$P(ADM,U,8),ECXATNPI=""
|
---|
| 47 | S ECXDOM=$P(ADM,U,10),ECXATTPC=$P(ADM,U,12),ECXPRVPC=$P(ADM,U,11)
|
---|
| 48 | ;
|
---|
| 49 | ;- Observation patient indicator (YES/NO)
|
---|
| 50 | S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXSPC)
|
---|
| 51 | ;
|
---|
| 52 | ;- Patient Type
|
---|
| 53 | S ECXPTYPE=$$TYPE^ECXUTL5(ECXDFN)
|
---|
| 54 | ;
|
---|
| 55 | ;- If null encounter number, don't file record
|
---|
| 56 | S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,,ECXSPC,ECXOBS,ECHEAD,,)
|
---|
| 57 | D:ECXENC'="" FILE
|
---|
| 58 | Q
|
---|
| 59 | ;
|
---|
| 60 | PAT(ECXDFN,ECXDATE,ECXERR) ;get patient demographic data
|
---|
| 61 | N OK,X
|
---|
| 62 | K ECXPAT
|
---|
| 63 | S ECXDATE=$P(ECXDATE,".")
|
---|
| 64 | S OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;2;3;4;5",.ECXPAT)
|
---|
| 65 | I 'OK S ECXERR=1 K ECXPAT Q
|
---|
| 66 | S ECXSSN=ECXPAT("SSN")
|
---|
| 67 | S ECXPNM=ECXPAT("NAME")
|
---|
| 68 | S ECXMPI=ECXPAT("MPI")
|
---|
| 69 | S ECXSEX=ECXPAT("SEX")
|
---|
| 70 | S ECXDOB=ECXPAT("DOB")
|
---|
| 71 | S ECXELIG=ECXPAT("ELIG")
|
---|
| 72 | S ECXVET=ECXPAT("VET")
|
---|
| 73 | S ECXVNS=ECXPAT("VIETNAM")
|
---|
| 74 | S ECXPOS=ECXPAT("POS")
|
---|
| 75 | S ECXMNS=ECXPAT("MEANS")
|
---|
| 76 | S ECXRACE=ECXPAT("RACE")
|
---|
| 77 | S ECXRELG=ECXPAT("RELIGION")
|
---|
| 78 | S ECXEMP=ECXPAT("EMPLOY")
|
---|
| 79 | S ECXMAR=ECXPAT("MARITAL")
|
---|
| 80 | S ECXPST=ECXPAT("POW STAT")
|
---|
| 81 | S ECXPLOC=ECXPAT("POW LOC")
|
---|
| 82 | S ECXRST=ECXPAT("IR STAT")
|
---|
| 83 | S ECXAST=ECXPAT("AO STAT")
|
---|
| 84 | S ECXMST=ECXPAT("MST STAT")
|
---|
| 85 | S ECXSTATE=ECXPAT("STATE")
|
---|
| 86 | S ECXCNTY=ECXPAT("COUNTY")
|
---|
| 87 | S ECXZIP=ECXPAT("ZIP")
|
---|
| 88 | S ECXENRL=ECXPAT("ENROLL LOC")
|
---|
| 89 | S ECXSVC=ECXPAT("SC%")
|
---|
| 90 | S ECXPHI=ECXPAT("PHI")
|
---|
| 91 | S ECXHI=+$$INSUR^IBBAPI(ECXDFN,ECXDATE)
|
---|
| 92 | S ECXEST=ECXPAT("EC STAT")
|
---|
| 93 | ;
|
---|
| 94 | ;- Agent Orange location
|
---|
| 95 | S ECXAOL=ECXPAT("AOL")
|
---|
| 96 | ;
|
---|
| 97 | ; - Head and Neck Cancer Indicator
|
---|
| 98 | S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
|
---|
| 99 | ; - Race and Ethnicity
|
---|
| 100 | S ECXETH=ECXPAT("ETHNIC")
|
---|
| 101 | S ECXRC1=ECXPAT("RACE1")
|
---|
| 102 | ;
|
---|
| 103 | ;get primary care data
|
---|
| 104 | S X=$$PRIMARY^ECXUTL2(ECXDFN,ECXDATE)
|
---|
| 105 | S ECPTTM=$P(X,U),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4)
|
---|
| 106 | S ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7)
|
---|
| 107 | ;get combat veteran data
|
---|
| 108 | I $$CVEDT^ECXUTL5(ECXDFN,ECD)
|
---|
| 109 | ;get national patient record flag if exist
|
---|
| 110 | D NPRF^ECXUTL5
|
---|
| 111 | ;get emergency response indicator (FEMA)
|
---|
| 112 | S ECXERI=ECXPAT("ERI")
|
---|
| 113 | Q
|
---|
| 114 | ;
|
---|
| 115 | PTF ; get admitting DRG, diagnosis, source of admission from PTF
|
---|
| 116 | ;use number for DRG and .01 for diagnosis
|
---|
| 117 | N EC,EC1,ECX
|
---|
| 118 | S EC=1 I $D(^DGPT(ECPTF,"M",2,0)) S EC=2
|
---|
| 119 | S EC1=+$P(^DGPT(ECPTF,"M",EC,0),U,5)
|
---|
| 120 | S ECDRG=$P($G(^DGPT(ECPTF,"M",EC,"P")),U)
|
---|
| 121 | S ECDIA=$P($G(^ICD9(EC1,0)),U)
|
---|
| 122 | S ECX=+$P($G(^DGPT(ECPTF,101)),U),ECXSADM=$P($G(^DIC(45.1,ECX,0)),U,11)
|
---|
| 123 | Q
|
---|
| 124 | ;
|
---|
| 125 | FILE ;file the extract record
|
---|
| 126 | ;node0
|
---|
| 127 | ;facility^dfn^ssn^name^in/out^day^primary care team^sex^dob^
|
---|
| 128 | ;religion^employment status^health ins^state^county^zip^
|
---|
| 129 | ;eligibility^vet^vietnam^agent orange^radiation^pow^
|
---|
| 130 | ;period of service^means test^marital status^
|
---|
| 131 | ;ward^treating specialty^attending physician^mov #^DRG^diagnosis^
|
---|
| 132 | ;time^primary care provider^race^primary ward provider
|
---|
| 133 | ;node1
|
---|
| 134 | ;mpi^dss dept^attending npi^pc provider npi^ward provider npi^
|
---|
| 135 | ;admission elig^mst status^^sharing payor^
|
---|
| 136 | ;sharing insurance^enrollment location^
|
---|
| 137 | ;pc prov person class^assoc pc provider^assoc pc prov person class^
|
---|
| 138 | ;assoc pc prov npi^dom^enrollment cat^enrollment stat^enrollment
|
---|
| 139 | ;priority^purple heart ind.^obs pat ind^encounter num^agent orange
|
---|
| 140 | ;loc^production div^pow loc^source of admission^head & neck canc. ind
|
---|
| 141 | ;^ethnicity^race1^enrollment priority_sub group^user enrollee^patient
|
---|
| 142 | ;type^combat vet elig^combat vet elig end date^enc cv eligible^
|
---|
| 143 | ;national patient record flag ECXNPRFI^att phy person class ECXATTPC
|
---|
| 144 | ;^primary ward provider person class ECXPRVPC^environ contamin ECXEST
|
---|
| 145 | ;^emergency response indicator(FEMA) ECXERI^agent orange indic ECXAO
|
---|
| 146 | ;^environ contam ECXECE^encoun head/neck ECXHNC^encoun MST ECXMIL^rad
|
---|
| 147 | ;encoun ECXIR
|
---|
| 148 | ;
|
---|
| 149 | ;Convert specialty to PTF Code
|
---|
| 150 | ;
|
---|
| 151 | N ECXDATA
|
---|
| 152 | S ECXDATA=$$TSDATA^DGACT(42.4,+ECXSPC,.ECXDATA)
|
---|
| 153 | S ECXSPC=$G(ECXDATA(7))
|
---|
| 154 | ;
|
---|
| 155 | N DA,DIK
|
---|
| 156 | S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
|
---|
| 157 | S ECODE=EC7_U_EC23_U_ECXFAC_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U_ECXDATE_U
|
---|
| 158 | S ECODE=ECODE_ECPTTM_U_ECXSEX_U_ECXDOB_U_ECXRELG_U
|
---|
| 159 | S ECODE=ECODE_ECXEMP_U_ECXHI_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U
|
---|
| 160 | S ECODE=ECODE_ECXELIG_U_ECXVET_U_ECXVNS_U_ECXAST_U_ECXRST_U_ECXPST_U
|
---|
| 161 | S ECODE=ECODE_ECXPOS_U_ECXMNS_U_ECXMAR_U
|
---|
| 162 | S ECODE=ECODE_ECXWRD_U_ECXSPC_U_ECXATT_U_ECDA_U_ECDRG_U_ECDIA_U
|
---|
| 163 | S ECODE=ECODE_ECTM_U_ECPTPR_U_ECXRACE_U_ECXPRV_U
|
---|
| 164 | S ECODE1=ECXMPI_U_ECXDSSD_U_ECXATNPI_U_ECPTNPI_U_ECXPRNPI_U_ELGA_U
|
---|
| 165 | S ECODE1=ECODE1_ECXMST_U_U_U_U_ECXENRL_U_ECCLAS_U
|
---|
| 166 | S ECODE1=ECODE1_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXCAT_U
|
---|
| 167 | S ECODE1=ECODE1_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPHI_U_ECXOBS_U_ECXENC_U_ECXAOL_U
|
---|
| 168 | S ECODE1=ECODE1_ECXPDIV_U_ECXPLOC_U_ECXSADM_U_ECXHNCI_U_ECXETH_U
|
---|
| 169 | S ECODE1=ECODE1_ECXRC1
|
---|
| 170 | I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
|
---|
| 171 | I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXATTPC_U_ECXPRVPC_U_ECXEST
|
---|
| 172 | I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR
|
---|
| 173 | S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1
|
---|
| 174 | S ECRN=ECRN+1
|
---|
| 175 | S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
|
---|
| 176 | Q
|
---|
| 177 | ;
|
---|
| 178 | SETUP ;Set required input for ECXTRAC.
|
---|
| 179 | S ECHEAD="ADM"
|
---|
| 180 | D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
|
---|
| 181 | Q
|
---|
| 182 | ;
|
---|
| 183 | LOCAL ; to extract nightly for local use not to be transmitted to TSI
|
---|
| 184 | ; should be queued with a 1D frequency
|
---|
| 185 | D SETUP,^ECXTLOCL,^ECXKILL Q
|
---|
| 186 | ;
|
---|
| 187 | QUE ; entry point for the background requeuing handled by ECXTAUTO
|
---|
| 188 | D SETUP,QUE^ECXTAUTO,^ECXKILL Q
|
---|
| 189 | ;
|
---|