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