- ECXADM ;ALB/JAP,BIR/DMA,CML,PTD-Admissions Extract ;2/14/20 08:46
- ;;3.0;DSS EXTRACTS;**1,4,11,8,13,24,33,39,46,71,84,92,107,105,120,127,132,136,144,149,154,161,166,170,174,178,184**;Dec 22, 1997;Build 124
- BEG ;entry point from option
- D SETUP I ECFILE="" Q
- D ^ECXTRAC,^ECXKILL
- Q
- ;
- START ; start package specific extract
- K ^TMP($J,"EDIS") ;136 Clear temporary space for index
- D BLDXREF^ECXUTL1(ECSD,ECED) ;136 build temp xref for emergency dept
- S QFLG=0
- S ECED=ECED+.3,ECD=ECSD1
- F S ECD=$O(^DGPM("ATT1",ECD)),ECDA=0 Q:('ECD)!(ECD>ECED) D
- .F S ECDA=$O(^DGPM("ATT1",ECD,ECDA)) Q:ECDA="" D
- ..I $D(^DGPM(ECDA,0)) D
- ...S EC=^DGPM(ECDA,0),ECXDFN=$P(EC,U,3) D GET
- ;170 Added section to look at transfers and record an admission record if transfer to ASIH other facility happens
- S ECD=ECSD1
- F S ECD=$O(^DGPM("ATT2",ECD)),ECDA=0 Q:('ECD)!(ECD>ECED) D
- .F S ECDA=$O(^DGPM("ATT2",ECD,ECDA)) Q:ECDA="" D
- ..I $D(^DGPM(ECDA,0))&($$ISASIH^ECXUTL6(ECDA,2)) D
- ...I '+$$NEEDADR^ECXUTL6("TRAN",ECDA,"ADM") Q ;Already have ADM record
- ...S EC=^DGPM(ECDA,0),ECXDFN=$P(EC,U,3) D GET
- K ^TMP($J,"EDIS") ;136 delete temporary xref
- Q
- ;
- GET ;gather extract data
- N ADM,W,X,ECXNPRFI,ECXATTPC,ECXPRVPC,ECXEST,ECXAOT,ECXEDIS,ECXICD10P ;136
- N ECXESC,ECXECL,ECXCLST ;144 Encounter Service Connected, Encounter Camp Lejeune, Camp Lejeune Status
- N ECXSTANO ;166 Patient Division
- N ECXASIH ;170 Is patient ASIH other facility
- N ECXNMPI,ECXCERN,ECXSIG ;184 - New fields
- ;patient demographics
- S ECXERR=0 D PAT(ECXDFN,ECD,.ECXERR)
- Q:ECXERR
- I $$ENROLLM^ECXUTL2(ECXDFN)
- S ECXFAC=$P($G(^DIC(42,+$P(EC,U,6),0)),U,11)
- S ECXPDIV=$$GETDIV^ECXDEPT(ECXFAC) ;Get production division
- S ECXSTANO=ECXPDIV ;Set Patient Division to Prod Div Code. tjl - 166
- ;admission data
- S ELGA=$P($G(^DIC(8,+$P(EC,U,20),0)),U,9)
- I ELGA S ELGA=$$ELIG^ECXUTL3(ELGA,ECXSVC)
- S (ECDRG,ECDIA,ECXSADM,ECXADMS,ECXAOT,ECXICD10P)="",ECPTF=+$P(EC,U,16) I ECPTF,$D(^DGPT(ECPTF,"M")) D PTF ;154
- ;get encounter classification
- S (ECXAO,ECXECE,ECXIR,ECXMIL,ECXHNC,ECXSHAD,ECXESC,ECXECL)="",ECXVISIT=$P(EC,U,27) ;144
- I ECXVISIT'="" D
- .D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR Q
- .S ECXAO=$G(ECXVIST("AO")),ECXIR=$G(ECXVIST("IR"))
- .S ECXMIL=$G(ECXVIST("MST")),ECXHNC=$G(ECXVIST("HNC"))
- .S ECXECE=$G(ECXVIST("PGE")),ECXSHAD=$G(ECXVIST("SHAD"))
- .S ECXESC=$G(ECXVIST("ENCSC")),ECXECL=$G(ECXVIST("ENCCL")) ;144 Encounter SC and Encounter Camp Lejeune
- ;use movement record date & time
- S ADM=$$INP^ECXUTL2(ECXDFN,ECD)
- S ECXA=$P(ADM,U),ECXMN=$P(ADM,U,2),ECXSPC=$P(ADM,U,3)
- S (ECXADMDT,ECXDATE)=$P(ADM,U,4)
- ;if movement# doesn't match cross-ref ien, then quit
- Q:ECXMN'=ECDA
- S ECTM=$$ECXTIME^ECXUTL(ECXDATE)
- S ECXDATE=$$ECXDATE^ECXUTL(ECXDATE,ECXYM)
- S W=$P(ADM,U,9)
- ;ECA_U_ECMN_U_ECTS_U_ECADM_U_ECWARD_U_ECDC_U_ECXPWP_U_ECXATP_U_ECXWW_U_ECXDOM_U_ECXPWPPC_U_ECXATPPC_U_ECXDWARD_U_ECXASIH
- S ECXWRD=$P(W,";",1),ECXFAC=$P(W,";",2),ECXDSSD=$P(W,";",3)
- S ECXPRV=$P(ADM,U,7),ECXPRNPI="",ECXATT=$P(ADM,U,8),ECXATNPI=""
- S ECXDOM=$P(ADM,U,10),ECXATTPC=$P(ADM,U,12),ECXPRVPC=$P(ADM,U,11)
- S ECXASIH=+$P(ADM,U,14) ;ASIH other facility status
- N ECXUSRTN
- S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",$E(ECXATT,2,$L(ECXATT)),ECD)
- S:+ECXUSRTN'>0 ECXUSRTN=""
- S ECATTNPI=$P(ECXUSRTN,U)
- S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",$E(ECXPRV,2,$L(ECXPRV)),ECD)
- S:+ECXUSRTN'>0 ECXUSRTN=""
- S ECPWNPI=$P(ECXUSRTN,U)
- ;
- ;- Observation patient indicator (YES/NO)
- S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXSPC)
- ;
- ;- Patient Type
- S ECXPTYPE=$$TYPE^ECXUTL5(ECXDFN)
- ;
- S ECXEDIS=$$EDIS^ECXUTL1(ECXDFN,ECD,"A") ;136 Get emergency room disposition
- ;- If null encounter number, don't file record
- S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,,ECXSPC,ECXOBS,ECHEAD,,)
- I $G(ECXASIH) S ECXA="A" ;170 If patient is ASIH set in/out indicator to A
- D:ECXENC'="" FILE
- Q
- ;
- PAT(ECXDFN,ECXDATE,ECXERR) ;get patient demographic data
- N OK,X
- K ECXPAT
- S ECXDATE=$P(ECXDATE,".")
- S OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;2;3;4;5",.ECXPAT)
- I 'OK S ECXERR=1 K ECXPAT Q
- S ECXSSN=ECXPAT("SSN")
- S ECXPNM=ECXPAT("NAME")
- S ECXMPI=ECXPAT("MPI")
- S ECXSEX=ECXPAT("SEX")
- S ECXDOB=ECXPAT("DOB")
- S ECXELIG=ECXPAT("ELIG")
- S ECXVET=ECXPAT("VET")
- S ECXVNS=ECXPAT("VIETNAM")
- S ECXPOS=ECXPAT("POS")
- S ECXMNS=ECXPAT("MEANS")
- S ECXRACE=ECXPAT("RACE")
- S ECXRELG=ECXPAT("RELIGION") S:ECXLOGIC>2019 ECXRELG="" ;174 - TJL - Field retired
- S ECXEMP=ECXPAT("EMPLOY")
- S ECXMAR=ECXPAT("MARITAL")
- S ECXPST=ECXPAT("POW STAT")
- S ECXPLOC=ECXPAT("POW LOC")
- S ECXRST=ECXPAT("IR STAT")
- S ECXAST=ECXPAT("AO STAT")
- S ECXMST=ECXPAT("MST STAT")
- S ECXSTATE=ECXPAT("STATE")
- S ECXCNTY=ECXPAT("COUNTY")
- S ECXZIP=ECXPAT("ZIP")
- S ECXCNTRY=ECXPAT("COUNTRY")
- S ECXENRL=ECXPAT("ENROLL LOC")
- S ECXSVC=ECXPAT("SC%")
- S ECXPHI=ECXPAT("PHI")
- S ECXHI=+$$INSUR^IBBAPI(ECXDFN,ECXDATE)
- S ECXEST=ECXPAT("EC STAT")
- S ECXCLST=ECXPAT("CL STAT") ;144 Camp Lejeune Status
- S ECXSVCI=ECXPAT("COMBSVCI") ;149 COMBAT SVC IND
- S ECXSVCL=ECXPAT("COMBSVCL") ;149 COMBAT SVC LOC
- S ECXSIGI=ECXPAT("SIGI") ;184 - SELF IDENTIFED GENDER
- ;
- ;-OEF/OIF Data
- S ECXOEF=ECXPAT("ECXOEF")
- S ECXOEFDT=ECXPAT("ECXOEFDT")
- ;
- ;- Agent Orange location
- S ECXAOL=ECXPAT("AOL")
- ;
- ; - Head and Neck Cancer Indicator
- S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
- ; - PROJ 112/SHAD Indicator
- S ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
- ; ******* - PATCH 127, ADD PATCAT CODE - ********
- S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
- ; - Race and Ethnicity
- S ECXETH=ECXPAT("ETHNIC")
- S ECXRC1=ECXPAT("RACE1")
- ;
- ;get primary care data
- S X=$$PRIMARY^ECXUTL2(ECXDFN,ECXDATE)
- S ECPTTM=$P(X,U),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4)
- S ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7)
- ;get combat veteran data
- I $$CVEDT^ECXUTL5(ECXDFN,ECD)
- ;get national patient record flag if exist
- D NPRF^ECXUTL5 S:ECXLOGIC>2019 ECXNPRFI="" ; 174 - TJL - Field retired
- ;get emergency response indicator (FEMA)
- S ECXERI=ECXPAT("ERI")
- Q
- ;
- PTF ; get admitting DRG, diagnosis, source of admission from PTF
- ;use number for DRG and .01 for diagnosis
- N EC,EC1,ECX
- S EC=1 I $D(^DGPT(ECPTF,"M",2,0)) S EC=2
- S EC1=+$P(^DGPT(ECPTF,"M",EC,0),U,5)
- S ECDRG=$P($G(^DGPT(ECPTF,"M",EC,"P")),U) S:ECXLOGIC>2019 ECDRG="" ;174 - TJL - Field retired
- S ECXICD10P=$S('EC1:"",1:$$CODEC^ICDEX(80,EC1)) ;154,161
- S ECX=+$P($G(^DGPT(ECPTF,101)),U),ECXSADM=$P($G(^DIC(45.1,ECX,0)),U,11)
- S ECXADMS=$$GET1^DIQ(45.1,ECX,.01)
- ;if source of admission = admit outpatient treatment ('1P')
- S ECXAOT=$S(($$GET1^DIQ(45.1,ECX,.01)="1P"):"Y",1:"")
- Q
- ;
- FILE ;file the extract record
- ;node0
- ;facility^dfn^ssn^name^in/out^day^Placehold primary care team^sex^dob^
- ;PLACEHOLD religion^employment status^health ins^state^county^zip^
- ;eligibility^vet^vietnam^agent orange^radiation^pow^
- ;period of service^means test^marital status^
- ;ward^treating specialty^attending physician^mov #^PLACEHOLD DRG^Placeholder^
- ;time^Placehold primary care provider^Placehold Race^primary ward provider
- ;node1
- ;mpi^placeholder^attending npi^pc provider npi^ward provider npi^
- ;admission elig^mst status^shad status^PLACEHOLD sharing payor^
- ;PLACEHOLD sharing insurance^enrollment location^
- ;Placehold pc prov person class^Placehold assoc pc provider^Placehold assoc pc prov person class^
- ;assoc pc prov npi^dom^enrollment cat^enrollment stat^encounter
- ;shad^purple heart ind.^obs pat ind^encounter num^agent orange
- ;loc^production div^pow loc^source of admission^head & neck canc. ind
- ;^Placehold ethnicity^Placehold race1^enrollment priority_sub group^user enrollee^patient
- ;type^combat vet elig^combat vet elig end date^enc cv eligible^
- ;PLACEHOLD national patient record flag ECXNPRFI^att phy person class ECXATTPC
- ;^primary ward provider person class ECXPRVPC^environ contamin ECXEST
- ;^emergency response indicator(FEMA) ECXERI^agent orange indic ECXAO
- ;^environ contam ECXECE^encoun head/neck ECXHNC^encoun MST ECXMIL^rad
- ;encoun ECXIR^
- ;node 2 - patch 136 separated node1 from node 2 for clarity
- ;OEF/OIF ECXOEF^ OEF/OIF return date ECXOEFDT
- ;^Placehold associate pc provider npi ECASNPI^attending physician npi ECATNPI^
- ;Placehold primary care provider npi ECPTNPI^primary ward provider npi ECPWNPI^
- ;admit outpatient treatment ECXAOT^country ECXCNTRY^pat cat ECXPATCAT^
- ;admit source ECXADMS ^emergency dept disposition ECXEDIS^Primary ICD-10 code ECXICD10P^Camp Lejeune Status ECXCLST^Encounter Camp Lejeune ECXECL^Encounter SC ECXESC
- ;Combat Service Indicator (ECXSVCI) ^ Combat Service Location (ECXSVCL) ^ Patient Division (ECXSTANO)
- ;Convert specialty to PTF Code
- ;node3 - patch 184 added ECXCRN for CERNER data
- ;Cerner data (ECXCERN)
- ;node 4
- ;New MPI (ECXNMPI)^SELF IDNETIFIED GENDER (ECXSIGI)
- ;
- S ECXDATA=$$TSDATA^DGACT(42.4,+ECXSPC,.ECXDATA)
- S ECXSPC=$G(ECXDATA(7))
- ;
- N DA,DIK
- S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
- I ECXLOGIC>2018 S (ECXRACE,ECXETH,ECXRC1,ECPTTM,ECPTPR,ECCLAS,ECASPR,ECCLAS2,ECASNPI,ECPTNPI)="" ;170 Fields will now be null
- I ECXLOGIC>2020 S ECXMNS="" ;178 Means Test field will now be null
- I ECXLOGIC>2022 S ECXNMPI=ECXMPI,ECXMPI="" ;184 - field retired
- S ECODE=EC7_U_EC23_U_ECXFAC_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U_ECXDATE_U
- S ECODE=ECODE_ECPTTM_U_ECXSEX_U_ECXDOB_U_ECXRELG_U
- S ECODE=ECODE_ECXEMP_U_ECXHI_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U
- S ECODE=ECODE_ECXELIG_U_ECXVET_U_ECXVNS_U_ECXAST_U_ECXRST_U_ECXPST_U
- S ECODE=ECODE_ECXPOS_U_ECXMNS_U_ECXMAR_U
- S ECODE=ECODE_ECXWRD_U_ECXSPC_U_ECXATT_U_ECDA_U_ECDRG_U_ECDIA_U
- S ECODE=ECODE_ECTM_U_ECPTPR_U_ECXRACE_U_ECXPRV_U
- S ECODE1=ECXMPI_U_ECXDSSD_U_""_U_""_U_""_U_ELGA_U
- S ECODE1=ECODE1_ECXMST_U_$S(ECXLOGIC<2005:ECXPRIOR,ECXLOGIC>2010:ECXSHADI,1:"")_U_U_U_ECXENRL_U_ECCLAS_U
- S ECODE1=ECODE1_ECASPR_U_ECCLAS2_U_U_ECXDOM_U_ECXCAT_U
- S ECODE1=ECODE1_ECXSTAT_U_$S(ECXLOGIC>2010:ECXSHAD,1:"")_U_ECXPHI_U_ECXOBS_U_ECXENC_U_ECXAOL_U
- S ECODE1=ECODE1_ECXPDIV_U_ECXPLOC_U_ECXSADM_U_ECXHNCI_U_ECXETH_U
- S ECODE1=ECODE1_ECXRC1
- I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
- I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXATTPC_U_ECXPRVPC_U_ECXEST
- I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U
- I ECXLOGIC>2007 S ECODE2=ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECATTNPI_U_ECPTNPI_U_ECPWNPI
- I ECXLOGIC>2009 S ECODE2=ECODE2_U_ECXAOT_U_ECXCNTRY
- ; ***** ADDING PATCAT TO 9TH PIECE OF ECODE *******
- I ECXLOGIC>2010 S ECODE2=ECODE2_U_ECXPATCAT
- I ECXLOGIC>2011 S ECODE2=ECODE2_U_ECXADMS
- I ECXLOGIC>2012 S ECODE2=ECODE2_U_ECXEDIS_U_ECXICD10P ;136
- I ECXLOGIC>2013 S ECODE2=ECODE2_U_ECXCLST_U_ECXECL_U_ECXESC ;144 Add Camp Lejeune status, encounter Camp Lejeune and encounter service connected
- I ECXLOGIC>2014 S ECODE2=ECODE2_U_ECXSVCI_U_ECXSVCL ;149
- I ECXLOGIC>2017 S ECODE2=ECODE2_U_ECXSTANO_U ;166 - tjl Added Patient Division,184 added "^"
- I ECXLOGIC>2022 S ECODE3=$G(ECXCERN)_U,ECODE4=ECXNMPI_U_ECXSIGI ;184 Added CERNER, New MPI and Self Identified Gender
- S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2)
- S ^ECX(ECFILE,EC7,3)=$G(ECODE3),^ECX(ECFILE,EC7,4)=$G(ECODE4) ;184
- S ECRN=ECRN+1
- S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
- Q
- ;
- SETUP ;Set required input for ECXTRAC.
- S ECHEAD="ADM"
- D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
- Q
- ;
- LOCAL ; to extract nightly for local use not to be transmitted to TSI
- ; should be queued with a 1D frequency
- D SETUP,^ECXTLOCL,^ECXKILL Q
- ;
- QUE ; entry point for the background requeuing handled by ECXTAUTO
- D SETUP,QUE^ECXTAUTO,^ECXKILL Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXADM 11771 printed Feb 18, 2025@23:18:18 Page 2
- ECXADM ;ALB/JAP,BIR/DMA,CML,PTD-Admissions Extract ;2/14/20 08:46
- +1 ;;3.0;DSS EXTRACTS;**1,4,11,8,13,24,33,39,46,71,84,92,107,105,120,127,132,136,144,149,154,161,166,170,174,178,184**;Dec 22, 1997;Build 124
- BEG ;entry point from option
- +1 DO SETUP
- IF ECFILE=""
- QUIT
- +2 DO ^ECXTRAC
- DO ^ECXKILL
- +3 QUIT
- +4 ;
- START ; start package specific extract
- +1 ;136 Clear temporary space for index
- KILL ^TMP($JOB,"EDIS")
- +2 ;136 build temp xref for emergency dept
- DO BLDXREF^ECXUTL1(ECSD,ECED)
- +3 SET QFLG=0
- +4 SET ECED=ECED+.3
- SET ECD=ECSD1
- +5 FOR
- SET ECD=$ORDER(^DGPM("ATT1",ECD))
- SET ECDA=0
- if ('ECD)!(ECD>ECED)
- QUIT
- Begin DoDot:1
- +6 FOR
- SET ECDA=$ORDER(^DGPM("ATT1",ECD,ECDA))
- if ECDA=""
- QUIT
- Begin DoDot:2
- +7 IF $DATA(^DGPM(ECDA,0))
- Begin DoDot:3
- +8 SET EC=^DGPM(ECDA,0)
- SET ECXDFN=$PIECE(EC,U,3)
- DO GET
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 ;170 Added section to look at transfers and record an admission record if transfer to ASIH other facility happens
- +10 SET ECD=ECSD1
- +11 FOR
- SET ECD=$ORDER(^DGPM("ATT2",ECD))
- SET ECDA=0
- if ('ECD)!(ECD>ECED)
- QUIT
- Begin DoDot:1
- +12 FOR
- SET ECDA=$ORDER(^DGPM("ATT2",ECD,ECDA))
- if ECDA=""
- QUIT
- Begin DoDot:2
- +13 IF $DATA(^DGPM(ECDA,0))&($$ISASIH^ECXUTL6(ECDA,2))
- Begin DoDot:3
- +14 ;Already have ADM record
- IF '+$$NEEDADR^ECXUTL6("TRAN",ECDA,"ADM")
- QUIT
- +15 SET EC=^DGPM(ECDA,0)
- SET ECXDFN=$PIECE(EC,U,3)
- DO GET
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 ;136 delete temporary xref
- KILL ^TMP($JOB,"EDIS")
- +17 QUIT
- +18 ;
- GET ;gather extract data
- +1 ;136
- NEW ADM,W,X,ECXNPRFI,ECXATTPC,ECXPRVPC,ECXEST,ECXAOT,ECXEDIS,ECXICD10P
- +2 ;144 Encounter Service Connected, Encounter Camp Lejeune, Camp Lejeune Status
- NEW ECXESC,ECXECL,ECXCLST
- +3 ;166 Patient Division
- NEW ECXSTANO
- +4 ;170 Is patient ASIH other facility
- NEW ECXASIH
- +5 ;184 - New fields
- NEW ECXNMPI,ECXCERN,ECXSIG
- +6 ;patient demographics
- +7 SET ECXERR=0
- DO PAT(ECXDFN,ECD,.ECXERR)
- +8 if ECXERR
- QUIT
- +9 IF $$ENROLLM^ECXUTL2(ECXDFN)
- +10 SET ECXFAC=$PIECE($GET(^DIC(42,+$PIECE(EC,U,6),0)),U,11)
- +11 ;Get production division
- SET ECXPDIV=$$GETDIV^ECXDEPT(ECXFAC)
- +12 ;Set Patient Division to Prod Div Code. tjl - 166
- SET ECXSTANO=ECXPDIV
- +13 ;admission data
- +14 SET ELGA=$PIECE($GET(^DIC(8,+$PIECE(EC,U,20),0)),U,9)
- +15 IF ELGA
- SET ELGA=$$ELIG^ECXUTL3(ELGA,ECXSVC)
- +16 ;154
- SET (ECDRG,ECDIA,ECXSADM,ECXADMS,ECXAOT,ECXICD10P)=""
- SET ECPTF=+$PIECE(EC,U,16)
- IF ECPTF
- IF $DATA(^DGPT(ECPTF,"M"))
- DO PTF
- +17 ;get encounter classification
- +18 ;144
- SET (ECXAO,ECXECE,ECXIR,ECXMIL,ECXHNC,ECXSHAD,ECXESC,ECXECL)=""
- SET ECXVISIT=$PIECE(EC,U,27)
- +19 IF ECXVISIT'=""
- Begin DoDot:1
- +20 DO VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR)
- IF ECXERR
- KILL ECXERR
- QUIT
- +21 SET ECXAO=$GET(ECXVIST("AO"))
- SET ECXIR=$GET(ECXVIST("IR"))
- +22 SET ECXMIL=$GET(ECXVIST("MST"))
- SET ECXHNC=$GET(ECXVIST("HNC"))
- +23 SET ECXECE=$GET(ECXVIST("PGE"))
- SET ECXSHAD=$GET(ECXVIST("SHAD"))
- +24 ;144 Encounter SC and Encounter Camp Lejeune
- SET ECXESC=$GET(ECXVIST("ENCSC"))
- SET ECXECL=$GET(ECXVIST("ENCCL"))
- End DoDot:1
- +25 ;use movement record date & time
- +26 SET ADM=$$INP^ECXUTL2(ECXDFN,ECD)
- +27 SET ECXA=$PIECE(ADM,U)
- SET ECXMN=$PIECE(ADM,U,2)
- SET ECXSPC=$PIECE(ADM,U,3)
- +28 SET (ECXADMDT,ECXDATE)=$PIECE(ADM,U,4)
- +29 ;if movement# doesn't match cross-ref ien, then quit
- +30 if ECXMN'=ECDA
- QUIT
- +31 SET ECTM=$$ECXTIME^ECXUTL(ECXDATE)
- +32 SET ECXDATE=$$ECXDATE^ECXUTL(ECXDATE,ECXYM)
- +33 SET W=$PIECE(ADM,U,9)
- +34 ;ECA_U_ECMN_U_ECTS_U_ECADM_U_ECWARD_U_ECDC_U_ECXPWP_U_ECXATP_U_ECXWW_U_ECXDOM_U_ECXPWPPC_U_ECXATPPC_U_ECXDWARD_U_ECXASIH
- +35 SET ECXWRD=$PIECE(W,";",1)
- SET ECXFAC=$PIECE(W,";",2)
- SET ECXDSSD=$PIECE(W,";",3)
- +36 SET ECXPRV=$PIECE(ADM,U,7)
- SET ECXPRNPI=""
- SET ECXATT=$PIECE(ADM,U,8)
- SET ECXATNPI=""
- +37 SET ECXDOM=$PIECE(ADM,U,10)
- SET ECXATTPC=$PIECE(ADM,U,12)
- SET ECXPRVPC=$PIECE(ADM,U,11)
- +38 ;ASIH other facility status
- SET ECXASIH=+$PIECE(ADM,U,14)
- +39 NEW ECXUSRTN
- +40 SET ECXUSRTN=$$NPI^XUSNPI("Individual_ID",$EXTRACT(ECXATT,2,$LENGTH(ECXATT)),ECD)
- +41 if +ECXUSRTN'>0
- SET ECXUSRTN=""
- +42 SET ECATTNPI=$PIECE(ECXUSRTN,U)
- +43 SET ECXUSRTN=$$NPI^XUSNPI("Individual_ID",$EXTRACT(ECXPRV,2,$LENGTH(ECXPRV)),ECD)
- +44 if +ECXUSRTN'>0
- SET ECXUSRTN=""
- +45 SET ECPWNPI=$PIECE(ECXUSRTN,U)
- +46 ;
- +47 ;- Observation patient indicator (YES/NO)
- +48 SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXSPC)
- +49 ;
- +50 ;- Patient Type
- +51 SET ECXPTYPE=$$TYPE^ECXUTL5(ECXDFN)
- +52 ;
- +53 ;136 Get emergency room disposition
- SET ECXEDIS=$$EDIS^ECXUTL1(ECXDFN,ECD,"A")
- +54 ;- If null encounter number, don't file record
- +55 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,,ECXSPC,ECXOBS,ECHEAD,,)
- +56 ;170 If patient is ASIH set in/out indicator to A
- IF $GET(ECXASIH)
- SET ECXA="A"
- +57 if ECXENC'=""
- DO FILE
- +58 QUIT
- +59 ;
- PAT(ECXDFN,ECXDATE,ECXERR) ;get patient demographic data
- +1 NEW OK,X
- +2 KILL ECXPAT
- +3 SET ECXDATE=$PIECE(ECXDATE,".")
- +4 SET OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;2;3;4;5",.ECXPAT)
- +5 IF 'OK
- SET ECXERR=1
- KILL ECXPAT
- QUIT
- +6 SET ECXSSN=ECXPAT("SSN")
- +7 SET ECXPNM=ECXPAT("NAME")
- +8 SET ECXMPI=ECXPAT("MPI")
- +9 SET ECXSEX=ECXPAT("SEX")
- +10 SET ECXDOB=ECXPAT("DOB")
- +11 SET ECXELIG=ECXPAT("ELIG")
- +12 SET ECXVET=ECXPAT("VET")
- +13 SET ECXVNS=ECXPAT("VIETNAM")
- +14 SET ECXPOS=ECXPAT("POS")
- +15 SET ECXMNS=ECXPAT("MEANS")
- +16 SET ECXRACE=ECXPAT("RACE")
- +17 ;174 - TJL - Field retired
- SET ECXRELG=ECXPAT("RELIGION")
- if ECXLOGIC>2019
- SET ECXRELG=""
- +18 SET ECXEMP=ECXPAT("EMPLOY")
- +19 SET ECXMAR=ECXPAT("MARITAL")
- +20 SET ECXPST=ECXPAT("POW STAT")
- +21 SET ECXPLOC=ECXPAT("POW LOC")
- +22 SET ECXRST=ECXPAT("IR STAT")
- +23 SET ECXAST=ECXPAT("AO STAT")
- +24 SET ECXMST=ECXPAT("MST STAT")
- +25 SET ECXSTATE=ECXPAT("STATE")
- +26 SET ECXCNTY=ECXPAT("COUNTY")
- +27 SET ECXZIP=ECXPAT("ZIP")
- +28 SET ECXCNTRY=ECXPAT("COUNTRY")
- +29 SET ECXENRL=ECXPAT("ENROLL LOC")
- +30 SET ECXSVC=ECXPAT("SC%")
- +31 SET ECXPHI=ECXPAT("PHI")
- +32 SET ECXHI=+$$INSUR^IBBAPI(ECXDFN,ECXDATE)
- +33 SET ECXEST=ECXPAT("EC STAT")
- +34 ;144 Camp Lejeune Status
- SET ECXCLST=ECXPAT("CL STAT")
- +35 ;149 COMBAT SVC IND
- SET ECXSVCI=ECXPAT("COMBSVCI")
- +36 ;149 COMBAT SVC LOC
- SET ECXSVCL=ECXPAT("COMBSVCL")
- +37 ;184 - SELF IDENTIFED GENDER
- SET ECXSIGI=ECXPAT("SIGI")
- +38 ;
- +39 ;-OEF/OIF Data
- +40 SET ECXOEF=ECXPAT("ECXOEF")
- +41 SET ECXOEFDT=ECXPAT("ECXOEFDT")
- +42 ;
- +43 ;- Agent Orange location
- +44 SET ECXAOL=ECXPAT("AOL")
- +45 ;
- +46 ; - Head and Neck Cancer Indicator
- +47 SET ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
- +48 ; - PROJ 112/SHAD Indicator
- +49 SET ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
- +50 ; ******* - PATCH 127, ADD PATCAT CODE - ********
- +51 SET ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
- +52 ; - Race and Ethnicity
- +53 SET ECXETH=ECXPAT("ETHNIC")
- +54 SET ECXRC1=ECXPAT("RACE1")
- +55 ;
- +56 ;get primary care data
- +57 SET X=$$PRIMARY^ECXUTL2(ECXDFN,ECXDATE)
- +58 SET ECPTTM=$PIECE(X,U)
- SET ECPTPR=$PIECE(X,U,2)
- SET ECCLAS=$PIECE(X,U,3)
- SET ECPTNPI=$PIECE(X,U,4)
- +59 SET ECASPR=$PIECE(X,U,5)
- SET ECCLAS2=$PIECE(X,U,6)
- SET ECASNPI=$PIECE(X,U,7)
- +60 ;get combat veteran data
- +61 IF $$CVEDT^ECXUTL5(ECXDFN,ECD)
- +62 ;get national patient record flag if exist
- +63 ; 174 - TJL - Field retired
- DO NPRF^ECXUTL5
- if ECXLOGIC>2019
- SET ECXNPRFI=""
- +64 ;get emergency response indicator (FEMA)
- +65 SET ECXERI=ECXPAT("ERI")
- +66 QUIT
- +67 ;
- PTF ; get admitting DRG, diagnosis, source of admission from PTF
- +1 ;use number for DRG and .01 for diagnosis
- +2 NEW EC,EC1,ECX
- +3 SET EC=1
- IF $DATA(^DGPT(ECPTF,"M",2,0))
- SET EC=2
- +4 SET EC1=+$PIECE(^DGPT(ECPTF,"M",EC,0),U,5)
- +5 ;174 - TJL - Field retired
- SET ECDRG=$PIECE($GET(^DGPT(ECPTF,"M",EC,"P")),U)
- if ECXLOGIC>2019
- SET ECDRG=""
- +6 ;154,161
- SET ECXICD10P=$SELECT('EC1:"",1:$$CODEC^ICDEX(80,EC1))
- +7 SET ECX=+$PIECE($GET(^DGPT(ECPTF,101)),U)
- SET ECXSADM=$PIECE($GET(^DIC(45.1,ECX,0)),U,11)
- +8 SET ECXADMS=$$GET1^DIQ(45.1,ECX,.01)
- +9 ;if source of admission = admit outpatient treatment ('1P')
- +10 SET ECXAOT=$SELECT(($$GET1^DIQ(45.1,ECX,.01)="1P"):"Y",1:"")
- +11 QUIT
- +12 ;
- FILE ;file the extract record
- +1 ;node0
- +2 ;facility^dfn^ssn^name^in/out^day^Placehold primary care team^sex^dob^
- +3 ;PLACEHOLD religion^employment status^health ins^state^county^zip^
- +4 ;eligibility^vet^vietnam^agent orange^radiation^pow^
- +5 ;period of service^means test^marital status^
- +6 ;ward^treating specialty^attending physician^mov #^PLACEHOLD DRG^Placeholder^
- +7 ;time^Placehold primary care provider^Placehold Race^primary ward provider
- +8 ;node1
- +9 ;mpi^placeholder^attending npi^pc provider npi^ward provider npi^
- +10 ;admission elig^mst status^shad status^PLACEHOLD sharing payor^
- +11 ;PLACEHOLD sharing insurance^enrollment location^
- +12 ;Placehold pc prov person class^Placehold assoc pc provider^Placehold assoc pc prov person class^
- +13 ;assoc pc prov npi^dom^enrollment cat^enrollment stat^encounter
- +14 ;shad^purple heart ind.^obs pat ind^encounter num^agent orange
- +15 ;loc^production div^pow loc^source of admission^head & neck canc. ind
- +16 ;^Placehold ethnicity^Placehold race1^enrollment priority_sub group^user enrollee^patient
- +17 ;type^combat vet elig^combat vet elig end date^enc cv eligible^
- +18 ;PLACEHOLD national patient record flag ECXNPRFI^att phy person class ECXATTPC
- +19 ;^primary ward provider person class ECXPRVPC^environ contamin ECXEST
- +20 ;^emergency response indicator(FEMA) ECXERI^agent orange indic ECXAO
- +21 ;^environ contam ECXECE^encoun head/neck ECXHNC^encoun MST ECXMIL^rad
- +22 ;encoun ECXIR^
- +23 ;node 2 - patch 136 separated node1 from node 2 for clarity
- +24 ;OEF/OIF ECXOEF^ OEF/OIF return date ECXOEFDT
- +25 ;^Placehold associate pc provider npi ECASNPI^attending physician npi ECATNPI^
- +26 ;Placehold primary care provider npi ECPTNPI^primary ward provider npi ECPWNPI^
- +27 ;admit outpatient treatment ECXAOT^country ECXCNTRY^pat cat ECXPATCAT^
- +28 ;admit source ECXADMS ^emergency dept disposition ECXEDIS^Primary ICD-10 code ECXICD10P^Camp Lejeune Status ECXCLST^Encounter Camp Lejeune ECXECL^Encounter SC ECXESC
- +29 ;Combat Service Indicator (ECXSVCI) ^ Combat Service Location (ECXSVCL) ^ Patient Division (ECXSTANO)
- +30 ;Convert specialty to PTF Code
- +31 ;node3 - patch 184 added ECXCRN for CERNER data
- +32 ;Cerner data (ECXCERN)
- +33 ;node 4
- +34 ;New MPI (ECXNMPI)^SELF IDNETIFIED GENDER (ECXSIGI)
- +35 ;
- +36 SET ECXDATA=$$TSDATA^DGACT(42.4,+ECXSPC,.ECXDATA)
- +37 SET ECXSPC=$GET(ECXDATA(7))
- +38 ;
- +39 NEW DA,DIK
- +40 SET EC7=$ORDER(^ECX(ECFILE,999999999),-1)
- SET EC7=EC7+1
- +41 ;170 Fields will now be null
- IF ECXLOGIC>2018
- SET (ECXRACE,ECXETH,ECXRC1,ECPTTM,ECPTPR,ECCLAS,ECASPR,ECCLAS2,ECASNPI,ECPTNPI)=""
- +42 ;178 Means Test field will now be null
- IF ECXLOGIC>2020
- SET ECXMNS=""
- +43 ;184 - field retired
- IF ECXLOGIC>2022
- SET ECXNMPI=ECXMPI
- SET ECXMPI=""
- +44 SET ECODE=EC7_U_EC23_U_ECXFAC_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U_ECXDATE_U
- +45 SET ECODE=ECODE_ECPTTM_U_ECXSEX_U_ECXDOB_U_ECXRELG_U
- +46 SET ECODE=ECODE_ECXEMP_U_ECXHI_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U
- +47 SET ECODE=ECODE_ECXELIG_U_ECXVET_U_ECXVNS_U_ECXAST_U_ECXRST_U_ECXPST_U
- +48 SET ECODE=ECODE_ECXPOS_U_ECXMNS_U_ECXMAR_U
- +49 SET ECODE=ECODE_ECXWRD_U_ECXSPC_U_ECXATT_U_ECDA_U_ECDRG_U_ECDIA_U
- +50 SET ECODE=ECODE_ECTM_U_ECPTPR_U_ECXRACE_U_ECXPRV_U
- +51 SET ECODE1=ECXMPI_U_ECXDSSD_U_""_U_""_U_""_U_ELGA_U
- +52 SET ECODE1=ECODE1_ECXMST_U_$SELECT(ECXLOGIC<2005:ECXPRIOR,ECXLOGIC>2010:ECXSHADI,1:"")_U_U_U_ECXENRL_U_ECCLAS_U
- +53 SET ECODE1=ECODE1_ECASPR_U_ECCLAS2_U_U_ECXDOM_U_ECXCAT_U
- +54 SET ECODE1=ECODE1_ECXSTAT_U_$SELECT(ECXLOGIC>2010:ECXSHAD,1:"")_U_ECXPHI_U_ECXOBS_U_ECXENC_U_ECXAOL_U
- +55 SET ECODE1=ECODE1_ECXPDIV_U_ECXPLOC_U_ECXSADM_U_ECXHNCI_U_ECXETH_U
- +56 SET ECODE1=ECODE1_ECXRC1
- +57 IF ECXLOGIC>2004
- SET ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
- +58 IF ECXLOGIC>2005
- SET ECODE1=ECODE1_U_ECXATTPC_U_ECXPRVPC_U_ECXEST
- +59 IF ECXLOGIC>2006
- SET ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U
- +60 IF ECXLOGIC>2007
- SET ECODE2=ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECATTNPI_U_ECPTNPI_U_ECPWNPI
- +61 IF ECXLOGIC>2009
- SET ECODE2=ECODE2_U_ECXAOT_U_ECXCNTRY
- +62 ; ***** ADDING PATCAT TO 9TH PIECE OF ECODE *******
- +63 IF ECXLOGIC>2010
- SET ECODE2=ECODE2_U_ECXPATCAT
- +64 IF ECXLOGIC>2011
- SET ECODE2=ECODE2_U_ECXADMS
- +65 ;136
- IF ECXLOGIC>2012
- SET ECODE2=ECODE2_U_ECXEDIS_U_ECXICD10P
- +66 ;144 Add Camp Lejeune status, encounter Camp Lejeune and encounter service connected
- IF ECXLOGIC>2013
- SET ECODE2=ECODE2_U_ECXCLST_U_ECXECL_U_ECXESC
- +67 ;149
- IF ECXLOGIC>2014
- SET ECODE2=ECODE2_U_ECXSVCI_U_ECXSVCL
- +68 ;166 - tjl Added Patient Division,184 added "^"
- IF ECXLOGIC>2017
- SET ECODE2=ECODE2_U_ECXSTANO_U
- +69 ;184 Added CERNER, New MPI and Self Identified Gender
- IF ECXLOGIC>2022
- SET ECODE3=$GET(ECXCERN)_U
- SET ECODE4=ECXNMPI_U_ECXSIGI
- +70 SET ^ECX(ECFILE,EC7,0)=ECODE
- SET ^ECX(ECFILE,EC7,1)=ECODE1
- SET ^ECX(ECFILE,EC7,2)=$GET(ECODE2)
- +71 ;184
- SET ^ECX(ECFILE,EC7,3)=$GET(ECODE3)
- SET ^ECX(ECFILE,EC7,4)=$GET(ECODE4)
- +72 SET ECRN=ECRN+1
- +73 SET DA=EC7
- SET DIK="^ECX("_ECFILE_","
- DO IX1^DIK
- KILL DIK,DA
- +74 QUIT
- +75 ;
- SETUP ;Set required input for ECXTRAC.
- +1 SET ECHEAD="ADM"
- +2 DO ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
- +3 QUIT
- +4 ;
- LOCAL ; to extract nightly for local use not to be transmitted to TSI
- +1 ; should be queued with a 1D frequency
- +2 DO SETUP
- DO ^ECXTLOCL
- DO ^ECXKILL
- QUIT
- +3 ;
- QUE ; entry point for the background requeuing handled by ECXTAUTO
- +1 DO SETUP
- DO QUE^ECXTAUTO
- DO ^ECXKILL
- QUIT
- +2 ;