FHOMRMD ;Hines OIFO/RTK/FAI RECURRING MEALS REVIEW/DISPLAY  ;10/20/04  13:22
 ;;5.5;DIETETICS;**1,5**;Jan 28, 2005;Build 53
 ;patch #5 - added outpatient SOs & SFs.
 ;
DISP ;
 S X1=STDT,X2=-1 D C^%DTC S STDT=X
 I '$O(^FHPT(FHDFN,"OP","B",STDT)) W !!,"No Recurring Meals to Display" Q
 K FHLIST S EX="",NUM=0 D HDR I $G(ENDT)="" S ENDT=9999999.99
 F FHRMDT=STDT:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0!(FHRMDT>ENDT)!(EX=U)  F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0!(EX=U)  D
 .S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0))
 .S FHRM=$P(FHNODE,U,1)
 .S NUM=NUM+1,PAD=$S($L(NUM)<3:3-$L(NUM),1:1) W !?PAD,NUM
 .S FHLIST(NUM)=FHRNUM_"^"_FHRM
 .S FHDOW=$$DOW^XLFDT(FHRM),FHDOW=$E(FHDOW,1,3)
 .S FHDTP=$$FMTE^XLFDT(FHRM,"P") W ?6,FHDOW," - ",$E(FHDTP,1,12)
 .S FHLPT=$P(FHNODE,U,3),FHLOCZN=$G(^FH(119.6,FHLPT,0)) D
 ..S FHLOC=$E($P(FHLOCZN,U,1),1,10),FHSERV=$P(FHLOCZN,U,10)
 ..S FHSRV=$S(FHSERV["T":$P(FHLOCZN,U,5),FHSERV["C":$P(FHLOCZN,U,6),1:"")
 ..I FHSRV="" S FHSRVPT="" Q
 ..S FHSRVPT=$P($G(^FH(119.72,FHSRV,0)),U,1)
 ..Q
 .W ?26,FHLOC,?38,$E(FHSRVPT,1,9)
 .W ?51,$P(FHNODE,U,4),?56,$P(FHNODE,U,5)
 .I $P($G(^FH(119.6,FHLPT,1)),U,4)="Y" D DIETPAT W ?60,$E(FHDIETP,1,12)
 .I $P($G(^FH(119.6,FHLPT,1)),U,4)'="Y" S FHDPTR=$P(FHNODE,U,2) Q:FHDPTR=""  W ?60,$E($P($G(^FH(111,FHDPTR,0)),U,1),1,12)
 .S FHSTAT=$P(FHNODE,U,15) I FHSTAT="C" W ?76,"C"
 .I $Y>(IOSL-4) D PG I EX=U Q
 .I $D(^FHPT(FHDFN,"OP",FHRNUM,1)) D
 ..S FHNODE1=$G(^FHPT(FHDFN,"OP",FHRNUM,1))
 ..S FHSTATA=$P(FHNODE1,U,5) I FHSTATA="C" W !?7,"Additional Orders: ",$E($P(FHNODE1,U,1),1,46),?76,"C" Q
 ..W !?7,"Additional Orders: ",$P(FHNODE1,U,1)
 .I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D
 ..S FHNODE2=$G(^FHPT(FHDFN,"OP",FHRNUM,2))
 ..S FHEL=FHNODE2
 ..W !?7,"Early/Late Tray Time: ",$P(FHEL,U,1)
 ..W "  Bagged Meal: ",$P(FHEL,U,2)
 ..S FHSTATE=$P(FHNODE2,U,6) I FHSTATE="C" W ?76,"C"
 .I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D
 ..S FHNODE3=$G(^FHPT(FHDFN,"OP",FHRNUM,3))
 ..S FHTU=FHNODE3
 ..W !?7,"Tubefeeding: " S FHSTATT=$P(FHTU,U,5) I FHSTATT="C" W ?76,"C"
 ..F FHTZ=0:0 S FHTZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ)) Q:FHTZ'>0  D
 ...S FHTUZN=$G(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ,0))
 ...S FHTUPTR=$P(FHTUZN,U,1),FHTUSTR=$P(FHTUZN,U,2)
 ...W !?9,$P($G(^FH(118.2,FHTUPTR,0)),U,1),"  Strength: "
 ...W $S(FHTUSTR=1:"1/4",FHTUSTR=2:"1/2",FHTUSTR=3:"3/4",1:"FULL")
 ...I $P(FHTUZN,U,3)["CC" D  ;print ml instead of cc.
 ....S QUA=$P(FHTUZN,U,3)
 ....S QUAFI=$P(QUA,"CC",1),QUASE=$P(QUA,"CC",2)
 ....S $P(FHTUZN,U,3)=QUAFI_"ML"_QUASE
 ...W "  Quantity: ",$P(FHTUZN,U,3)
 ..W !?7,"Total ML's: ",$P(FHTU,U,2),"  Total KCALS/DAY: ",$P(FHTU,U,3)
 ..S FHTCOMM=$P(FHTU,U,1) I FHTCOMM'="" W !?7,"Comment: ",FHTCOMM
 .;outpatient SOs.
 .I $D(^FHPT(FHDFN,"OP",FHRNUM,"SP")) D
 ..I $Y>(IOSL-4) D PG I EX=U Q
 ..W !,?7,"Standing Orders:"
 ..S FHTZSOL=23,FHTZCNT=0
 ..F FHTZ=0:0 S FHTZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ)) Q:FHTZ'>0  D
 ...S FHTZSO=$G(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ,0))
 ...S FHTZSO2=$P(FHTZSO,U,2)
 ...S FHTZSO6=$P(FHTZSO,U,6)
 ...S FHTZSO8=$P(FHTZSO,U,8)
 ...S FHTZSOCN="" I FHTZSO6'="" S FHTZSOCN=" (C) "
 ...I $G(FHTZSO2),$D(^FH(118.3,FHTZSO2,0)) D
 ....S FHTZSON=$P(^FH(118.3,FHTZSO2,0),U,1)
 ....S FHTZSOL=FHTZSOL+$L(FHTZSON)+$L(FHTZSOCN)+7
 ....I FHTZSOL>80 W !,?23 S FHTZSOL=30+$L(FHTZSON)+$L(FHTZSOCN),FHTZCNT=0
 ....I $G(FHTZCNT) W ", ",FHTZSON,FHTZSOCN," = ",FHTZSO8
 ....E  W " ",FHTZSON,FHTZSOCN," = ",FHTZSO8
 ....S FHTZCNT=FHTZCNT+1
 .I $D(^FHPT(FHDFN,"OP",FHRNUM,"SF")) D
 ..Q:'$D(^FHPT(FHDFN,"OP",FHRNUM,"SF",0))
 ..S SF=""
 ..I $D(^FHPT(FHDFN,"OP",FHRNUM,"SF",0)) S SF=$P(^(0),U,3)
 ..Q:'SF
 ..S FHSFDAT=$G(^FHPT(FHDFN,"OP",FHRNUM,"SF",SF,0))
 ..I SF,$P(FHSFDAT,U,32) Q
 ..I $Y>(IOSL-4) D PG I EX=U Q
 ..W !,?7,"Supplemental Feeding: " I $P(FHSFDAT,U,4),$D(^FH(118.1,$P(FHSFDAT,U,4),0)) W $P(^(0),U,1)
 ..S FHSF10=$P(FHSFDAT,U,5,12)
 ..S FHSF2=$P(FHSFDAT,U,13,20)
 ..S FHSF8=$P(FHSFDAT,U,21,28)
 ..I FHSF10'["^^^^^^^" D
 ...W !,?9,"10AM:"
 ...F FHI=1,3,5,7 S FHSF1=$P(FHSF10,U,FHI) I FHSF1,$D(^FH(118,FHSF1,0)) W " ",$P(^FH(118,FHSF1,0),U,1)," = ",$S('$P(FHSF10,U,FHI+1):1,1:$P(FHSF10,U,FHI+1))
 ..I FHSF2'["^^^^^^^" D
 ...I $Y>(IOSL-4) D PG I EX=U Q
 ...W !,?9,"2PM:"
 ...F FHI=1,3,5,7 S FHSF1=$P(FHSF2,U,FHI) I FHSF1,$D(^FH(118,FHSF1,0)) W " ",$P(^FH(118,FHSF1,0),U,1)," = ",$S('$P(FHSF2,U,FHI+1):1,1:$P(FHSF2,U,FHI+1))
 ..I FHSF8'["^^^^^^^" D
 ...I $Y>(IOSL-4) D PG I EX=U Q
 ...W !,?9,"8PM:"
 ...F FHI=1,3,5,7 S FHSF1=$P(FHSF8,U,FHI) I FHSF1,$D(^FH(118,FHSF1,0)) W " ",$P(^FH(118,FHSF1,0),U,1)," = ",$S('$P(FHSF8,U,FHI+1):1,1:$P(FHSF8,U,FHI+1))
 .Q
 W ! Q
DIETPAT ;
 S FHDIETS=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,7,11)
 S FHDIETP=""
 F PCE=1:1:5 D
 .S FHDPTR=$P(FHDIETS,U,PCE) I FHDPTR="" Q
 .S FHDNM=$P($G(^FH(111,FHDPTR,0)),U,7)
 .I FHDNM="" S FHDNM=$P($G(^FH(111,FHDPTR,0)),U,1)
 .S FHDIETP=FHDIETP_FHDNM_"," Q
 S FHDIETP=$E(FHDIETP,1,$L(FHDIETP)-1)
 Q
PG ;
 Q:$O(^FHPT(FHDFN,"OP","B",FHRMDT))'>0
 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
 D HDR Q
HDR ;
 I $G(FHPP)'=1 W:$Y @IOF
 K FHPP W !?15,"R E C U R R I N G   M E A L S"
 W !!?3,"NAME: " D PATNAME^FHOMUTL W FHPTNM,"   ",FHSSN
 W !!?27,"Ordering",?38,"Service"
 W !?2,"#",?6,"Date/Time",?27,"Location",?38,"Point"
 W ?50,"Meal",?55,"Bag",?60,"Diet Ordered",?74,"Status"
 W !?1,"===",?6,"==================",?26,"=========="
 W ?38,"==========",?50,"====",?55,"===",?60,"============",?74,"======"
 Q
END ;
 K EX,FHDIET,FHDIETP,FHDIETS,FHDTP,FHFIND,FHLOC,FHLPT,FHNODE,FHRM
 K FHRNUM,FHDPTR,FHDNM,FHTZCNT,FHTZSON,FHTZSOCN,FHTZSO8,FHTZSOL,FHTZSO2,FHTZSO6,FHTZ,FHTZSO Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMRMD   5687     printed  Sep 23, 2025@19:28:57                                                                                                                                                                                                     Page 2
FHOMRMD   ;Hines OIFO/RTK/FAI RECURRING MEALS REVIEW/DISPLAY  ;10/20/04  13:22
 +1       ;;5.5;DIETETICS;**1,5**;Jan 28, 2005;Build 53
 +2       ;patch #5 - added outpatient SOs & SFs.
 +3       ;
DISP      ;
 +1        SET X1=STDT
           SET X2=-1
           DO C^%DTC
           SET STDT=X
 +2        IF '$ORDER(^FHPT(FHDFN,"OP","B",STDT))
               WRITE !!,"No Recurring Meals to Display"
               QUIT 
 +3        KILL FHLIST
           SET EX=""
           SET NUM=0
           DO HDR
           IF $GET(ENDT)=""
               SET ENDT=9999999.99
 +4        FOR FHRMDT=STDT:0
               SET FHRMDT=$ORDER(^FHPT(FHDFN,"OP","B",FHRMDT))
               if FHRMDT'>0!(FHRMDT>ENDT)!(EX=U)
                   QUIT 
               FOR FHRNUM=0:0
                   SET FHRNUM=$ORDER(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM))
                   if FHRNUM'>0!(EX=U)
                       QUIT 
                   Begin DoDot:1
 +5                    SET FHNODE=$GET(^FHPT(FHDFN,"OP",FHRNUM,0))
 +6                    SET FHRM=$PIECE(FHNODE,U,1)
 +7                    SET NUM=NUM+1
                       SET PAD=$SELECT($LENGTH(NUM)<3:3-$LENGTH(NUM),1:1)
                       WRITE !?PAD,NUM
 +8                    SET FHLIST(NUM)=FHRNUM_"^"_FHRM
 +9                    SET FHDOW=$$DOW^XLFDT(FHRM)
                       SET FHDOW=$EXTRACT(FHDOW,1,3)
 +10                   SET FHDTP=$$FMTE^XLFDT(FHRM,"P")
                       WRITE ?6,FHDOW," - ",$EXTRACT(FHDTP,1,12)
 +11                   SET FHLPT=$PIECE(FHNODE,U,3)
                       SET FHLOCZN=$GET(^FH(119.6,FHLPT,0))
                       Begin DoDot:2
 +12                       SET FHLOC=$EXTRACT($PIECE(FHLOCZN,U,1),1,10)
                           SET FHSERV=$PIECE(FHLOCZN,U,10)
 +13                       SET FHSRV=$SELECT(FHSERV["T":$PIECE(FHLOCZN,U,5),FHSERV["C":$PIECE(FHLOCZN,U,6),1:"")
 +14                       IF FHSRV=""
                               SET FHSRVPT=""
                               QUIT 
 +15                       SET FHSRVPT=$PIECE($GET(^FH(119.72,FHSRV,0)),U,1)
 +16                       QUIT 
                       End DoDot:2
 +17                   WRITE ?26,FHLOC,?38,$EXTRACT(FHSRVPT,1,9)
 +18                   WRITE ?51,$PIECE(FHNODE,U,4),?56,$PIECE(FHNODE,U,5)
 +19                   IF $PIECE($GET(^FH(119.6,FHLPT,1)),U,4)="Y"
                           DO DIETPAT
                           WRITE ?60,$EXTRACT(FHDIETP,1,12)
 +20                   IF $PIECE($GET(^FH(119.6,FHLPT,1)),U,4)'="Y"
                           SET FHDPTR=$PIECE(FHNODE,U,2)
                           if FHDPTR=""
                               QUIT 
                           WRITE ?60,$EXTRACT($PIECE($GET(^FH(111,FHDPTR,0)),U,1),1,12)
 +21                   SET FHSTAT=$PIECE(FHNODE,U,15)
                       IF FHSTAT="C"
                           WRITE ?76,"C"
 +22                   IF $Y>(IOSL-4)
                           DO PG
                           IF EX=U
                               QUIT 
 +23                   IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,1))
                           Begin DoDot:2
 +24                           SET FHNODE1=$GET(^FHPT(FHDFN,"OP",FHRNUM,1))
 +25                           SET FHSTATA=$PIECE(FHNODE1,U,5)
                               IF FHSTATA="C"
                                   WRITE !?7,"Additional Orders: ",$EXTRACT($PIECE(FHNODE1,U,1),1,46),?76,"C"
                                   QUIT 
 +26                           WRITE !?7,"Additional Orders: ",$PIECE(FHNODE1,U,1)
                           End DoDot:2
 +27                   IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,2))
                           Begin DoDot:2
 +28                           SET FHNODE2=$GET(^FHPT(FHDFN,"OP",FHRNUM,2))
 +29                           SET FHEL=FHNODE2
 +30                           WRITE !?7,"Early/Late Tray Time: ",$PIECE(FHEL,U,1)
 +31                           WRITE "  Bagged Meal: ",$PIECE(FHEL,U,2)
 +32                           SET FHSTATE=$PIECE(FHNODE2,U,6)
                               IF FHSTATE="C"
                                   WRITE ?76,"C"
                           End DoDot:2
 +33                   IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,3))
                           Begin DoDot:2
 +34                           SET FHNODE3=$GET(^FHPT(FHDFN,"OP",FHRNUM,3))
 +35                           SET FHTU=FHNODE3
 +36                           WRITE !?7,"Tubefeeding: "
                               SET FHSTATT=$PIECE(FHTU,U,5)
                               IF FHSTATT="C"
                                   WRITE ?76,"C"
 +37                           FOR FHTZ=0:0
                                   SET FHTZ=$ORDER(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ))
                                   if FHTZ'>0
                                       QUIT 
                                   Begin DoDot:3
 +38                                   SET FHTUZN=$GET(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ,0))
 +39                                   SET FHTUPTR=$PIECE(FHTUZN,U,1)
                                       SET FHTUSTR=$PIECE(FHTUZN,U,2)
 +40                                   WRITE !?9,$PIECE($GET(^FH(118.2,FHTUPTR,0)),U,1),"  Strength: "
 +41                                   WRITE $SELECT(FHTUSTR=1:"1/4",FHTUSTR=2:"1/2",FHTUSTR=3:"3/4",1:"FULL")
 +42      ;print ml instead of cc.
                                       IF $PIECE(FHTUZN,U,3)["CC"
                                           Begin DoDot:4
 +43                                           SET QUA=$PIECE(FHTUZN,U,3)
 +44                                           SET QUAFI=$PIECE(QUA,"CC",1)
                                               SET QUASE=$PIECE(QUA,"CC",2)
 +45                                           SET $PIECE(FHTUZN,U,3)=QUAFI_"ML"_QUASE
                                           End DoDot:4
 +46                                   WRITE "  Quantity: ",$PIECE(FHTUZN,U,3)
                                   End DoDot:3
 +47                           WRITE !?7,"Total ML's: ",$PIECE(FHTU,U,2),"  Total KCALS/DAY: ",$PIECE(FHTU,U,3)
 +48                           SET FHTCOMM=$PIECE(FHTU,U,1)
                               IF FHTCOMM'=""
                                   WRITE !?7,"Comment: ",FHTCOMM
                           End DoDot:2
 +49      ;outpatient SOs.
 +50                   IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,"SP"))
                           Begin DoDot:2
 +51                           IF $Y>(IOSL-4)
                                   DO PG
                                   IF EX=U
                                       QUIT 
 +52                           WRITE !,?7,"Standing Orders:"
 +53                           SET FHTZSOL=23
                               SET FHTZCNT=0
 +54                           FOR FHTZ=0:0
                                   SET FHTZ=$ORDER(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ))
                                   if FHTZ'>0
                                       QUIT 
                                   Begin DoDot:3
 +55                                   SET FHTZSO=$GET(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ,0))
 +56                                   SET FHTZSO2=$PIECE(FHTZSO,U,2)
 +57                                   SET FHTZSO6=$PIECE(FHTZSO,U,6)
 +58                                   SET FHTZSO8=$PIECE(FHTZSO,U,8)
 +59                                   SET FHTZSOCN=""
                                       IF FHTZSO6'=""
                                           SET FHTZSOCN=" (C) "
 +60                                   IF $GET(FHTZSO2)
                                           IF $DATA(^FH(118.3,FHTZSO2,0))
                                               Begin DoDot:4
 +61                                               SET FHTZSON=$PIECE(^FH(118.3,FHTZSO2,0),U,1)
 +62                                               SET FHTZSOL=FHTZSOL+$LENGTH(FHTZSON)+$LENGTH(FHTZSOCN)+7
 +63                                               IF FHTZSOL>80
                                                       WRITE !,?23
                                                       SET FHTZSOL=30+$LENGTH(FHTZSON)+$LENGTH(FHTZSOCN)
                                                       SET FHTZCNT=0
 +64                                               IF $GET(FHTZCNT)
                                                       WRITE ", ",FHTZSON,FHTZSOCN," = ",FHTZSO8
 +65                                              IF '$TEST
                                                       WRITE " ",FHTZSON,FHTZSOCN," = ",FHTZSO8
 +66                                               SET FHTZCNT=FHTZCNT+1
                                               End DoDot:4
                                   End DoDot:3
                           End DoDot:2
 +67                   IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,"SF"))
                           Begin DoDot:2
 +68                           if '$DATA(^FHPT(FHDFN,"OP",FHRNUM,"SF",0))
                                   QUIT 
 +69                           SET SF=""
 +70                           IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,"SF",0))
                                   SET SF=$PIECE(^(0),U,3)
 +71                           if 'SF
                                   QUIT 
 +72                           SET FHSFDAT=$GET(^FHPT(FHDFN,"OP",FHRNUM,"SF",SF,0))
 +73                           IF SF
                                   IF $PIECE(FHSFDAT,U,32)
                                       QUIT 
 +74                           IF $Y>(IOSL-4)
                                   DO PG
                                   IF EX=U
                                       QUIT 
 +75                           WRITE !,?7,"Supplemental Feeding: "
                               IF $PIECE(FHSFDAT,U,4)
                                   IF $DATA(^FH(118.1,$PIECE(FHSFDAT,U,4),0))
                                       WRITE $PIECE(^(0),U,1)
 +76                           SET FHSF10=$PIECE(FHSFDAT,U,5,12)
 +77                           SET FHSF2=$PIECE(FHSFDAT,U,13,20)
 +78                           SET FHSF8=$PIECE(FHSFDAT,U,21,28)
 +79                           IF FHSF10'["^^^^^^^"
                                   Begin DoDot:3
 +80                                   WRITE !,?9,"10AM:"
 +81                                   FOR FHI=1,3,5,7
                                           SET FHSF1=$PIECE(FHSF10,U,FHI)
                                           IF FHSF1
                                               IF $DATA(^FH(118,FHSF1,0))
                                                   WRITE " ",$PIECE(^FH(118,FHSF1,0),U,1)," = ",$SELECT('$PIECE(FHSF10,U,FHI+1):1,1:$PIECE(FHSF10,U,FHI+1))
                                   End DoDot:3
 +82                           IF FHSF2'["^^^^^^^"
                                   Begin DoDot:3
 +83                                   IF $Y>(IOSL-4)
                                           DO PG
                                           IF EX=U
                                               QUIT 
 +84                                   WRITE !,?9,"2PM:"
 +85                                   FOR FHI=1,3,5,7
                                           SET FHSF1=$PIECE(FHSF2,U,FHI)
                                           IF FHSF1
                                               IF $DATA(^FH(118,FHSF1,0))
                                                   WRITE " ",$PIECE(^FH(118,FHSF1,0),U,1)," = ",$SELECT('$PIECE(FHSF2,U,FHI+1):1,1:$PIECE(FHSF2,U,FHI+1))
                                   End DoDot:3
 +86                           IF FHSF8'["^^^^^^^"
                                   Begin DoDot:3
 +87                                   IF $Y>(IOSL-4)
                                           DO PG
                                           IF EX=U
                                               QUIT 
 +88                                   WRITE !,?9,"8PM:"
 +89                                   FOR FHI=1,3,5,7
                                           SET FHSF1=$PIECE(FHSF8,U,FHI)
                                           IF FHSF1
                                               IF $DATA(^FH(118,FHSF1,0))
                                                   WRITE " ",$PIECE(^FH(118,FHSF1,0),U,1)," = ",$SELECT('$PIECE(FHSF8,U,FHI+1):1,1:$PIECE(FHSF8,U,FHI+1))
                                   End DoDot:3
                           End DoDot:2
 +90                   QUIT 
                   End DoDot:1
 +91       WRITE !
           QUIT 
DIETPAT   ;
 +1        SET FHDIETS=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,7,11)
 +2        SET FHDIETP=""
 +3        FOR PCE=1:1:5
               Begin DoDot:1
 +4                SET FHDPTR=$PIECE(FHDIETS,U,PCE)
                   IF FHDPTR=""
                       QUIT 
 +5                SET FHDNM=$PIECE($GET(^FH(111,FHDPTR,0)),U,7)
 +6                IF FHDNM=""
                       SET FHDNM=$PIECE($GET(^FH(111,FHDPTR,0)),U,1)
 +7                SET FHDIETP=FHDIETP_FHDNM_","
                   QUIT 
               End DoDot:1
 +8        SET FHDIETP=$EXTRACT(FHDIETP,1,$LENGTH(FHDIETP)-1)
 +9        QUIT 
PG        ;
 +1        if $ORDER(^FHPT(FHDFN,"OP","B",FHRMDT))'>0
               QUIT 
 +2        IF IOST?1"C".E
               WRITE !
               KILL DIR
               SET DIR(0)="E"
               DO ^DIR
               IF 'Y
                   SET EX=U
                   QUIT 
 +3        DO HDR
           QUIT 
HDR       ;
 +1        IF $GET(FHPP)'=1
               if $Y
                   WRITE @IOF
 +2        KILL FHPP
           WRITE !?15,"R E C U R R I N G   M E A L S"
 +3        WRITE !!?3,"NAME: "
           DO PATNAME^FHOMUTL
           WRITE FHPTNM,"   ",FHSSN
 +4        WRITE !!?27,"Ordering",?38,"Service"
 +5        WRITE !?2,"#",?6,"Date/Time",?27,"Location",?38,"Point"
 +6        WRITE ?50,"Meal",?55,"Bag",?60,"Diet Ordered",?74,"Status"
 +7        WRITE !?1,"===",?6,"==================",?26,"=========="
 +8        WRITE ?38,"==========",?50,"====",?55,"===",?60,"============",?74,"======"
 +9        QUIT 
END       ;
 +1        KILL EX,FHDIET,FHDIETP,FHDIETS,FHDTP,FHFIND,FHLOC,FHLPT,FHNODE,FHRM
 +2        KILL FHRNUM,FHDPTR,FHDNM,FHTZCNT,FHTZSON,FHTZSOCN,FHTZSO8,FHTZSOL,FHTZSO2,FHTZSO6,FHTZ,FHTZSO
           QUIT