Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXADM

ECXADM.m

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