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
Q
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
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXNUT1 13660 printed Oct 16, 2024@17:53:55 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
