Routine: ECXNUT1

ECXNUT1 ;ALB/JRC Nutrition DSS Extract ; 9/4/09 8:59am

 ;;3.0;DSS EXTRACTS;**92,107,105,112,119**;Dec 22, 1997;Build 19

GETMEALS ;get patient meals

 ; variable names:   ordate - regular diet order date

 ;                   sdate  - diet order npo/withhold date

 ;                   norder - "sf" or "so" order date

 ;                             note: there is a relationship

 ;                             between "sf", "so" and regular diets

 ;                   adate - admission date

 ;                   ddate - discharge date

 N I,J,P,D,ECXADM,FHDFN,ORDATE,DATES,NODE,SF,PRODUCT,ECXQTY,ORDER,ECXORDPH,ECXKEY,ECXFPD,ECXFDD,ECXFPF,ECXDLT,ECXDFL,MEAL,MEALS,SORDATE,NUMBER,TF,TFNODE,ECXTFU,SDATE,START,ECSDX

 ;set ecsd to first day of the month before setting meals array

 S ECSDX=ECSD,ECSD=ECSD+.1,ECXTFU=""

 ;setup individual meals array for inpatients

 F I=ECSD:1:ECED F J=I+.0800,I+.1300,I+.1800 S MEALS(J)=J

 ;get "inp", "sf", and "so" inpatient meals

 S ECXADM=0 F  S ECXADM=$O(@ARRAY@(ECXADM)) Q:'ECXADM  D

 .S FHDFN=0 F  S FHDFN=$O(@ARRAY@(ECXADM,FHDFN)) Q:'FHDFN  D

 ..S ORDATE=0,(ADATE,DDATE,SDATE)=""

 ..F  S ORDATE=$O(@ARRAY@(ECXADM,FHDFN,ORDATE)) Q:'ORDATE  Q:ORDATE>ECED  D

 ...Q:$P($G(^TMP($J,"FH",ECXADM,FHDFN,+ORDATE,"INP")),U,7)'=""

 ...S DATES=$$GETDATES(),SDATE=$S(ORDATE>ECSD:ORDATE,1:ECSD)

INPPD ...;create regular diet individual meals

 ...S P="INP",D="PD"

 ...;get new order date and time if exist

 ...S NORDER=$$NEWORDER(P,ORDATE)

 ...S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,ORDATE,"INP")) Q:'NODE

 ...S PRODUCT=$P(NODE,U,13),ECXQTY=1,ORDER=""_$P(NODE,U,14)_","_""

 ...;Resolve feeder key for nutrition product

 ...S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)

 ...I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 ...S MEAL=SDATE F  S MEAL=$O(MEALS(MEAL)) Q:'MEAL  D

 ....I NORDER]"" Q:MEAL>NORDER

 ....I $P(DATES,U,3) Q:MEAL>$P(DATES,U,3)

 ....S ECXORDPH=$$GET1^DIQ(100,+ORDER,1,"I")

 ....;Get additional data and file record.

 ....S DATE=MEAL

 ....I $P(DATES,U) D MEALCHK Q:MEALCHK=1

 ....D:DATE'>ECED GET^ECXNUT

INPSF ;create supplemental feeding meals if they exist

 S ECXADM=0 F  S ECXADM=$O(@ARRAY@(ECXADM)) Q:'ECXADM  D

 .S FHDFN=0 F  S FHDFN=$O(@ARRAY@(ECXADM,FHDFN)) Q:'FHDFN  D

 ..S ORDATE=0,(ADATE,DDATE,SDATE)=""

 ..F  S ORDATE=$O(@ARRAY@(ECXADM,FHDFN,ORDATE)) Q:'ORDATE  D

 ...S DATES=$$GETDATES(),SDATE=$S(ORDATE>ECSD:ORDATE,1:ECSD)

 ...;get "sf" orders if they exist

 ...N SFNODE S (SFNODE,ECXORDPH,CDATE)=""

 ...S SFNODE=$G(@ARRAY@(ECXADM,FHDFN,ORDATE,"SF"))

 ...I +SFNODE D

 ....S P="INP",D="SF"

 ....;get new order date and time if exist

 ....S NORDER=$$NEWORDER(D,ORDATE),CDATE=$P(SFNODE,U,32)

 ....S START=$P(SFNODE,U,2) I START<ECSD S START=ECSD

 ....;order thru all "sf" product fields and generate records

 ....F SF=5:2:27 S PRODUCT=$P(SFNODE,U,SF) S ECXQTY=$P(SFNODE,U,(SF+1)) D

 .....Q:PRODUCT']""

 .....;Resolve external value for product key

 .....S ECXKEY=$$NUTKEY^ECXUTL6("SF",PRODUCT)

 .....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 .....;create individual meals

 .....F MEAL=START:1:ECED D

 ......;Get additional data and file record.

 ......S DATE=$P(MEAL,".")_"."_$S("57911"[SF:10,"13151719"[SF:14,1:18)

 ......I DATE<ORDATE Q

 ......I CDATE]"" Q:DATE>CDATE

 ......I NORDER]"" Q:DATE>NORDER

 ......I $P(DATES,U,3)]"" Q:DATE>$P(DATES,U,3)

 ......I $P(DATES,U) D MEALCHK Q:MEALCHK=1

 ......D:DATE'>ECED GET^ECXNUT

