- 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 Mar 13, 2025@20:52:19 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
