FHOMRR1 ;Hines OIFO/RTK RECURRING MEALS REVIEW/DISPLAY ;2/04/03 14:05
;;5.5;DIETETICS;**1,5**;Jan 28, 2005;Build 53
;11/30/05 patch 5 - added outpatient standing order & SFs.
;
STRT K FHPSDT D GETOPT^FHOMUTL I FHFIND=0 Q
I STDT="" Q
D ENDATE^FHOMUTL I ENDT="" Q
S ENDT=ENDT_.99
D DEV D STRT Q
;I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q
;
DEV ;get device and set up queue
W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
I '$D(IO("Q")) U IO D DISP,^%ZISC,END Q
S ZTRTN="DISP^FHOMRR1"
S ZTSAVE("STDT")="",ZTSAVE("FHDFN")=""
S ZTDESC="Outpatient Meals Recurring Meals Display" D ^%ZTLOAD
D ^%ZISC K %ZIS,IOP
D END Q
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)) Q:FHNODE=""
.I $P(FHNODE,U,15)="C" Q
.S FHRM=$P(FHNODE,U,1)
.S NUM=NUM+1,PAD=$S($L(NUM)=1:" ",1:"") W !,PAD,NUM
.S FHLIST(NUM)=FHRNUM_"^"_FHRM
.S FHDTP=$$FMTE^XLFDT(FHRM,"P") W ?5,$E(FHDTP,1,12)
.S FHRMBD=$P(FHNODE,U,18),FHRMBNM=""
.I FHRMBD'="" S FHRMBNM=$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,11)
.S FHLPT=$P(FHNODE,U,3),FHLOCZN=$G(^FH(119.6,FHLPT,0)) D
..S FHLOC=$E($P(FHLOCZN,U,1),1,11),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 ?19,FHLOC,?31,FHRMBNM,?44,$E(FHSRVPT,1,11),?58,$P(FHNODE,U,4)
.I $P($G(^FH(119.6,FHLPT,1)),U,4)="Y" D DIETPAT W ?63,$E(FHDIETP,1,17)
.I $P($G(^FH(119.6,FHLPT,1)),U,4)'="Y" S FHDPTR=$P(FHNODE,U,2) Q:FHDPTR="" W ?63,$E($P($G(^FH(111,FHDPTR,0)),U,1),1,17)
.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)) I $P(FHNODE1,U,5)="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 I $P(FHNODE2,U,6)="C" Q
..W !?7,"Early/Late Tray Time: ",$P(FHEL,U,1)
..W " Bagged Meal: ",$P(FHEL,U,2)
.I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D
..S FHNODE3=$G(^FHPT(FHDFN,"OP",FHRNUM,3))
..S FHTU=FHNODE3 I $P(FHTU,U,5)="C" Q
..W !?7,"Tubefeeding: "
..F FHTZ=0:0 S FHTZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ)) Q:FHTZ'>0!(EX=U) 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)
...I $Y>(IOSL-4) D PG I EX=U Q
..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
.Q:EX=U 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'="" QUIT ;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
.Q:EX=U 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))
..Q:EX=U 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 !?5,"R E C U R R I N G M E A L D I S P L A Y"
W !!?3,"OUTPATIENT NAME: " D PATNAME^FHOMUTL W FHPTNM," ",FHSSN
W ?65,FHSEX," Age ",FHAGE
W !!," #",?5,"Date/Time",?19,"Location Room-Bed",?44,"Service Pnt"
W ?57,"Meal",?63,"Diet Ordered"
W !,"===",?5,"============",?19,"=========== ==========="
W ?44,"===========",?57,"====",?63,"================="
Q
END ;
K ENDT,EX,FHDIET,FHDIETP,FHDIETS,FHDTP,FHFIND,FHLOC,FHLPT,FHNODE,FHRM,DIR,BID,DFN,FHDFN
K FHRNUM,FHDPTR,FHDNM,FHAGE,FHBID,FHDFN,FHDOB,FHDOW,FHDTDF,FHI,FHLIST,FHLOCZN,FHPCZN
K FHPTNM,FHRMDT,FHSERV,FHSEX,FHSF1,FHSF10,FHSF2,FHSF8,FHSFDAT,FHSRV,FHSRVPT,FHSSN,FHTZ,FHTZCNT,FHTZSO
K FHTZSO2,FHTZSO6,FHTZSO8,FHTZSOCN,FHTZSOL,FHTZSON,FHZ115,FILE,FLAG,IEN,IEN200,J,NUM,PAD,PCE,PID,POP,SF,STDT
Q
FHOMRR1 ;Hines OIFO/RTK RECURRING MEALS REVIEW/DISPLAY ;2/04/03 14:05
+1 ;;5.5;DIETETICS;**1,5**;Jan 28, 2005;Build 53
+2 ;11/30/05 patch 5 - added outpatient standing order & SFs.
+3 ;
STRT KILL FHPSDT
DO GETOPT^FHOMUTL
IF FHFIND=0
QUIT
+1 IF STDT=""
QUIT
+2 DO ENDATE^FHOMUTL
IF ENDT=""
QUIT
+3 SET ENDT=ENDT_.99
+4 DO DEV
DO STRT
QUIT
+5 ;I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q
+6 ;
DEV ;get device and set up queue
+1 WRITE !
KILL %ZIS,IOP
SET %ZIS="Q"
DO ^%ZIS
IF POP
QUIT
+2 IF '$DATA(IO("Q"))
USE IO
DO DISP
DO ^%ZISC
DO END
QUIT
+3 SET ZTRTN="DISP^FHOMRR1"
+4 SET ZTSAVE("STDT")=""
SET ZTSAVE("FHDFN")=""
+5 SET ZTDESC="Outpatient Meals Recurring Meals Display"
DO ^%ZTLOAD
+6 DO ^%ZISC
KILL %ZIS,IOP
+7 DO END
QUIT
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))
IF FHNODE=""
QUIT
+6 IF $PIECE(FHNODE,U,15)="C"
QUIT
+7 SET FHRM=$PIECE(FHNODE,U,1)
+8 SET NUM=NUM+1
SET PAD=$SELECT($LENGTH(NUM)=1:" ",1:"")
WRITE !,PAD,NUM
+9 SET FHLIST(NUM)=FHRNUM_"^"_FHRM
+10 SET FHDTP=$$FMTE^XLFDT(FHRM,"P")
WRITE ?5,$EXTRACT(FHDTP,1,12)
+11 SET FHRMBD=$PIECE(FHNODE,U,18)
SET FHRMBNM=""
+12 IF FHRMBD'=""
SET FHRMBNM=$EXTRACT($PIECE($GET(^DG(405.4,FHRMBD,0)),U,1),1,11)
+13 SET FHLPT=$PIECE(FHNODE,U,3)
SET FHLOCZN=$GET(^FH(119.6,FHLPT,0))
Begin DoDot:2
+14 SET FHLOC=$EXTRACT($PIECE(FHLOCZN,U,1),1,11)
SET FHSERV=$PIECE(FHLOCZN,U,10)
+15 SET FHSRV=$SELECT(FHSERV["T":$PIECE(FHLOCZN,U,5),FHSERV["C":$PIECE(FHLOCZN,U,6),1:"")
+16 IF FHSRV=""
SET FHSRVPT=""
QUIT
+17 SET FHSRVPT=$PIECE($GET(^FH(119.72,FHSRV,0)),U,1)
+18 QUIT
End DoDot:2
+19 WRITE ?19,FHLOC,?31,FHRMBNM,?44,$EXTRACT(FHSRVPT,1,11),?58,$PIECE(FHNODE,U,4)
+20 IF $PIECE($GET(^FH(119.6,FHLPT,1)),U,4)="Y"
DO DIETPAT
WRITE ?63,$EXTRACT(FHDIETP,1,17)
+21 IF $PIECE($GET(^FH(119.6,FHLPT,1)),U,4)'="Y"
SET FHDPTR=$PIECE(FHNODE,U,2)
IF FHDPTR=""
QUIT
WRITE ?63,$EXTRACT($PIECE($GET(^FH(111,FHDPTR,0)),U,1),1,17)
+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))
IF $PIECE(FHNODE1,U,5)="C"
QUIT
+25 WRITE !?7,"Additional Orders: ",$PIECE(FHNODE1,U,1)
End DoDot:2
+26 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,2))
Begin DoDot:2
+27 SET FHNODE2=$GET(^FHPT(FHDFN,"OP",FHRNUM,2))
+28 SET FHEL=FHNODE2
IF $PIECE(FHNODE2,U,6)="C"
QUIT
+29 WRITE !?7,"Early/Late Tray Time: ",$PIECE(FHEL,U,1)
+30 WRITE " Bagged Meal: ",$PIECE(FHEL,U,2)
End DoDot:2
+31 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,3))
Begin DoDot:2
+32 SET FHNODE3=$GET(^FHPT(FHDFN,"OP",FHRNUM,3))
+33 SET FHTU=FHNODE3
IF $PIECE(FHTU,U,5)="C"
QUIT
+34 WRITE !?7,"Tubefeeding: "
+35 FOR FHTZ=0:0
SET FHTZ=$ORDER(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ))
IF FHTZ'>0!(EX=U)
QUIT
Begin DoDot:3
+36 SET FHTUZN=$GET(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ,0))
+37 SET FHTUPTR=$PIECE(FHTUZN,U,1)
SET FHTUSTR=$PIECE(FHTUZN,U,2)
+38 WRITE !?9,$PIECE($GET(^FH(118.2,FHTUPTR,0)),U,1)," Strength: "
+39 WRITE $SELECT(FHTUSTR=1:"1/4",FHTUSTR=2:"1/2",FHTUSTR=3:"3/4",1:"FULL")
+40 ;print ml instead of cc.
IF $PIECE(FHTUZN,U,3)["CC"
Begin DoDot:4
+41 SET QUA=$PIECE(FHTUZN,U,3)
+42 SET QUAFI=$PIECE(QUA,"CC",1)
SET QUASE=$PIECE(QUA,"CC",2)
+43 SET $PIECE(FHTUZN,U,3)=QUAFI_"ML"_QUASE
End DoDot:4
+44 WRITE " Quantity: ",$PIECE(FHTUZN,U,3)
+45 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
End DoDot:3
+46 WRITE !?7,"Total ML's: ",$PIECE(FHTU,U,2)," Total KCALS/DAY: ",$PIECE(FHTU,U,3)
+47 SET FHTCOMM=$PIECE(FHTU,U,1)
IF FHTCOMM'=""
WRITE !?7,"Comment: ",FHTCOMM
End DoDot:2
+48 IF EX=U
QUIT
IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,"SP"))
Begin DoDot:2
+49 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+50 WRITE !,?7,"Standing Orders:"
+51 SET FHTZSOL=23
SET FHTZCNT=0
+52 FOR FHTZ=0:0
SET FHTZ=$ORDER(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ))
IF FHTZ'>0
QUIT
Begin DoDot:3
+53 SET FHTZSO=$GET(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ,0))
+54 SET FHTZSO2=$PIECE(FHTZSO,U,2)
+55 SET FHTZSO6=$PIECE(FHTZSO,U,6)
+56 SET FHTZSO8=$PIECE(FHTZSO,U,8)
+57 ;S FHTZSOCN=" (C) "
SET FHTZSOCN=""
IF FHTZSO6'=""
QUIT
+58 IF $GET(FHTZSO2)
IF $DATA(^FH(118.3,FHTZSO2,0))
Begin DoDot:4
+59 SET FHTZSON=$PIECE(^FH(118.3,FHTZSO2,0),U,1)
+60 SET FHTZSOL=FHTZSOL+$LENGTH(FHTZSON)+$LENGTH(FHTZSOCN)+7
+61 IF FHTZSOL>80
WRITE !,?23
SET FHTZSOL=30+$LENGTH(FHTZSON)+$LENGTH(FHTZSOCN)
SET FHTZCNT=0
+62 IF $GET(FHTZCNT)
WRITE ", ",FHTZSON,FHTZSOCN," = ",FHTZSO8
+63 IF '$TEST
WRITE " ",FHTZSON,FHTZSOCN," = ",FHTZSO8
+64 SET FHTZCNT=FHTZCNT+1
End DoDot:4
End DoDot:3
End DoDot:2
+65 IF EX=U
QUIT
IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,"SF"))
Begin DoDot:2
+66 IF '$DATA(^FHPT(FHDFN,"OP",FHRNUM,"SF",0))
QUIT
+67 SET SF=""
+68 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,"SF",0))
SET SF=$PIECE(^(0),U,3)
+69 IF 'SF
QUIT
+70 SET FHSFDAT=$GET(^FHPT(FHDFN,"OP",FHRNUM,"SF",SF,0))
+71 IF SF
IF $PIECE(FHSFDAT,U,32)
QUIT
+72 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+73 WRITE !,?7,"Supplemental Feeding: "
IF $PIECE(FHSFDAT,U,4)
IF $DATA(^FH(118.1,$PIECE(FHSFDAT,U,4),0))
WRITE $PIECE(^(0),U,1)
+74 SET FHSF10=$PIECE(FHSFDAT,U,5,12)
+75 SET FHSF2=$PIECE(FHSFDAT,U,13,20)
+76 SET FHSF8=$PIECE(FHSFDAT,U,21,28)
+77 IF FHSF10'["^^^^^^^"
Begin DoDot:3
+78 WRITE !,?9,"10AM:"
+79 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
+80 IF FHSF2'["^^^^^^^"
Begin DoDot:3
+81 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+82 WRITE !,?9,"2PM:"
+83 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
+84 IF EX=U
QUIT
IF FHSF8'["^^^^^^^"
Begin DoDot:3
+85 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+86 WRITE !,?9,"8PM:"
+87 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
+88 QUIT
End DoDot:1
+89 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 !?5,"R E C U R R I N G M E A L D I S P L A Y"
+3 WRITE !!?3,"OUTPATIENT NAME: "
DO PATNAME^FHOMUTL
WRITE FHPTNM," ",FHSSN
+4 WRITE ?65,FHSEX," Age ",FHAGE
+5 WRITE !!," #",?5,"Date/Time",?19,"Location Room-Bed",?44,"Service Pnt"
+6 WRITE ?57,"Meal",?63,"Diet Ordered"
+7 WRITE !,"===",?5,"============",?19,"=========== ==========="
+8 WRITE ?44,"===========",?57,"====",?63,"================="
+9 QUIT
END ;
+1 KILL ENDT,EX,FHDIET,FHDIETP,FHDIETS,FHDTP,FHFIND,FHLOC,FHLPT,FHNODE,FHRM,DIR,BID,DFN,FHDFN
+2 KILL FHRNUM,FHDPTR,FHDNM,FHAGE,FHBID,FHDFN,FHDOB,FHDOW,FHDTDF,FHI,FHLIST,FHLOCZN,FHPCZN
+3 KILL FHPTNM,FHRMDT,FHSERV,FHSEX,FHSF1,FHSF10,FHSF2,FHSF8,FHSFDAT,FHSRV,FHSRVPT,FHSSN,FHTZ,FHTZCNT,FHTZSO
+4 KILL FHTZSO2,FHTZSO6,FHTZSO8,FHTZSOCN,FHTZSOL,FHTZSON,FHZ115,FILE,FLAG,IEN,IEN200,J,NUM,PAD,PCE,PID,POP,SF,STDT
+5 QUIT
