- 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 Mar 13, 2025@20:58:58 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
