FHPRC5.m

FHPRC5 ; HISC/REL - List Menu Cycle ;4/27/93  13:44 

 ;;5.5;DIETETICS;;Jan 28, 2005

 S DIC="^FH(116,",DIC(0)="AEQM" W ! D ^DIC K DIC G KIL:"^"[X!$D(DTOUT),FHPRC5:Y<1

 S FHCY=+Y

 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL

 I $D(IO("Q")) S FHPGM="Q1^FHPRC5",FHLST="FHCY" D EN2^FH G KIL

 U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL

Q1 ; List the Menu Cycle

 D NOW^%DTC S NOW=%,N=$P($G(^FH(116,FHCY,0)),"^",2) Q:'N

 S PG=0 D HDR F K=1:1:N D Q2

 W ! Q

Q2 D:$Y>(IOSL-11) HDR S X=$G(^FH(116,FHCY,"DA",K,0)) W !,$J(K,3)

 S S1=-20 F L=2:1:4 S Z=$P(X,"^",L),S1=S1+25 I Z S Z=$P($G(^FH(116.1,Z,0)),"^",1) I Z'="" W ?S1,$E(Z,1,23)

 Q

HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1,DTP=NOW D DTP^FH W !,DTP,?30,"M E N U   C Y C L E",?73,"Page ",PG

 S Y=$P(^FH(116,FHCY,0),"^",1) W !!?(80-$L(Y)\2),Y

 W !!,"Day",?5,"Breakfast",?30,"Noon",?55,"Evening"

 W !,"-------------------------------------------------------------------------------",! Q

KIL G KILL^XUSCLEAN

FHPRC5    ; HISC/REL - List Menu Cycle ;4/27/93  13:44 

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

 +2        SET DIC="^FH(116,"

           SET DIC(0)="AEQM"

           WRITE !

           DO ^DIC

           KILL DIC

           IF "^"[X!$DATA(DTOUT)

               GOTO KIL

           IF Y<1

               GOTO FHPRC5

 +3        SET FHCY=+Y

 +4        WRITE !

           KILL IOP,%ZIS

           SET %ZIS("A")="Select LIST Printer: "

           SET %ZIS="MQ"

           DO ^%ZIS

           KILL %ZIS,IOP

           IF POP

               GOTO KIL

 +5        IF $DATA(IO("Q"))

               SET FHPGM="Q1^FHPRC5"

               SET FHLST="FHCY"

               DO EN2^FH

               GOTO KIL

 +6        USE IO

           DO Q1

           DO ^%ZISC

           KILL %ZIS,IOP

           GOTO KIL

Q1        ; List the Menu Cycle

 +1        DO NOW^%DTC

           SET NOW=%

           SET N=$PIECE($GET(^FH(116,FHCY,0)),"^",2)

           IF 'N

               QUIT 

 +2        SET PG=0

           DO HDR

           FOR K=1:1:N

               DO Q2

 +3        WRITE !

           QUIT 

Q2         IF $Y>(IOSL-11)

               DO HDR

           SET X=$GET(^FH(116,FHCY,"DA",K,0))

           WRITE !,$JUSTIFY(K,3)

 +1        SET S1=-20

           FOR L=2:1:4

               SET Z=$PIECE(X,"^",L)

               SET S1=S1+25

               IF Z

                   SET Z=$PIECE($GET(^FH(116.1,Z,0)),"^",1)

                   IF Z'=""

                       WRITE ?S1,$EXTRACT(Z,1,23)

 +2        QUIT 

HDR        IF '($EXTRACT(IOST,1,2)'="C-"&'PG)

               WRITE @IOF

           SET PG=PG+1

           SET DTP=NOW

           DO DTP^FH

           WRITE !,DTP,?30,"M E N U   C Y C L E",?73,"Page ",PG

 +1        SET Y=$PIECE(^FH(116,FHCY,0),"^",1)

           WRITE !!?(80-$LENGTH(Y)\2),Y

 +2        WRITE !!,"Day",?5,"Breakfast",?30,"Noon",?55,"Evening"

 +3        WRITE !,"-------------------------------------------------------------------------------",!

           QUIT 

KIL        GOTO KILL^XUSCLEAN