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

ECXNUT.m

Go to the documentation of this file.
  1. ECXNUT ;ALB/JRC Nutrition DSS Extract ; 10/31/08 1:57pm
  1. ;;3.0;DSS EXTRACTS;**92,107,105,112,120,127**;Dec 22, 1997;Build 36
  1. BEG ;entry point from option
  1. N EC23,EC7,ECED,ECFILE,ECGRP,ECHEAD,ECINST,ECPACK,ECPIECE,ECRN,ECRTN,ECSD1,ECVER,ECXYM
  1. D SETUP I ECFILE="" Q
  1. D ^ECXTRAC,^ECXKILL
  1. Q
  1. ;
  1. START ; start package specific extract
  1. ;Init variables
  1. N ECSD,ARRAY
  1. S ECED=ECED+.3,ECSD=ECSD1,ARRAY="^TMP($J,""FH"")"
  1. K @ARRAY
  1. ;
  1. ;Call n&fs api and store in ^TMP($J,"FH" global
  1. D DATA^FHDSSAPI(ECSD,ECED)
  1. ;
  1. ;Get n&fs records from ^TMP($J,"FH" global and file
  1. D GETMEALS^ECXNUT1
  1. ;
  1. ;kill ^tmp global
  1. K @ARRAY
  1. ;
  1. Q
  1. ;
  1. GET ;gather extract data
  1. ;Init variables
  1. N ECXORDPC,ECXSSN,ECXPNM,ECXSEX,ECXDOB,ECXMPI,ECXRC1,ECXETH,ECXVET,ECXENRL,ECXELIG,ECXMST,ECXPST,ECXPLOC,ECXPHI,ECXMNS,ECXSTATE,ECXCNTY,ECXZIP,ECXPOS,ECXAST,ECXAOL,ECXRST,ECXEST,ECXTM,ECXDATE,ECXMN,ECXSPC
  1. N ECXADMDT,ECXWRD,ECXFAC,ECXPRV,ECXPRNPI,ECXATT,ECXATNPI,ECXDOM,ECXATTPC,ECXPRVPC,ECXPDIV,ECXCBOC,ECPTPR,ECCLASS,ECPTTM,ECXOBS,ECXHNCI,ECXNPRFI,ECXERI,ECXENC,ECPAT,ECXERR,ADM,W,X,ECXCAT,ECXCVE,ECXPRIOR,ECXPTYPE,ECXSTAT,ECXUESTA,ECXA,ECORNPI
  1. N ECXOEF,ECXOEFDT,ECXCNTRY
  1. ;
  1. ;- Prefix ordering pro with a 2 and get person class
  1. S ECXORDPC=$$PRVCLASS^ECXUTL(+ECXORDPH,DATE)
  1. S ECORNPI=$$NPI^XUSNPI("Individual_ID",+ECXORDPH,DATE)
  1. S:+ECORNPI'>0 ECORNPI="" S ECORNPI=$P(ECORNPI,U)
  1. S ECXORDPH=$S(ECXORDPH:2_ECXORDPH,1:"")
  1. ;
  1. ;set patient file (#2) dfn and get patient demographics
  1. S ECXDFN=$P($G(^TMP($J,"FH","ZN",FHDFN)),U,3)
  1. S ECXERR=0 D PAT(ECXDFN)
  1. Q:ECXERR
  1. ;Set demographic variables
  1. S ECXSSN=ECPAT("SSN"),ECXPNM=ECPAT("NAME"),ECXSEX=ECPAT("SEX"),ECXDOB=ECPAT("DOB"),ECXMPI=ECPAT("MPI"),ECXRC1=ECPAT("RACE1"),ECXETH=ECPAT("ETHNIC"),ECXVET=ECPAT("VET"),ECXENRL=ECPAT("ENROLL LOC"),ECXELIG=ECPAT("ELIG")
  1. S ECXMST=ECPAT("MST STAT"),ECXPST=ECPAT("POW STAT"),ECXPLOC=ECPAT("POW LOC"),ECXPHI=ECPAT("PHI"),ECXMNS=ECPAT("MEANS"),ECXSTATE=ECPAT("STATE"),ECXCNTY=ECPAT("COUNTY"),ECXZIP=ECPAT("ZIP")
  1. S ECXCNTRY=ECPAT("COUNTRY")
  1. S ECXPOS=ECPAT("POS"),ECXAST=ECPAT("AO STAT"),ECXAOL=ECPAT("AOL"),ECXRST=ECPAT("IR STAT"),ECXEST=ECPAT("EC STAT")
  1. ;
  1. ;Get oef/oif data
  1. S ECXOEF=ECPAT("ECXOEF")
  1. S ECXOEFDT=ECPAT("ECXOEFDT")
  1. ;
  1. ;Get enrollment status
  1. I $$ENROLLM^ECXUTL2(ECXDFN)
  1. ;
  1. S ECXTM=$$ECXTIME^ECXUTL(DATE)
  1. S ECXDATE=$$ECXDATE^ECXUTL(+DATE,ECXYM)
  1. ;
  1. ;- Use movement record date & time
  1. S ADM=$$INP^ECXUTL2(ECXDFN,DATE),ECXA=$P(ADM,U)
  1. I $G(P)="INP",$G(ECXA)'="I" Q
  1. S ECXMN=$P(ADM,U,2),ECXSPC=$P(ADM,U,3),ECXADMDT=$P(ADM,U,4)
  1. S W=$P(ADM,U,9),ECXWRD=$P(W,";",1),ECXFAC=$P(W,";",2)
  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. ;
  1. S ECXPDIV=$$GETDIV^ECXDEPT(ECXFAC) ;Get production division
  1. S ECXCBOC=$$CBOC^ECXSCX2(+ECXFAC) ;Get cboc facility
  1. ;
  1. ;- Get primary care data
  1. S X=$$PRIMARY^ECXUTL2(ECXDFN,DATE)
  1. S ECPTPR=$P(X,U,2),ECCLASS=$P(X,U,3),ECPTTM=$P(X,U),ECPTNPI=$P(X,U,4)
  1. ;
  1. ;- Observation patient indicator (YES/NO)
  1. S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXSPC)
  1. ;
  1. ;- Get head and neck cancer indicator
  1. S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
  1. ;
  1. ;- Get shad indicator
  1. S ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
  1. ;
  1. ;- Get national patient record flag indicator
  1. N ECXNPRFI D NPRF^ECXUTL5
  1. ;
  1. ;- National response indicator
  1. S ECXERI=$$EMGRES^DGUTL(ECXDFN)
  1. ;
  1. ; ******* - PATCH 127, ADD PATCAT CODE ********
  1. S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
  1. ;
  1. ;- If null encounter number, don't file record
  1. S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,DATE,ECXSPC,ECXOBS,ECHEAD,,)
  1. D:ECXENC'="" FILE
  1. Q
  1. ;
  1. PAT(ECXDFN) ;get/set patient data
  1. ; INPUT - ECXDFN = patient ien (DFN)
  1. ; OUTPUT - ECPAT array:
  1. ; ECPAT("SSN")
  1. ; ECPAT("NAME")
  1. ; returns 0 or 1 in ECXERR - 0=successful
  1. ; 1=error condition
  1. N X,OK
  1. ;get data
  1. S ECXERR=0
  1. K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,"","1;2;3;5",.ECPAT)
  1. I 'OK S ECXERR=1
  1. Q ECXERR
  1. ;
  1. FILE ;file the n&fs extract record
  1. ;node
  1. ;facility^dfn^ssn^name^in/out^day^time^treating specialty^
  1. ;ordering provider^ordering provider person class^primary
  1. ;care provider^primary person class^primary care team^mpi^dob^sex^
  1. ;race 1^ethnicity^veteran^enrollment status^enrollment location^
  1. ;enrollment category^enrollment priority^eligibility^period of
  1. ;service^agent orange status^agent orange location^radiation status
  1. ;^environmental contaminants^mst status^head & neck cancer indicator
  1. ;pow status^pow location^purple heart indicator^means test^state code
  1. ;^county code^zip+4^observation patient indicator^rrtp,prrtp and
  1. ;saartp indicator^encounter number^patient division^food production
  1. ;division^delivery division^product feeder key^food production
  1. ;facility^delivery location type^delivery feeder location^quantity^
  1. ;cboc^status^user enrollee^patient type^cv status eligibility^
  1. ;national patient record flag^emergency response indicator^admission
  1. ;date^oef/oif ECXOEF^oef/oif return date ECXOEFDT^ordering provider
  1. ;npi ECORNPI^primary care provider npi ECPTNPI^country ECXCNTRY^
  1. ;shad indicator ECXSHADI
  1. ;patient category ECXPATCAT
  1. ;
  1. N DA,DIK,ECODE,ECODE1
  1. S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
  1. S ECODE=EC7_U_EC23_U_ECINST_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
  1. ;
  1. ;convert specialty to PTF Code
  1. ;
  1. N ECXDATA
  1. S ECXDATA=$$TSDATA^DGACT(42.4,+ECXSPC,.ECXDATA)
  1. S ECXSPC=$G(ECXDATA(7))
  1. ;
  1. S ECODE=ECODE_ECXDATE_U_ECXTM_U_ECXSPC_U_ECXORDPH_U_ECXORDPC_U
  1. S ECODE=ECODE_ECPTPR_U_ECCLASS_U_ECPTTM_U_ECXMPI_U_ECXDOB_U_ECXSEX_U
  1. S ECODE=ECODE_ECXRC1_U_ECXETH_U_ECXVET_U_ECXSTAT_U_ECXENRL_U_ECXCAT_U
  1. S ECODE=ECODE_ECXPRIOR_U_ECXELIG_U_ECXPOS_U_ECXAST_U_ECXAOL_U_ECXRST
  1. S ECODE=ECODE_U_ECXEST_U_ECXMST_U_ECXHNCI_U_ECXPST_U_ECXPLOC_U_ECXPHI
  1. S ECODE=ECODE_U_ECXMNS_U_ECXSTATE_U_ECXCNTY_U
  1. S ECODE1=ECXZIP_U_ECXOBS_U_ECXDOM_U_ECXENC_U_ECXPDIV_U_ECXFPD_U
  1. S ECODE1=ECODE1_ECXFDD_U_ECXKEY_U_ECXFPF_U_ECXDLT_U_ECXDFL_U_ECXQTY_U
  1. S ECODE1=ECODE1_ECXCBOC_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXNPRFI_U
  1. S ECODE1=ECODE1_ECXERI_U_$S(ECXADMDT:$$ECXDATE^ECXUTL(ECXADMDT,ECXYM),1:"")
  1. I ECXLOGIC>2007 S ECODE1=ECODE1_U_ECXOEF_U_ECXOEFDT_U_$G(ECXTFU)_U_ECORNPI_U_ECPTNPI
  1. I ECXLOGIC>2009 S ECODE1=ECODE1_U_ECXCNTRY
  1. I ECXLOGIC>2010 S ECODE1=ECODE1_U_ECXSHADI_U_ECXPATCAT
  1. S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1
  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="NUT"
  1. D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
  1. Q