INPSO ;create standing order meals if they exist

 S ECSDX=$P(ECSD,".")

 K MEALS F I=ECSDX:1:ECED F J=I+.0800,I+.1300,I+.1800 S MEALS(J)=J

 S ECXADM=0 F  S ECXADM=$O(@ARRAY@(ECXADM)) Q:'ECXADM  D

 .S FHDFN=0 F  S FHDFN=$O(@ARRAY@(ECXADM,FHDFN)) Q:'FHDFN  D

 ..S ORDATE=0,(ADATE,DDATE,SDATE)=""

 ..F  S ORDATE=$O(@ARRAY@(ECXADM,FHDFN,ORDATE)) Q:'ORDATE  D

 ...S DATES=$$GETDATES(),SDATE=$S(ORDATE>ECSD:ORDATE,1:ECSD)

 ...N SONODE,NUM S (SONODE,ECXORDPH)="",NUM=0

 ...F  S NUM=$O(@ARRAY@(ECXADM,FHDFN,ORDATE,"SO",NUM)) Q:'NUM  D

 ....S SONODE=$G(@ARRAY@(ECXADM,FHDFN,ORDATE,"SO",NUM))

 ....I +SONODE D

 .....;create standing order meals

 .....N SMEAL S P="INP",D="SO"

 .....;get new order date and time if exist

 .....S PRODUCT=$P(SONODE,U,2),ECXQTY=$P(SONODE,U,8),SMEAL=$P(SONODE,U,3),CDATE=$P(SONODE,U,6)

 .....;Resolve feeder key for nutrition product

 .....S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)

 .....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 .....;create individual meals

 .....S MEAL=SDATE F  S MEAL=$O(MEALS(MEAL)) Q:'MEAL  D

 ......N TIME S TIME=$P(MEALS(MEAL),".",2)

 ......Q:SMEAL'["B"&(TIME="08")

 ......Q:SMEAL'["N"&(TIME=13)

 ......Q:SMEAL'["E"&(TIME=18)

 ......I CDATE]"" Q:MEAL>CDATE

 ......I $P(DATES,U,3) Q:MEAL>$P(DATES,U,3)

 ......;Get additional data and file record.

 ......N ZDATE S ZDATE=DATE

 ......S DATE=MEAL

 ......I $P(DATES,U) D MEALCHK Q:MEALCHK=1

 ......D GET^ECXNUT

 ......S DATE=ZDATE

 ;remove individual meals array

 K MEALS

INPTF ;Get inpatient tube feedings

 N P1,PNODE,CDATE,ECXTFU,MEALS

 ;set daily meals array for inpatient tube feedings

 S ECSD=ECSD1

 F I=ECSD:1:ECED+1 S MEALS(I)=""

 S (FHDFN,DATE,P1,CDATE,SDATE)=0,(ECXADM,NODE,ECXORDPH,PNODE)=""

 S P="INP",D="TF" F  S ECXADM=$O(^TMP($J,"FH",ECXADM)) Q:'ECXADM  D

 .F  S FHDFN=$O(^TMP($J,"FH",ECXADM,FHDFN))  Q:'FHDFN  D

 ..F  S DATE=$O(^TMP($J,"FH",ECXADM,FHDFN,DATE)) Q:'DATE  D

 ...S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,DATE,"TF")) Q:'NODE  D

 ....F  S P1=$O(^TMP($J,"FH",ECXADM,FHDFN,DATE,"TF",P1)) Q:'P1  D

 .....S PNODE=^TMP($J,"FH",ECXADM,FHDFN,DATE,"TF",P1,"P")

 .....S ORDATE=DATE,DATES=$$GETDATES(),CDATE=$P(NODE,U,11)

 .....S SDATE=$S(ORDATE>ECSD:ORDATE,1:ECSD)

 .....S PRODUCT=$P(PNODE,U,1),ORDER=""_$P(NODE,U,14)_","_""

 .....S ECXQTY=$S($P(PNODE,U,3)["GM":$P(PNODE,U,3),1:$P(PNODE,U,4))

 .....S ECXTFU=$S($P(PNODE,U,3)["GM":"GM",1:"ML")

 .....;Resolve external value for product key

 .....S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)

 .....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 .....;create daily meals

 .....S MEAL=SDATE F  S MEAL=$O(MEALS(MEAL)) Q:'MEAL  D

 ......I $P(DATES,U) Q:MEAL>$P(DATES,U)

 ......I CDATE]"" Q:$P(MEAL,".")>$P(CDATE,".")

 ......I $P(DATES,U,3) Q:$P(MEAL,".")>$P($P(DATES,U,3),".")

 ......S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I")

 ......;Get additional data and file record.

 ......S DATE=MEAL

 ......I $P(DATES,U) D MEALCHK Q:MEALCHK=1

 ......D GET^ECXNUT S DATE=ORDATE

OPRM ;Get outpatient recurring meals

 S DATE=0,(ECXADM,NODE,ECXORDPH,ECXTFU)=""

 S P="OP",D="RM" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D

 . S FHDFN=0 F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN))  Q:'FHDFN  D

 .. S NUMBER=0 F  S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER  D

 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM")) Q:'NODE

 ... S PRODUCT=$P(NODE,U,2),ECXQTY=1,ORDER=""_$P(NODE,U,12)_","_""

 ... S PRODUCT=$$GET1^DIQ(111,PRODUCT,4,"I")

 ... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I")

 ... ;Resolve external value for product key

 ... S ECXKEY=$$NUTKEY^ECXUTL6("PD",PRODUCT)

 ... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 ... ;Get additional data and file record.

 ... D GET^ECXNUT

OPSO ;Get outpatient standing orders

 S DATE=0,(ECXADM,NODE,ECXORDPH)=""

 S P="OP",D="SO" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D

 . S FHDFN=0 F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN))  Q:'FHDFN  D

 .. S NUMBER=0 F  S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER  D

 ... S FHNUM=0 F  S FHNUM=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMSO",FHNUM)) Q:FHNUM'>0  D

 ....N SMEAL S P="OP",D="SO"

 ....;get new order date and time if exist

 ....S SONODE=^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMSO",FHNUM)

 ....S NORDER=DATE,SMEAL=$P(SONODE,U,3)

 ....S PRODUCT=$P(SONODE,U,2),ECXQTY=$P(SONODE,U,8)

 ....;Resolve feeder key for nutrition product

 ....S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)

 ....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 ....;create individual meals

 ....S MEAL=NUMBER F  S MEAL=$O(MEALS(MEAL)) Q:'MEAL  D

 .....N TIME S TIME=$P(MEALS(MEAL),".",2)

 .....Q:SMEAL'["B"&(TIME="08")

 .....Q:SMEAL'["N"&(TIME=13)

 .....Q:SMEAL'["E"&(TIME=18)

 .....I $P(DATES,U) Q:MEAL>$P(DATES,U)

 .....I NORDER]"" Q:MEAL>NORDER

 .....I $P(DATES,U,3) Q:MEAL>$P(DATES,U,3)

 .....;Get additional data and file record.

 .....N ZDATE S ZDATE=DATE

 .....S DATE=MEAL D GET^ECXNUT

 .....S DATE=ZDATE

