FHDPGM ;Hines OIFO/RTK/FAI PRINT GUEST MEALS LIST ;10/20/04 15:15
;;5.5;DIETETICS;;Jan 28, 2005
;
EN S FHSORT="A"
LIST ;
S EX="",NUM=0 D HDR
F FHGMDT=STDT:0 S FHGMDT=$O(^FHPT(FHDFN,"GM",FHGMDT)) Q:FHGMDT'>0!(FHGMDT<STDT)!(FHGMDT>ENDT)!(EX=U) D
.S NUM=NUM+1,FHNODE=$G(^FHPT(FHDFN,"GM",FHGMDT,0))
.S FHCL=$P(FHNODE,U,2),FHML=$P(FHNODE,U,3),FHCH=$P(FHNODE,U,4)
.S FHLPT=$P($G(FHNODE),U,5)
.S:FHLPT'="" FHLOC=$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,10)
.S FHCL=$S(FHCL="E":" EMPLOYEE",FHCL="G":"GRATUITOUS",FHCL="O":" OOD",FHCL="P":" PAID",1:"VOLUNTEER")
.D PATNAME^FHOMUTL
.S FHD=$$FMTE^XLFDT(FHGMDT,"P") W !,?2,$E(FHD,1,12)
.W ?16,$G(FHLOC),?30,FHML,?36,FHCL,?50,FHCH
.I $Y>(IOSL-4) D PG I EX=U Q
.Q
I NUM=0 W !!,"NO GUEST MEALS FOR THIS DATE RANGE" Q
Q
END ;
K FHGMDT,FHML,FHCL,FHCH
Q
PG ;
Q:$O(^FHPT(FHDFN,"GM",FHGMDT))'>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,"G U E S T M E A L S"
W !!?2,"Date",?16,"Location",?30,"Meal"
W ?36,"Class",?50,"Charge"
W !?2,"============",?16,"=========="
W ?30,"====",?36,"=========",?50,"======"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHDPGM 1150 printed Sep 23, 2025@19:23:38 Page 2
FHDPGM ;Hines OIFO/RTK/FAI PRINT GUEST MEALS LIST ;10/20/04 15:15
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 ;
EN SET FHSORT="A"
LIST ;
+1 SET EX=""
SET NUM=0
DO HDR
+2 FOR FHGMDT=STDT:0
SET FHGMDT=$ORDER(^FHPT(FHDFN,"GM",FHGMDT))
if FHGMDT'>0!(FHGMDT<STDT)!(FHGMDT>ENDT)!(EX=U)
QUIT
Begin DoDot:1
+3 SET NUM=NUM+1
SET FHNODE=$GET(^FHPT(FHDFN,"GM",FHGMDT,0))
+4 SET FHCL=$PIECE(FHNODE,U,2)
SET FHML=$PIECE(FHNODE,U,3)
SET FHCH=$PIECE(FHNODE,U,4)
+5 SET FHLPT=$PIECE($GET(FHNODE),U,5)
+6 if FHLPT'=""
SET FHLOC=$EXTRACT($PIECE($GET(^FH(119.6,FHLPT,0)),U,1),1,10)
+7 SET FHCL=$SELECT(FHCL="E":" EMPLOYEE",FHCL="G":"GRATUITOUS",FHCL="O":" OOD",FHCL="P":" PAID",1:"VOLUNTEER")
+8 DO PATNAME^FHOMUTL
+9 SET FHD=$$FMTE^XLFDT(FHGMDT,"P")
WRITE !,?2,$EXTRACT(FHD,1,12)
+10 WRITE ?16,$GET(FHLOC),?30,FHML,?36,FHCL,?50,FHCH
+11 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+12 QUIT
End DoDot:1
+13 IF NUM=0
WRITE !!,"NO GUEST MEALS FOR THIS DATE RANGE"
QUIT
+14 QUIT
END ;
+1 KILL FHGMDT,FHML,FHCL,FHCH
+2 QUIT
PG ;
+1 if $ORDER(^FHPT(FHDFN,"GM",FHGMDT))'>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,"G U E S T M E A L S"
+3 WRITE !!?2,"Date",?16,"Location",?30,"Meal"
+4 WRITE ?36,"Class",?50,"Charge"
+5 WRITE !?2,"============",?16,"=========="
+6 WRITE ?30,"====",?36,"=========",?50,"======"
+7 QUIT
