| 1 | FHPRC8 ; HISC/REL - Print Daily Diet Menus ;1/23/98 16:10
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | S FHP=$O(^FH(119.71,0)) I FHP'<1,$O(^FH(119.71,FHP))<1 G F1
|
|---|
| 4 | F0 R !!,"Select PRODUCTION FACILITY: ",X:DTIME G:'$T!("^"[X) KIL
|
|---|
| 5 | K DIC S DIC="^FH(119.71,",DIC(0)="EMQ" D ^DIC G:Y<1 F0 S FHP=+Y
|
|---|
| 6 | F1 S %DT("A")="Select Date: ",%DT="AEX" W ! D ^%DT G:"^"[X!$D(DTOUT) KIL G:Y<1 F1 S D1=+Y
|
|---|
| 7 | L0 W !!,"The Menu requires a 132 compressed printer.",!
|
|---|
| 8 | W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
|
|---|
| 9 | I $D(IO("Q")) S FHPGM="Q1^FHPRC8",FHLST="D1^FHP" D EN2^FH G F1
|
|---|
| 10 | U IO D Q1 D ^%ZISC K %ZIS,IOP G F1
|
|---|
| 11 | Q1 ; Print the Daily Menu
|
|---|
| 12 | D ^FHDEV S X=220 X ^%ZOSF("RM") K ^TMP($J) S X1=D1 D SET
|
|---|
| 13 | Q:'$D(^TMP($J)) D NOW^%DTC S NOW=%,PG=0,DTP=D1 D DTP^FH S DTE=DTP,DTP=NOW D DTP^FH
|
|---|
| 14 | S X=D1 D DOW^%DTC S DTE=$P("Sun^Mon^Tues^Wednes^Thurs^Fri^Satur","^",Y+1)_"day "_DTE
|
|---|
| 15 | S TYP=$P($G(^FH(119.71,FHP,0)),"^",2) W @FHIO("P16") D PRT W @FHIO("P10") Q
|
|---|
| 16 | SET D E1^FHPRC1 S X2="" I FHCY>0,$D(^FH(116,FHCY,"DA",FHDA,0)) S X2=^(0)
|
|---|
| 17 | I $D(^FH(116.3,D1,0)) S X=^(0) F K3=2:1:4 I $P(X,"^",K3) S $P(X2,"^",K3)=$P(X,"^",K3)
|
|---|
| 18 | S RG=$P(^FH(116.2,1,0),"^",2)
|
|---|
| 19 | K M,M1 F K=0:0 S K=$O(^FH(116.2,K)) Q:K<1 S X=^(K,0),PD=$P(X,"^",2) I PD'="",K=1!($P(X,"^",7)="Y") S K4=$P(X,"^",6),K4=$S(K4<1:99,K4<10:"0"_K4,1:K4) S M(PD)=K4_PD,M1(K4_PD)=K
|
|---|
| 20 | S REG=M(RG)
|
|---|
| 21 | F K3=1:1:3 S X=$P(X2,"^",K3+1) I X D S1
|
|---|
| 22 | K M Q
|
|---|
| 23 | S1 K ^TMP($J,"R") F P1=0:0 S P1=$O(^FH(116.1,X,"RE",P1)) Q:P1<1 S Y0=^(P1,0) D S2
|
|---|
| 24 | S P1=0,NX="" F K=0:0 S NX=$O(^TMP($J,"R",NX)) Q:NX="" S X=^(NX) D S3
|
|---|
| 25 | K Y,Y0 Q
|
|---|
| 26 | S2 S L1=+Y0,Y=$G(^FH(114,L1,0)) Q:Y=""
|
|---|
| 27 | F CAT=0:0 S CAT=$O(^FH(116.1,X,"RE",P1,"R",CAT)) Q:CAT<1 S MCA=^(CAT,0) D
|
|---|
| 28 | .S K4=+MCA,K4=$P($G(^FH(114.1,+K4,0)),"^",3)
|
|---|
| 29 | .S K4=$S(K4<1:99,K4<10:"0"_K4,1:K4)_+MCA
|
|---|
| 30 | .S ^TMP($J,"R","A"_K4_$P(Y,"^",1))=$P(Y,"^",1)_"^"_$P(MCA,"^",2)_"^"_$P(Y,"^",3) Q
|
|---|
| 31 | Q
|
|---|
| 32 | S3 S L1=$P(X,"^",1),X1=$P(X,"^",2),P1=P1+1
|
|---|
| 33 | S P0=0 I X1[RG S:'$D(^TMP($J,"X",K3,REG,0)) ^TMP($J,"X",K3,REG,0)=0 S P0=^(0)+1,^(0)=P0,^TMP($J,"X",K3,REG,P0)=L1_"^"_$P(X,"^",3)
|
|---|
| 34 | F K4=1:1 S Z=$E($P(X1," ",K4),1,2) Q:Z="" I Z'=RG S Z=$S($D(M(Z)):M(Z),1:"") I Z'="" S:'$D(^TMP($J,"X",K3,Z,0)) ^TMP($J,"X",K3,Z,0)=0 S P2=^(0)+1,^(0)=P2,^TMP($J,"X",K3,Z,P2)=L1_"^"_P0
|
|---|
| 35 | Q
|
|---|
| 36 | PRT K M2 S N1=0,NX="" F K=0:0 S NX=$O(M1(NX)) Q:NX="" I NX'=REG S N1=N1+1,M2(N1)=NX
|
|---|
| 37 | S L2=0
|
|---|
| 38 | P0 Q:L2=N1 S L1=L2+1,L2=L1+4 S:L2>N1 L2=N1 D HDR F K3=1:1:3 S P1=0 D P1
|
|---|
| 39 | W ! G P0
|
|---|
| 40 | P1 S P1=P1+1,C=0,Y="|",NX="" S X=$G(^TMP($J,"X",K3,REG,P1)) S:X'="" C=1 S:X'=""&(TYP'="Y") X=$J(P1,2)_" "_X S Y=Y_" "_$E($P(X,"^",1)_$J("",30),1,30)_" | "_$E($P(X,"^",2)_$J("",15),1,15)_" |"
|
|---|
| 41 | F K4=L1:1:L2 S NX=M2(K4),X="",P2=0 S:$D(^TMP($J,"X",K3,NX,P1)) X=^(P1),P2=$P(X,"^",2),X=$P(X,"^",1),C=1 S:P2&(TYP'="Y") X=P2 S Y=Y_" "_$E(X_$J("",30),1,30)_" |"
|
|---|
| 42 | I C W !,Y G P1
|
|---|
| 43 | W !,LN Q
|
|---|
| 44 | HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !,DTP,?90,"D A I L Y D I E T M E N U S",?210,"Page ",PG,!!?(216-$L(DTE)\2),DTE
|
|---|
| 45 | W !!?2,"REGULAR",?35,"Portion Size" S KK=20 F K4=L1:1:L2 S NX=$E(M2(K4),3,4),NX=$O(^FH(116.2,"C",NX,0)),X=$P($G(^FH(116.2,+NX,0)),"^",1) S KK=KK+33 W ?KK,$E(X,1,30)
|
|---|
| 46 | S LN="",$P(LN,"-",L2-L1+1*33+53)="" W !,LN Q
|
|---|
| 47 | KIL K ^TMP($J) G KILL^XUSCLEAN
|
|---|
