FHDPGM.m

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

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