FHDPSM ;Hines OIFO/RTK/FAI SPECIAL MEALS DISPLAY ;10/20/04 14:22
;;5.5;DIETETICS;**19**;Jan 28, 2005;Build 2
;
LIST ;
K FHLIST S FHS="ACDP",NUM=0,EX="" D HDR
F FHSMDT=STDT:0 S FHSMDT=$O(^FHPT(FHDFN,"SM",FHSMDT)) Q:FHSMDT'>0!(FHSMDT<STDT)!(FHSMDT>ENDT)!(EX=U) D
.S FHNODE=$G(^FHPT(FHDFN,"SM",FHSMDT,0)),FHSTAT=$P(FHNODE,U,2)
.I FHS'[FHSTAT Q
.S FHSTAT=$S(FHSTAT="P":"PENDING",FHSTAT="A":"AUTHORIZED",FHSTAT="D":"DENIED",1:"CANCELLED")
.S NUM=NUM+1,PAD=$S($L(NUM)=1:" ",1:"") W !,PAD,NUM
.D PATNAME^FHOMUTL
.S FHD=$$FMTE^XLFDT(FHSMDT,"P") W ?8,$E(FHD,1,12)
.S FHLPT=$P($G(FHNODE),U,3),FHLOC=$S(FHLPT="":"",1:$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,10))
.W ?26,FHLOC
.S FHDPT=$P(FHNODE,U,4),FHDIET=$S(FHDPT="":"",1:$E($P($G(^FH(111,FHDPT,0)),U,1),1,12))
.W ?40,FHDIET
.S FHMEAL=$P(FHNODE,U,9) W ?57,FHMEAL,?65,FHSTAT
.S FHLIST(NUM)=FHDFN_"^"_FHSMDT
.I $E(FHSTAT,1)="D" D
..S FHDENY=$P(FHNODE,U,6)
..I FHDENY'="" W !,?6,"Denied By: ",$P($G(^VA(200,FHDENY,0)),U,1)
.S FHCOMM=$P(FHNODE,U,8) I FHCOMM'="" W !?6,"Comment: ",FHCOMM
.I $D(^FHPT(FHDFN,"SM",FHSMDT,1)) D
..S FHEL=$G(^FHPT(FHDFN,"SM",FHSMDT,1))
..W !?6,"Early/Late Tray Time: ",$P(FHEL,U,1)
..W " Bagged Meal: ",$P(FHEL,U,2)
..Q
.I $Y>(IOSL-4) D PG I EX=U Q
.Q
I NUM=0 W !!,"NO SPECIAL MEALS FOR THIS DATE RANGE" Q
Q
PG ;
Q:$O(^FHPT(FHDFN,"SM",FHSMDT))'>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 ;
W:$Y @IOF
W !?15,"S P E C I A L M E A L S "
W !!!?1,"#",?8,"Date/Time",?26,"Location",?40,"Diet Ordered",?57,"Meal",?65,"Status"
W !,"===",?7,"============",?25,"==========",?39,"============",?56,"====",?65,"========="
Q
END ;
K EX,FHNODE,FHSTAT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHDPSM 1715 printed Oct 16, 2024@17:48:30 Page 2
FHDPSM ;Hines OIFO/RTK/FAI SPECIAL MEALS DISPLAY ;10/20/04 14:22
+1 ;;5.5;DIETETICS;**19**;Jan 28, 2005;Build 2
+2 ;
LIST ;
+1 KILL FHLIST
SET FHS="ACDP"
SET NUM=0
SET EX=""
DO HDR
+2 FOR FHSMDT=STDT:0
SET FHSMDT=$ORDER(^FHPT(FHDFN,"SM",FHSMDT))
if FHSMDT'>0!(FHSMDT<STDT)!(FHSMDT>ENDT)!(EX=U)
QUIT
Begin DoDot:1
+3 SET FHNODE=$GET(^FHPT(FHDFN,"SM",FHSMDT,0))
SET FHSTAT=$PIECE(FHNODE,U,2)
+4 IF FHS'[FHSTAT
QUIT
+5 SET FHSTAT=$SELECT(FHSTAT="P":"PENDING",FHSTAT="A":"AUTHORIZED",FHSTAT="D":"DENIED",1:"CANCELLED")
+6 SET NUM=NUM+1
SET PAD=$SELECT($LENGTH(NUM)=1:" ",1:"")
WRITE !,PAD,NUM
+7 DO PATNAME^FHOMUTL
+8 SET FHD=$$FMTE^XLFDT(FHSMDT,"P")
WRITE ?8,$EXTRACT(FHD,1,12)
+9 SET FHLPT=$PIECE($GET(FHNODE),U,3)
SET FHLOC=$SELECT(FHLPT="":"",1:$EXTRACT($PIECE($GET(^FH(119.6,FHLPT,0)),U,1),1,10))
+10 WRITE ?26,FHLOC
+11 SET FHDPT=$PIECE(FHNODE,U,4)
SET FHDIET=$SELECT(FHDPT="":"",1:$EXTRACT($PIECE($GET(^FH(111,FHDPT,0)),U,1),1,12))
+12 WRITE ?40,FHDIET
+13 SET FHMEAL=$PIECE(FHNODE,U,9)
WRITE ?57,FHMEAL,?65,FHSTAT
+14 SET FHLIST(NUM)=FHDFN_"^"_FHSMDT
+15 IF $EXTRACT(FHSTAT,1)="D"
Begin DoDot:2
+16 SET FHDENY=$PIECE(FHNODE,U,6)
+17 IF FHDENY'=""
WRITE !,?6,"Denied By: ",$PIECE($GET(^VA(200,FHDENY,0)),U,1)
End DoDot:2
+18 SET FHCOMM=$PIECE(FHNODE,U,8)
IF FHCOMM'=""
WRITE !?6,"Comment: ",FHCOMM
+19 IF $DATA(^FHPT(FHDFN,"SM",FHSMDT,1))
Begin DoDot:2
+20 SET FHEL=$GET(^FHPT(FHDFN,"SM",FHSMDT,1))
+21 WRITE !?6,"Early/Late Tray Time: ",$PIECE(FHEL,U,1)
+22 WRITE " Bagged Meal: ",$PIECE(FHEL,U,2)
+23 QUIT
End DoDot:2
+24 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+25 QUIT
End DoDot:1
+26 IF NUM=0
WRITE !!,"NO SPECIAL MEALS FOR THIS DATE RANGE"
QUIT
+27 QUIT
PG ;
+1 if $ORDER(^FHPT(FHDFN,"SM",FHSMDT))'>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 $Y
WRITE @IOF
+2 WRITE !?15,"S P E C I A L M E A L S "
+3 WRITE !!!?1,"#",?8,"Date/Time",?26,"Location",?40,"Diet Ordered",?57,"Meal",?65,"Status"
+4 WRITE !,"===",?7,"============",?25,"==========",?39,"============",?56,"====",?65,"========="
+5 QUIT
END ;
+1 KILL EX,FHNODE,FHSTAT
QUIT