OPSF ;Get outpatient supplemental feedings

 S DATE=0,(ECXADM,NODE,ECXORDPH)=""

 S P="OP",D="SO" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D

 . S FHDFN=0 F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN))  Q:'FHDFN  D

 .. S NUMBER=0 F  S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER  D

 ... Q:'$D(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMSF"))  D

 ....N SMEAL S P="OP",D="SF"

 ....;get "sf" orders if they exist

 ....N SFNODE S (SFNODE,ECXORDPH,CDATE)=""

 ....S SFNODE=^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMSF")

 ....I +SFNODE D

 .....;get new order date and time if exist

 .....S NORDER=DATE,CDATE=$P(SFNODE,U,32)

 .....;order thru all "sf" product fields and generate records

 .....F SF=5:2:27 S PRODUCT=$P(SFNODE,U,SF) S ECXQTY=$P(SFNODE,U,(SF+1)) D

 ......Q:PRODUCT']""

 ......;Resolve external value for product key

 ......S ECXKEY=$$NUTKEY^ECXUTL6("SF",PRODUCT)

 ......I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 ......;create individual meals

 ......F MEAL=DATE

 ......I $P(DATES,U,3)]"" Q:MEAL>$P(DATES,U,3)

 ......;Get additional data and file record.

 ......N ZDATE S ZDATE=DATE

 ......S DATE=$P(MEAL,".")_"."_$S("57911"[SF:10,"13151719"[SF:14,1:18)

 ......D GET^ECXNUT

 ......S DATE=ZDATE

OPTF ;Get outpatient tube feedings

 S DATE=0,(ECXADM,NODE,ECXORDPH)=""

 S P="OP",D="TF" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D

 . S FHDFN=0 F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN))  Q:'FHDFN  D

 .. S NUMBER=0 F  S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER  D

 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF")) Q:NODE=""

 ... S TF=0 F  S TF=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)) Q:'TF  D

 .... S TFNODE=^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)

 .... S PRODUCT=$P(TFNODE,U,1),ECXQTY=$P(TFNODE,U,4)

 .... ;Resolve external value for product key

 .... S ECXKEY=$$NUTKEY^ECXUTL6("TF",PRODUCT)

 .... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 .... ;Get additional data and file record.

 .... D GET^ECXNUT

OPSM ;Get outpatient special meals

 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)=""

 S P="OP",D="SM" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D

 . F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN  D

 .. S NODE=$G(^TMP($J,"FH",DATE,FHDFN,"SM")) Q:'NODE

 .. S PRODUCT=$P(NODE,U,4),ECXQTY=1,ECXORDPH=$P(NODE,U,5)

 .. S PRODUCT=$$GET1^DIQ(111,PRODUCT,4,"I")

 .. ;Resolve external value for product key

 .. S ECXKEY="SPECGUEST"

 .. I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 .. ;Get additional data and file record.

 .. D GET^ECXNUT

OPGM ;Get outpatient guest meals

 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)=""

 S P="OP",D="GM" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D

 . F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN  D

 .. S NODE=$G(^TMP($J,"FH",DATE,FHDFN,"GM")) Q:'NODE

 .. S PRODUCT=$P(NODE,U,13),ECXQTY=1

 .. ;Resolve external value for product key

 .. S ECXKEY="SPECGUEST"

 .. I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 .. ;Get additional data and file record.

 .. D GET^ECXNUT

GETDATES() ;Get admit, discharge, npo/withhold dates,for "inp", "sf" and "so"

 ;  return in string i.e.  stop date^admission date^discharge date

 ;     input:    ecxadm  -  movement file ien

 ;               fhdfn   - nutrition patient file (#115)

 ;     output:   stop date  - npo/withhold date

 ;               admit date - admission date and time

 ;               discharge date - discharge date and time

 ;               expiration date of withhold date

 ;init variables

 N ADATE,DDATE,DATE,STDATE,NORDATE,IENS,RDATE

 ;check input

 Q:'$G(ECXADM)!'$G(FHDFN) "0^0^0^0"

 ;get admission and discharge dates

 S (ADATE,DDATE,DATE,SDATE,NORDATE,STDATE,RDATE)="",IENS=""_ECXADM_","_FHDFN_","_"",ADATE=$$GET1^DIQ(115.01,IENS,.01,"I"),DDATE=$$GET1^DIQ(115.01,IENS,18,"I")

 ;get "inp" order's npo/withhold date return it as 'stdate' if exist

 S DATE=ORDATE F  S DATE=$O(@ARRAY@(ECXADM,FHDFN,DATE)) Q:'DATE  D

 .I $P($G(@ARRAY@(ECXADM,FHDFN,+DATE,"INP")),U,7)'="" S STDATE=DATE,RDATE=$P($G(@ARRAY@(ECXADM,FHDFN,+DATE,"INP")),U,10)

 Q STDATE_U_ADATE_U_DDATE_U_RDATE

NEWORDER(TYPE,DATE) ;Look for new order for inpatient meal type if exist

 ;    Input     ecxadm -  movement #

 ;              fhdfn  -  nutrition file (#115) fhdfn

 ;              date   -  starting order date to begin lookup

 ;              type   -  meal type "sf", "so", or "pd"

 ;    Output:   new order date and time for specific meal type

 ;init variables

 N NUMT

 S NORDER="",NUMT=0

 Q:$G(TYPE)']""!'$G(DATE) NORDER

 I TYPE'="SO" F  S DATE=$O(@ARRAY@(ECXADM,FHDFN,DATE)) Q:'DATE  Q:NORDER  D

 .S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,DATE,TYPE)) Q:'+NODE

 .S NORDER=DATE

 I TYPE="SO" D

 .F  S DATE=$O(@ARRAY@(ECXADM,FHDFN,DATE)) Q:'DATE  Q:NORDER  D

 ..S NUMT=$O(^TMP($J,"FH",ECXADM,FHDFN,DATE,TYPE,NUMT)) Q:'NUMT

 ..S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,DATE,TYPE,NUMT)) Q:'+NODE

 ..S NORDER=DATE

 Q NORDER

