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 Apr 09, 2024@20:56:02 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 ;
