source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHPRO5.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1FHPRO5 ; HISC/REL - Recipe Preparation ;7/18/94 16:39
2 ;;5.5;DIETETICS;**3**;Jan 28, 2005
3 ;RVD 5/23/05 0 - as part of AFP project.
4 I FHP3="Y"!(FHP4="Y") D Q1 D:FHP3="Y" Q2 D:FHP4="Y" ^FHPRO6
5 D:FHP5="Y" ^FHPRO7 Q
6Q1 ; Set-up Recipe Prep and Storeroom scratch global
7 K R S K4="" F K=0:0 S K4=$O(^TMP($J,"FH","T",K4)) Q:K4="" F L1=0:0 S L1=$O(^TMP($J,"FH","T",K4,L1)) Q:L1<1 S:'$D(R(L1)) R(L1)=0 S R(L1)=R(L1)+^(L1)
8G1 F K1=0:0 S K1=$O(R(K1)) Q:K1<1 D P3
9 G:$O(R(""))'="" G1
10 Q
11P3 S X0=$G(^FH(114,K1,0)),P1=R(K1),MUL=$P(X0,"^",2) K R(K1) Q:'MUL S MUL=P1/MUL
12 S S1=$P(X0,"^",12) S:S1 S1=$P($G(^FH(114.2,S1,0)),"^",3)
13 S S1=$S(S1<1:99,S1<10:"0"_S1,1:S1)_$E($P(X0,"^",1),1,28)
14 I FHP3="Y" S:$D(^TMP($J,"FH","I",S1,K1))#2=0 ^TMP($J,"FH","I",S1,K1)=0 S ^(K1)=^(K1)+P1
15 F KK=0:0 S KK=$O(^FH(114,K1,"I",KK)) Q:KK<1 S Y=^(KK,0) D P4
16 F KK=0:0 S KK=$O(^FH(114,K1,"R",KK)) Q:KK<1 S Y=^(KK,0) D P6
17 Q
18P4 S X1=+Y,Q=$P(Y,"^",2)*MUL
19 S Y0=$G(^FHING(X1,0))
20 S S2=$P(Y0,"^",12) S:S2 S2=$P($G(^FH(113.1,S2,0)),"^",3)
21 S S2=$S(S2<1:99,S2<10:"0"_S2,1:S2)_$E($P(Y0,"^",1),1,28) G:FHP3'="Y" P5
22 S:'$D(^TMP($J,"FH","I",S1,K1,S2,X1)) ^TMP($J,"FH","I",S1,K1,S2,X1)=0 S ^(X1)=^(X1)+Q
23P5 Q:FHP4'="Y"
24 S:'$D(^TMP($J,"FH","S",S2,X1,S1,K1)) ^TMP($J,"FH","S",S2,X1,S1,K1)=0 S ^(K1)=^(K1)+Q Q
25P6 S P1=$P(Y,"^",2)*MUL S:'$D(R(+Y)) R(+Y)=0 S R(+Y)=R(+Y)+P1 Q
26Q2 ; Print Recipe Preparation
27 S OLD="",R1="" I $P(FHPAR,"^",4)'="Y" S PG=0 D HDR
28S1 S R1=$O(^TMP($J,"FH","I",R1)) I R1="" W ! Q
29 F K1=0:0 S K1=$O(^TMP($J,"FH","I",R1,K1)) Q:K1<1 S TOT=^(K1),FLG=0,R2="",X0=^FH(114,K1,0) D S2
30 G S1
31S2 I $P(FHPAR,"^",4)="Y",OLD'=$E(R1,1,2) S OLD=$E(R1,1,2),PG=0 D HDR
32S3 S R2=$O(^TMP($J,"FH","I",R1,K1,R2)) Q:R2=""
33 F X1=0:0 S X1=$O(^TMP($J,"FH","I",R1,K1,R2,X1)) Q:X1<1 D S4
34 G S3
35S4 D:$Y>(IOSL-7) HDR W ! G:FLG S5 W !,$P(X0,"^",1) S FLG=1
36 I $P(FHPAR,"^",4)'="Y" S Z=$P(X0,"^",12) S:Z Z=$P(^FH(114.2,Z,0),"^",2) W:Z'="" " (",Z,")"
37 W ?39,$J(TOT,5,0)
38S5 S (Y,I1)=^TMP($J,"FH","I",R1,K1,R2,X1)
39 S Y(0)=$G(^FHING(X1,0)),UNT=$P(Y(0),"^",16) D EN2^FHREC1
40 W ?46,$E($P(Y(0),"^",1),1,42),?90,Y S I2=$P(Y(0),"^",17) Q:'I2 S I1=I1/I2 Q:'I1
41 S I1=+$J(I1,0,1) W ?113,I1," ",$P(Y(0),"^",6) Q
42B0 S LAB=$P(FHPAR,"^",10),R2=LAB=2*5+32
43 F KK=0:0 S KK=$O(^TMP($J,"FH","I",KK)) Q:KK<1 F K1=0:0 S K1=$O(^TMP($J,"FH","I",KK,K1)) Q:K1<1 D B1
44 F X1=1:1:18 W !
45 Q
46B1 F X1=0:0 S X1=$O(^TMP($J,"FH","I",KK,K1,X1)) Q:X1<1 S (Y,I1)=^(X1) D B2
47 Q
48B2 S Y(0)=^FHING(X1,0),UNT=$P(Y(0),"^",16) D EN2^FHREC1
49 S I2=$P(Y(0),"^",17) Q:'I2 S I1=I1/I2
50 S I1=$S(I1<1:1,I1#1<.1:I1\1,1:I1+.9\1)
51 W !,$E($P(Y(0),"^",1),1,R2),!!,I1," ",$P(Y(0),"^",6),!!,$E($P(^FH(114,K1,0),"^",1),1,R2),! Q
52HDR S PG=PG+1 W @IOF,!,DTP,?48,"R E C I P E P R E P A R A T I O N",?125,"Page ",PG
53 W !,FHRETYP,?(131-$L(FHP6)),FHP6
54 W ! D:$P(FHPAR,"^",4)="Y" PRE W ?(132-$L(TIM)\2),TIM
55 W !!,"Recipe",?40,"Port. Ingredient",?90,"Quantity",?113,"Storeroom Amount"
56 W ! F K=1:1:131 W "-"
57 Q
58PRE S K=$P(X0,"^",12) S:K K=$P($G(^FH(114.2,K,0)),"^",1)
59 W:K'="" K Q
Note: See TracBrowser for help on using the repository browser.