- 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 Jan 18, 2025@02:48:52 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