MEALCHK ;CHECK IF MEAL IS ON HOLD

 S (H,OFF)="",MEALCHK=0

 I $P(DATES,U) S H=$P(DATES,U)

 I $P(DATES,U,4)]"" S OFF=$P(DATES,U,4)

 E  D

 .S OFF=$O(@ARRAY@(ECXADM,FHDFN,H))

 .I OFF']"" S OFF=ECED+1

 I ((DATE-.0000001)>H),(DATE-.0000001<OFF) S MEALCHK=1

 K H,OFF

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXNUT1   13660     printed  Feb 18, 2025@23:19:33                                                                                                                                                                                                    Page 2

ECXNUT1   ;ALB/JRC Nutrition DSS Extract ; 9/4/09 8:59am

 +1       ;;3.0;DSS EXTRACTS;**92,107,105,112,119**;Dec 22, 1997;Build 19

 +2        QUIT

GETMEALS  ;get patient meals

 +1       ; variable names:   ordate - regular diet order date

 +2       ;                   sdate  - diet order npo/withhold date

 +3       ;                   norder - "sf" or "so" order date

 +4       ;                             note: there is a relationship

 +5       ;                             between "sf", "so" and regular diets

 +6       ;                   adate - admission date

 +7       ;                   ddate - discharge date

 +8        NEW I,J,P,D,ECXADM,FHDFN,ORDATE,DATES,NODE,SF,PRODUCT,ECXQTY,ORDER,ECXORDPH,ECXKEY,ECXFPD,ECXFDD,ECXFPF,ECXDLT,ECXDFL,MEAL,MEALS,SORDATE,NUMBER,TF,TFNODE,ECXTFU,SDATE,START,ECSDX

 +9       ;set ecsd to first day of the month before setting meals array

 +10       SET ECSDX=ECSD

           SET ECSD=ECSD+.1

           SET ECXTFU=""

 +11      ;setup individual meals array for inpatients

 +12       FOR I=ECSD:1:ECED

               FOR J=I+.0800,I+.1300,I+.1800

                   SET MEALS(J)=J

 +13      ;get "inp", "sf", and "so" inpatient meals

 +14       SET ECXADM=0

FOR

               SET ECXADM=$ORDER(@ARRAY@(ECXADM))

               if 'ECXADM

                   QUIT

               Begin DoDot:1

 +15               SET FHDFN=0

FOR

                       SET FHDFN=$ORDER(@ARRAY@(ECXADM,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +16                       SET ORDATE=0

                           SET (ADATE,DDATE,SDATE)=""

 +17                       FOR

                               SET ORDATE=$ORDER(@ARRAY@(ECXADM,FHDFN,ORDATE))

                               if 'ORDATE

                                   QUIT

                               if ORDATE>ECED

                                   QUIT

                               Begin DoDot:3

 +18                               if $PIECE($GET(^TMP($JOB,"FH",ECXADM,FHDFN,+ORDATE,"INP")),U,7)'=""

                                       QUIT

 +19                               SET DATES=$$GETDATES()

                                   SET SDATE=$SELECT(ORDATE>ECSD:ORDATE,1:ECSD)

INPPD     ;create regular diet individual meals

 +1                                SET P="INP"

                                   SET D="PD"

 +2       ;get new order date and time if exist

 +3                                SET NORDER=$$NEWORDER(P,ORDATE)

 +4                                SET NODE=$GET(^TMP($JOB,"FH",ECXADM,FHDFN,ORDATE,"INP"))

                                   if 'NODE

                                       QUIT

 +5                                SET PRODUCT=$PIECE(NODE,U,13)

                                   SET ECXQTY=1

                                   SET ORDER=""_$PIECE(NODE,U,14)_","_""

 +6       ;Resolve feeder key for nutrition product

 +7                                SET ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)

 +8                                IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +9                                SET MEAL=SDATE

FOR

                                       SET MEAL=$ORDER(MEALS(MEAL))

                                       if 'MEAL

                                           QUIT

                                       Begin DoDot:4

 +10                                       IF NORDER]""

                                               if MEAL>NORDER

                                                   QUIT

 +11                                       IF $PIECE(DATES,U,3)

                                               if MEAL>$PIECE(DATES,U,3)

                                                   QUIT

 +12                                       SET ECXORDPH=$$GET1^DIQ(100,+ORDER,1,"I")

 +13      ;Get additional data and file record.

 +14                                       SET DATE=MEAL

 +15                                       IF $PIECE(DATES,U)

                                               DO MEALCHK

                                               if MEALCHK=1

                                                   QUIT

 +16                                       if DATE'>ECED

                                               DO GET^ECXNUT

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

INPSF     ;create supplemental feeding meals if they exist

 +1        SET ECXADM=0

FOR

               SET ECXADM=$ORDER(@ARRAY@(ECXADM))

               if 'ECXADM

                   QUIT

               Begin DoDot:1

 +2                SET FHDFN=0

