- 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 Feb 18, 2025@23:19:20 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