source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHDPGM.m@ 703

Last change on this file since 703 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1FHDPGM ;Hines OIFO/RTK/FAI PRINT GUEST MEALS LIST ;10/20/04 15:15
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 ;
4EN S FHSORT="A"
5LIST ;
6 S EX="",NUM=0 D HDR
7 F FHGMDT=STDT:0 S FHGMDT=$O(^FHPT(FHDFN,"GM",FHGMDT)) Q:FHGMDT'>0!(FHGMDT<STDT)!(FHGMDT>ENDT)!(EX=U) D
8 .S NUM=NUM+1,FHNODE=$G(^FHPT(FHDFN,"GM",FHGMDT,0))
9 .S FHCL=$P(FHNODE,U,2),FHML=$P(FHNODE,U,3),FHCH=$P(FHNODE,U,4)
10 .S FHLPT=$P($G(FHNODE),U,5)
11 .S:FHLPT'="" FHLOC=$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,10)
12 .S FHCL=$S(FHCL="E":" EMPLOYEE",FHCL="G":"GRATUITOUS",FHCL="O":" OOD",FHCL="P":" PAID",1:"VOLUNTEER")
13 .D PATNAME^FHOMUTL
14 .S FHD=$$FMTE^XLFDT(FHGMDT,"P") W !,?2,$E(FHD,1,12)
15 .W ?16,$G(FHLOC),?30,FHML,?36,FHCL,?50,FHCH
16 .I $Y>(IOSL-4) D PG I EX=U Q
17 .Q
18 I NUM=0 W !!,"NO GUEST MEALS FOR THIS DATE RANGE" Q
19 Q
20END ;
21 K FHGMDT,FHML,FHCL,FHCH
22 Q
23PG ;
24 Q:$O(^FHPT(FHDFN,"GM",FHGMDT))'>0
25 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
26 D HDR Q
27HDR ;
28 W:$Y @IOF
29 W !?15,"G U E S T M E A L S"
30 W !!?2,"Date",?16,"Location",?30,"Meal"
31 W ?36,"Class",?50,"Charge"
32 W !?2,"============",?16,"=========="
33 W ?30,"====",?36,"=========",?50,"======"
34 Q
Note: See TracBrowser for help on using the repository browser.