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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRC5 1007 printed Oct 16, 2024@17:55:10 Page 2
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