FOR

                       SET FHDFN=$ORDER(@ARRAY@(ECXADM,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +3                        SET ORDATE=0

                           SET (ADATE,DDATE,SDATE)=""

 +4                        FOR

                               SET ORDATE=$ORDER(@ARRAY@(ECXADM,FHDFN,ORDATE))

                               if 'ORDATE

                                   QUIT

                               Begin DoDot:3

 +5                                SET DATES=$$GETDATES()

                                   SET SDATE=$SELECT(ORDATE>ECSD:ORDATE,1:ECSD)

 +6       ;get "sf" orders if they exist

 +7                                NEW SFNODE

                                   SET (SFNODE,ECXORDPH,CDATE)=""

 +8                                SET SFNODE=$GET(@ARRAY@(ECXADM,FHDFN,ORDATE,"SF"))

 +9                                IF +SFNODE

                                       Begin DoDot:4

 +10                                       SET P="INP"

                                           SET D="SF"

 +11      ;get new order date and time if exist

 +12                                       SET NORDER=$$NEWORDER(D,ORDATE)

                                           SET CDATE=$PIECE(SFNODE,U,32)

 +13                                       SET START=$PIECE(SFNODE,U,2)

                                           IF START<ECSD

                                               SET START=ECSD

 +14      ;order thru all "sf" product fields and generate records

 +15                                       FOR SF=5:2:27

                                               SET PRODUCT=$PIECE(SFNODE,U,SF)

                                               SET ECXQTY=$PIECE(SFNODE,U,(SF+1))

                                               Begin DoDot:5

 +16                                               if PRODUCT']""

                                                       QUIT

 +17      ;Resolve external value for product key

 +18                                               SET ECXKEY=$$NUTKEY^ECXUTL6("SF",PRODUCT)

 +19                                               IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +20      ;create individual meals

 +21                                               FOR MEAL=START:1:ECED

                                                       Begin DoDot:6

 +22      ;Get additional data and file record.

 +23                                                       SET DATE=$PIECE(MEAL,".")_"."_$SELECT("57911"[SF:10,"13151719"[SF:14,1:18)

 +24                                                       IF DATE<ORDATE

                                                               QUIT

 +25                                                       IF CDATE]""

                                                               if DATE>CDATE

                                                                   QUIT

 +26                                                       IF NORDER]""

                                                               if DATE>NORDER

                                                                   QUIT

 +27                                                       IF $PIECE(DATES,U,3)]""

                                                               if DATE>$PIECE(DATES,U,3)

                                                                   QUIT

 +28                                                       IF $PIECE(DATES,U)

                                                               DO MEALCHK

                                                               if MEALCHK=1

                                                                   QUIT

 +29                                                       if DATE'>ECED

                                                               DO GET^ECXNUT

                                                       End DoDot:6

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

INPSO     ;create standing order meals if they exist

 +1        SET ECSDX=$PIECE(ECSD,".")

 +2        KILL MEALS

           FOR I=ECSDX:1:ECED

               FOR J=I+.0800,I+.1300,I+.1800

                   SET MEALS(J)=J

 +3        SET ECXADM=0

FOR

               SET ECXADM=$ORDER(@ARRAY@(ECXADM))

               if 'ECXADM

                   QUIT

               Begin DoDot:1

 +4                SET FHDFN=0

FOR

                       SET FHDFN=$ORDER(@ARRAY@(ECXADM,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +5                        SET ORDATE=0

                           SET (ADATE,DDATE,SDATE)=""

 +6                        FOR

                               SET ORDATE=$ORDER(@ARRAY@(ECXADM,FHDFN,ORDATE))

                               if 'ORDATE

                                   QUIT

                               Begin DoDot:3

 +7                                SET DATES=$$GETDATES()

                                   SET SDATE=$SELECT(ORDATE>ECSD:ORDATE,1:ECSD)

 +8                                NEW SONODE,NUM

                                   SET (SONODE,ECXORDPH)=""

                                   SET NUM=0

 +9                                FOR

                                       SET NUM=$ORDER(@ARRAY@(ECXADM,FHDFN,ORDATE,"SO",NUM))

                                       if 'NUM

                                           QUIT

                                       Begin DoDot:4

 +10                                       SET SONODE=$GET(@ARRAY@(ECXADM,FHDFN,ORDATE,"SO",NUM))

 +11                                       IF +SONODE

                                               Begin DoDot:5

 +12      ;create standing order meals

 +13                                               NEW SMEAL

                                                   SET P="INP"

                                                   SET D="SO"

 +14      ;get new order date and time if exist

 +15                                               SET PRODUCT=$PIECE(SONODE,U,2)

                                                   SET ECXQTY=$PIECE(SONODE,U,8)

                                                   SET SMEAL=$PIECE(SONODE,U,3)

                                                   SET CDATE=$PIECE(SONODE,U,6)

 +16      ;Resolve feeder key for nutrition product

 +17                                               SET ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)

 +18                                               IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +19      ;create individual meals

 +20                                               SET MEAL=SDATE

FOR

                                                       SET MEAL=$ORDER(MEALS(MEAL))

                                                       if 'MEAL

                                                           QUIT

                                                       Begin DoDot:6

 +21                                                       NEW TIME

                                                           SET TIME=$PIECE(MEALS(MEAL),".",2)

 +22                                                       if SMEAL'["B"&(TIME="08")

                                                               QUIT

 +23                                                       if SMEAL'["N"&(TIME=13)

                                                               QUIT

 +24                                                       if SMEAL'["E"&(TIME=18)

                                                               QUIT

 +25                                                       IF CDATE]""

                                                               if MEAL>CDATE

                                                                   QUIT

 +26                                                       IF $PIECE(DATES,U,3)

                                                               if MEAL>$PIECE(DATES,U,3)

                                                                   QUIT

 +27      ;Get additional data and file record.

 +28                                                       NEW ZDATE

                                                           SET ZDATE=DATE

 +29                                                       SET DATE=MEAL

 +30                                                       IF $PIECE(DATES,U)

                                                               DO MEALCHK

                                                               if MEALCHK=1

                                                                   QUIT

 +31                                                       DO GET^ECXNUT

 +32                                                       SET DATE=ZDATE

                                                       End DoDot:6

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +33      ;remove individual meals array

 +34       KILL MEALS

INPTF     ;Get inpatient tube feedings

 +1        NEW P1,PNODE,CDATE,ECXTFU,MEALS

 +2       ;set daily meals array for inpatient tube feedings

 +3        SET ECSD=ECSD1

 +4        FOR I=ECSD:1:ECED+1

               SET MEALS(I)=""

 +5        SET (FHDFN,DATE,P1,CDATE,SDATE)=0

           SET (ECXADM,NODE,ECXORDPH,PNODE)=""

 +6        SET P="INP"

           SET D="TF"

FOR

               SET ECXADM=$ORDER(^TMP($JOB,"FH",ECXADM))

               if 'ECXADM

                   QUIT

               Begin DoDot:1

 +7                FOR

                       SET FHDFN=$ORDER(^TMP($JOB,"FH",ECXADM,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +8                        FOR

                               SET DATE=$ORDER(^TMP($JOB,"FH",ECXADM,FHDFN,DATE))

                               if 'DATE

                                   QUIT

                               Begin DoDot:3

 +9                                SET NODE=$GET(^TMP($JOB,"FH",ECXADM,FHDFN,DATE,"TF"))

                                   if 'NODE

                                       QUIT

                                   Begin DoDot:4

 +10                                   FOR

                                           SET P1=$ORDER(^TMP($JOB,"FH",ECXADM,FHDFN,DATE,"TF",P1))

                                           if 'P1

                                               QUIT

                                           Begin DoDot:5

 +11                                           SET PNODE=^TMP($JOB,"FH",ECXADM,FHDFN,DATE,"TF",P1,"P")

 +12                                           SET ORDATE=DATE

                                               SET DATES=$$GETDATES()

                                               SET CDATE=$PIECE(NODE,U,11)

 +13                                           SET SDATE=$SELECT(ORDATE>ECSD:ORDATE,1:ECSD)

 +14                                           SET PRODUCT=$PIECE(PNODE,U,1)

                                               SET ORDER=""_$PIECE(NODE,U,14)_","_""

 +15                                           SET ECXQTY=$SELECT($PIECE(PNODE,U,3)["GM":$PIECE(PNODE,U,3),1:$PIECE(PNODE,U,4))

 +16                                           SET ECXTFU=$SELECT($PIECE(PNODE,U,3)["GM":"GM",1:"ML")

 +17      ;Resolve external value for product key

 +18                                           SET ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)

 +19                                           IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +20      ;create daily meals

 +21                                           SET MEAL=SDATE

FOR

                                                   SET MEAL=$ORDER(MEALS(MEAL))

                                                   if 'MEAL

                                                       QUIT

                                                   Begin DoDot:6

 +22                                                   IF $PIECE(DATES,U)

                                                           if MEAL>$PIECE(DATES,U)

                                                               QUIT

 +23                                                   IF CDATE]""

                                                           if $PIECE(MEAL,".")>$PIECE(CDATE,".")

                                                               QUIT

 +24                                                   IF $PIECE(DATES,U,3)

                                                           if $PIECE(MEAL,".")>$PIECE($PIECE(DATES,U,3),".")

                                                               QUIT

 +25                                                   SET ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I")

 +26      ;Get additional data and file record.

 +27                                                   SET DATE=MEAL

 +28                                                   IF $PIECE(DATES,U)

                                                           DO MEALCHK

                                                           if MEALCHK=1

                                                               QUIT

 +29                                                   DO GET^ECXNUT

                                                       SET DATE=ORDATE

                                                   End DoDot:6

                                           End DoDot:5

                                   End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

OPRM      ;Get outpatient recurring meals

 +1        SET DATE=0

           SET (ECXADM,NODE,ECXORDPH,ECXTFU)=""

 +2        SET P="OP"

           SET D="RM"

FOR

               SET DATE=$ORDER(^TMP($JOB,"FH",DATE))

               if 'DATE

                   QUIT

               Begin DoDot:1

 +3                SET FHDFN=0

FOR

                       SET FHDFN=$ORDER(^TMP($JOB,"FH",DATE,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +4                        SET NUMBER=0

FOR

                               SET NUMBER=$ORDER(^TMP($JOB,"FH",DATE,FHDFN,NUMBER))

                               if 'NUMBER

                                   QUIT

                               Begin DoDot:3

 +5                                SET NODE=$GET(^TMP($JOB,"FH",DATE,FHDFN,NUMBER,"RM"))

                                   if 'NODE

                                       QUIT

 +6                                SET PRODUCT=$PIECE(NODE,U,2)

                                   SET ECXQTY=1

                                   SET ORDER=""_$PIECE(NODE,U,12)_","_""

 +7                                SET PRODUCT=$$GET1^DIQ(111,PRODUCT,4,"I")

 +8                                SET ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I")

 +9       ;Resolve external value for product key

 +10                               SET ECXKEY=$$NUTKEY^ECXUTL6("PD",PRODUCT)

 +11                               IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +12      ;Get additional data and file record.

 +13                               DO GET^ECXNUT

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

OPSO      ;Get outpatient standing orders

 +1        SET DATE=0

           SET (ECXADM,NODE,ECXORDPH)=""

 +2        SET P="OP"

           SET D="SO"

FOR

               SET DATE=$ORDER(^TMP($JOB,"FH",DATE))

               if 'DATE

                   QUIT

               Begin DoDot:1

 +3                SET FHDFN=0

FOR

                       SET FHDFN=$ORDER(^TMP($JOB,"FH",DATE,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +4                        SET NUMBER=0

FOR

                               SET NUMBER=$ORDER(^TMP($JOB,"FH",DATE,FHDFN,NUMBER))

                               if 'NUMBER

                                   QUIT

                               Begin DoDot:3

 +5                                SET FHNUM=0

FOR

                                       SET FHNUM=$ORDER(^TMP($JOB,"FH",DATE,FHDFN,NUMBER,"RMSO",FHNUM))

                                       if FHNUM'>0

                                           QUIT

                                       Begin DoDot:4

 +6                                        NEW SMEAL

                                           SET P="OP"

                                           SET D="SO"

 +7       ;get new order date and time if exist

 +8                                        SET SONODE=^TMP($JOB,"FH",DATE,FHDFN,NUMBER,"RMSO",FHNUM)

 +9                                        SET NORDER=DATE

                                           SET SMEAL=$PIECE(SONODE,U,3)

 +10                                       SET PRODUCT=$PIECE(SONODE,U,2)

                                           SET ECXQTY=$PIECE(SONODE,U,8)

 +11      ;Resolve feeder key for nutrition product

 +12                                       SET ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)

 +13                                       IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +14      ;create individual meals

 +15                                       SET MEAL=NUMBER

FOR

                                               SET MEAL=$ORDER(MEALS(MEAL))

                                               if 'MEAL

                                                   QUIT

                                               Begin DoDot:5

 +16                                               NEW TIME

                                                   SET TIME=$PIECE(MEALS(MEAL),".",2)

 +17                                               if SMEAL'["B"&(TIME="08")

                                                       QUIT

 +18                                               if SMEAL'["N"&(TIME=13)

                                                       QUIT

 +19                                               if SMEAL'["E"&(TIME=18)

                                                       QUIT

 +20                                               IF $PIECE(DATES,U)

                                                       if MEAL>$PIECE(DATES,U)

                                                           QUIT

 +21                                               IF NORDER]""

                                                       if MEAL>NORDER

                                                           QUIT

 +22                                               IF $PIECE(DATES,U,3)

                                                       if MEAL>$PIECE(DATES,U,3)

                                                           QUIT

 +23      ;Get additional data and file record.

 +24                                               NEW ZDATE

                                                   SET ZDATE=DATE

 +25                                               SET DATE=MEAL

                                                   DO GET^ECXNUT

 +26                                               SET DATE=ZDATE

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

OPSF      ;Get outpatient supplemental feedings

 +1        SET DATE=0

           SET (ECXADM,NODE,ECXORDPH)=""

 +2        SET P="OP"

           SET D="SO"

FOR

               SET DATE=$ORDER(^TMP($JOB,"FH",DATE))

               if 'DATE

                   QUIT

               Begin DoDot:1

 +3                SET FHDFN=0

FOR

                       SET FHDFN=$ORDER(^TMP($JOB,"FH",DATE,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +4                        SET NUMBER=0

FOR

                               SET NUMBER=$ORDER(^TMP($JOB,"FH",DATE,FHDFN,NUMBER))

                               if 'NUMBER

                                   QUIT

                               Begin DoDot:3

 +5                                if '$DATA(^TMP($JOB,"FH",DATE,FHDFN,NUMBER,"RMSF"))

                                       QUIT

                                   Begin DoDot:4

 +6                                    NEW SMEAL

                                       SET P="OP"

                                       SET D="SF"

 +7       ;get "sf" orders if they exist

 +8                                    NEW SFNODE

                                       SET (SFNODE,ECXORDPH,CDATE)=""

 +9                                    SET SFNODE=^TMP($JOB,"FH",DATE,FHDFN,NUMBER,"RMSF")

 +10                                   IF +SFNODE

                                           Begin DoDot:5

 +11      ;get new order date and time if exist

 +12                                           SET NORDER=DATE

                                               SET CDATE=$PIECE(SFNODE,U,32)

 +13      ;order thru all "sf" product fields and generate records

 +14                                           FOR SF=5:2:27

                                                   SET PRODUCT=$PIECE(SFNODE,U,SF)

                                                   SET ECXQTY=$PIECE(SFNODE,U,(SF+1))

                                                   Begin DoDot:6

 +15                                                   if PRODUCT']""

                                                           QUIT

 +16      ;Resolve external value for product key

 +17                                                   SET ECXKEY=$$NUTKEY^ECXUTL6("SF",PRODUCT)

 +18                                                   IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +19      ;create individual meals

 +20                                                   FOR MEAL=DATE

 +21                                                   IF $PIECE(DATES,U,3)]""

                                                           if MEAL>$PIECE(DATES,U,3)

                                                               QUIT

 +22      ;Get additional data and file record.

 +23                                                   NEW ZDATE

                                                       SET ZDATE=DATE

 +24                                                   SET DATE=$PIECE(MEAL,".")_"."_$SELECT("57911"[SF:10,"13151719"[SF:14,1:18)

 +25                                                   DO GET^ECXNUT

 +26                                                   SET DATE=ZDATE

                                                   End DoDot:6

                                           End DoDot:5

                                   End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

OPTF      ;Get outpatient tube feedings

 +1        SET DATE=0

           SET (ECXADM,NODE,ECXORDPH)=""

 +2        SET P="OP"

           SET D="TF"

FOR

               SET DATE=$ORDER(^TMP($JOB,"FH",DATE))

               if 'DATE

                   QUIT

               Begin DoDot:1

 +3                SET FHDFN=0

FOR

                       SET FHDFN=$ORDER(^TMP($JOB,"FH",DATE,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +4                        SET NUMBER=0

FOR

                               SET NUMBER=$ORDER(^TMP($JOB,"FH",DATE,FHDFN,NUMBER))

                               if 'NUMBER

                                   QUIT

                               Begin DoDot:3

 +5                                SET NODE=$GET(^TMP($JOB,"FH",DATE,FHDFN,NUMBER,"RMTF"))

                                   if NODE=""

                                       QUIT

 +6                                SET TF=0

FOR

                                       SET TF=$ORDER(^TMP($JOB,"FH",DATE,FHDFN,NUMBER,"RMTF",TF))

                                       if 'TF

                                           QUIT

                                       Begin DoDot:4

 +7                                        SET TFNODE=^TMP($JOB,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)

 +8                                        SET PRODUCT=$PIECE(TFNODE,U,1)

                                           SET ECXQTY=$PIECE(TFNODE,U,4)

 +9       ;Resolve external value for product key

 +10                                       SET ECXKEY=$$NUTKEY^ECXUTL6("TF",PRODUCT)

 +11                                       IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +12      ;Get additional data and file record.

 +13                                       DO GET^ECXNUT

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

OPSM      ;Get outpatient special meals

 +1        SET (FHDFN,DATE)=0

           SET (ECXADM,NODE,ECXORDPH)=""

 +2        SET P="OP"

           SET D="SM"

FOR

               SET DATE=$ORDER(^TMP($JOB,"FH",DATE))

               if 'DATE

                   QUIT

               Begin DoDot:1

 +3                FOR

                       SET FHDFN=$ORDER(^TMP($JOB,"FH",DATE,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +4                        SET NODE=$GET(^TMP($JOB,"FH",DATE,FHDFN,"SM"))

                           if 'NODE

                               QUIT

 +5                        SET PRODUCT=$PIECE(NODE,U,4)

                           SET ECXQTY=1

                           SET ECXORDPH=$PIECE(NODE,U,5)

 +6                        SET PRODUCT=$$GET1^DIQ(111,PRODUCT,4,"I")

 +7       ;Resolve external value for product key

 +8                        SET ECXKEY="SPECGUEST"

 +9                        IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +10      ;Get additional data and file record.

 +11                       DO GET^ECXNUT

                       End DoDot:2

               End DoDot:1

OPGM      ;Get outpatient guest meals

 +1        SET (FHDFN,DATE)=0

           SET (ECXADM,NODE,ECXORDPH)=""

 +2        SET P="OP"

           SET D="GM"

FOR

               SET DATE=$ORDER(^TMP($JOB,"FH",DATE))

               if 'DATE

                   QUIT

               Begin DoDot:1

 +3                FOR

                       SET FHDFN=$ORDER(^TMP($JOB,"FH",DATE,FHDFN))

                       if 'FHDFN

                           QUIT

                       Begin DoDot:2

 +4                        SET NODE=$GET(^TMP($JOB,"FH",DATE,FHDFN,"GM"))

                           if 'NODE

                               QUIT

 +5                        SET PRODUCT=$PIECE(NODE,U,13)

                           SET ECXQTY=1

 +6       ;Resolve external value for product key

 +7                        SET ECXKEY="SPECGUEST"

 +8                        IF $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)

 +9       ;Get additional data and file record.

 +10                       DO GET^ECXNUT

                       End DoDot:2

               End DoDot:1

 +11       QUIT

GETDATES() ;Get admit, discharge, npo/withhold dates,for "inp", "sf" and "so"

 +1       ;  return in string i.e.  stop date^admission date^discharge date

 +2       ;     input:    ecxadm  -  movement file ien

 +3       ;               fhdfn   - nutrition patient file (#115)

 +4       ;

 +5       ;     output:   stop date  - npo/withhold date

 +6       ;               admit date - admission date and time

 +7       ;               discharge date - discharge date and time

 +8       ;               expiration date of withhold date

 +9       ;init variables

 +10       NEW ADATE,DDATE,DATE,STDATE,NORDATE,IENS,RDATE

 +11      ;check input

 +12       if '$GET(ECXADM)!'$GET(FHDFN)

               QUIT "0^0^0^0"

 +13      ;get admission and discharge dates

 +14       SET (ADATE,DDATE,DATE,SDATE,NORDATE,STDATE,RDATE)=""

           SET IENS=""_ECXADM_","_FHDFN_","_""

           SET ADATE=$$GET1^DIQ(115.01,IENS,.01,"I")

           SET DDATE=$$GET1^DIQ(115.01,IENS,18,"I")

 +15      ;get "inp" order's npo/withhold date return it as 'stdate' if exist

 +16       SET DATE=ORDATE

FOR

               SET DATE=$ORDER(@ARRAY@(ECXADM,FHDFN,DATE))

               if 'DATE

                   QUIT

               Begin DoDot:1

 +17               IF $PIECE($GET(@ARRAY@(ECXADM,FHDFN,+DATE,"INP")),U,7)'=""

                       SET STDATE=DATE

                       SET RDATE=$PIECE($GET(@ARRAY@(ECXADM,FHDFN,+DATE,"INP")),U,10)

               End DoDot:1

 +18       QUIT STDATE_U_ADATE_U_DDATE_U_RDATE

NEWORDER(TYPE,DATE) ;Look for new order for inpatient meal type if exist

 +1       ;    Input     ecxadm -  movement #

 +2       ;              fhdfn  -  nutrition file (#115) fhdfn

 +3       ;              date   -  starting order date to begin lookup

 +4       ;              type   -  meal type "sf", "so", or "pd"

 +5       ;    Output:   new order date and time for specific meal type

 +6       ;init variables

 +7        NEW NUMT

 +8        SET NORDER=""

           SET NUMT=0

 +9        if $GET(TYPE)']""!'$GET(DATE)

               QUIT NORDER

 +10       IF TYPE'="SO"

FOR

                   SET DATE=$ORDER(@ARRAY@(ECXADM,FHDFN,DATE))

                   if 'DATE

                       QUIT

                   if NORDER

                       QUIT

                   Begin DoDot:1

 +11                   SET NODE=$GET(^TMP($JOB,"FH",ECXADM,FHDFN,DATE,TYPE))

                       if '+NODE

                           QUIT

 +12                   SET NORDER=DATE

                   End DoDot:1

 +13       IF TYPE="SO"

               Begin DoDot:1

 +14               FOR

                       SET DATE=$ORDER(@ARRAY@(ECXADM,FHDFN,DATE))

                       if 'DATE

                           QUIT

                       if NORDER

                           QUIT

                       Begin DoDot:2

 +15                       SET NUMT=$ORDER(^TMP($JOB,"FH",ECXADM,FHDFN,DATE,TYPE,NUMT))

                           if 'NUMT

                               QUIT

 +16                       SET NODE=$GET(^TMP($JOB,"FH",ECXADM,FHDFN,DATE,TYPE,NUMT))

                           if '+NODE

                               QUIT

 +17                       SET NORDER=DATE

                       End DoDot:2

               End DoDot:1

 +18       QUIT NORDER

MEALCHK   ;CHECK IF MEAL IS ON HOLD

 +1        SET (H,OFF)=""

           SET MEALCHK=0

 +2        IF $PIECE(DATES,U)

               SET H=$PIECE(DATES,U)

 +3        IF $PIECE(DATES,U,4)]""

               SET OFF=$PIECE(DATES,U,4)

 +4       IF '$TEST

               Begin DoDot:1

 +5                SET OFF=$ORDER(@ARRAY@(ECXADM,FHDFN,H))

 +6                IF OFF']""

                       SET OFF=ECED+1

               End DoDot:1

 +7        IF ((DATE-.0000001)>H)

               IF (DATE-.0000001<OFF)

                   SET MEALCHK=1

 +8        KILL H,OFF

 +9        QUIT

ECXNUT1.m