| [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 |  ;
 | 
|---|