- FHPRO7 ; HISC/REL - Print Recipes ;3/26/96 15:14
- ;;5.5;DIETETICS;**3**;Jan 28, 2005
- K N,R S K4="" F P0=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 D C0
- R0 F K1=0:0 S K1=$O(N(K1)) Q:K1<1 K N(K1) D R1
- G:$O(N(""))'="" R0
- F R1=0:0 S R1=$O(R(R1)) Q:R1="" I $G(^FH(114,R1,0))'="" D:$P(^FH(114,R1,0),"^",8)'="N" R3
- S NX="" F KK=0:0 S NX=$O(^TMP($J,"FH","R",NX)) Q:NX="" F R1=0:0 S R1=$O(^TMP($J,"FH","R",NX,R1)) Q:R1<1 S S1=R(R1) D EN1^FHREC2
- Q
- R1 F KK=0:0 S KK=$O(^FH(114,K1,"R",KK)) Q:KK<1 S Y=^(KK,0) D R2
- Q
- R2 S P1=R(K1),MUL=$P(^FH(114,K1,0),"^",2) Q:'MUL S MUL=P1/MUL
- S P1=$P(Y,"^",2)*MUL S:'$D(R(+Y)) R(+Y)=0 S R(+Y)=R(+Y)+P1 Q
- R3 S X=$G(^FH(114,R1,0)),K4=$P(X,"^",12),K4=$S($D(^FH(114.2,+K4,0)):$P(^(0),"^",3),1:99)
- S K4="A"_$S(K4<10:"0"_K4,1:K4)_$E($P(X,"^",1),1,27),^TMP($J,"FH","R",K4,R1)="" Q
- C0 S:'$D(R(L1)) R(L1)=0 S R(L1)=R(L1)+^TMP($J,"FH","T",K4,L1),N(L1)="" Q
- ;
- ;PROCESS Advance Food Prep
- P3 S TIMAFPML=""
- S FHPREASA="",FHIFLG=0
- S K4="",PG=0 F S K4=$O(^TMP($J,"AFP","T",K4)) Q:K4="" F K0=0:0 S K0=$O(^TMP($J,"AFP","T",K4,K0)) Q:K0'>0 S FHIFLG=1 D P3P
- Q
- P3P S X0=$G(^FH(114,K0,0)),MUL=$P(X0,"^",2) Q:'MUL S P1=^TMP($J,"AFP","T",K4,K0),MUL=P1/MUL
- S FHPREA="MISCELLANEOUS"
- S S1=$P(X0,"^",12) I S1 S FHPREA=$P($G(^FH(114.2,S1,0)),"^",1),S1=$P($G(^FH(114.2,S1,0)),"^",3)
- S FHUNAM=""
- S FHUTEN=$P(X0,"^",6) S:FHUTEN FHUNAM=$G(^FH(114.3,FHUTEN,0))
- S FHPOSI=$P(X0,"^",3)
- S S1=$S(S1<1:99,S1<10:"0"_S1,1:S1)_$E($P(X0,"^",1),1,28)
- K ^TMP($J,"FH")
- S ^TMP($J,"FH","I",S1,K0)=0 S ^(K0)=^(K0)+P1
- F KK=0:0 S KK=$O(^FH(114,K0,"I",KK)) Q:KK<1 S Y=^(KK,0) D P4
- F KK=0:0 S KK=$O(^FH(114,K0,"R",KK)) Q:KK<1 S Y=^(KK,0) D P6
- D Q2
- Q
- P4 S X1=+Y,Q=$P(Y,"^",2)*MUL
- S Y0=$G(^FHING(X1,0))
- S S2=$P(Y0,"^",12) S:S2 S2=$P($G(^FH(113.1,S2,0)),"^",3)
- S S2=$S(S2<1:99,S2<10:"0"_S2,1:S2)_$E($P(Y0,"^",1),1,28)
- S:'$D(^TMP($J,"FH","I",S1,K0,S2,X1)) ^TMP($J,"FH","I",S1,K0,S2,X1)=0 S ^(X1)=^(X1)+Q
- P5 ;
- S:'$D(^TMP($J,"FH","S",S2,X1,S1,K0)) ^TMP($J,"FH","S",S2,X1,S1,K0)=0 S ^(K0)=^(K0)+Q Q
- P6 S P1=$P(Y,"^",2)*MUL S:'$D(R(+Y)) R(+Y)=0 S R(+Y)=R(+Y)+P1 Q
- ;
- Q2 ; Print AFP
- S OLD="",R1="" I PG=0 D HDR
- S1 S R1=$O(^TMP($J,"FH","I",R1)) I R1="" W ! Q
- F K11=0:0 S K11=$O(^TMP($J,"FH","I",R1,K11)) Q:K11<1 S TOT=^(K11),FLG=0,R2="",X0=^FH(114,K11,0) D S2
- G S1
- S2 ;I $P(FHPAR,"^",4)="Y",OLD'=$E(R1,1,2) S OLD=$E(R1,1,2),PG=0 D HDR
- S3 S R2=$O(^TMP($J,"FH","I",R1,K11,R2)) Q:R2=""
- F X1=0:0 S X1=$O(^TMP($J,"FH","I",R1,K11,R2,X1)) Q:X1<1 D S4
- G S3
- S4 D:$Y>(IOSL-7) HDR W ! G:FLG S5 D:(FHPREASA'=FHPREA) HDR W !,$E($P(X0,"^",1),1,22) S FLG=1
- ;I $P(FHPAR,"^",4)'="Y"
- S Z=$P(X0,"^",12) S:Z Z=$P(^FH(114.2,Z,0),"^",2) W:Z'="" " (",Z,")"
- W ?30,FHPOSI
- S5 S (Y,I1)=^TMP($J,"FH","I",R1,K11,R2,X1)
- S Y(0)=$G(^FHING(X1,0)),UNT=$P(Y(0),"^",16) D EN2^FHREC1
- W ?40,$E($P(Y(0),"^",1),1,42)
- S FHYQU=$P(Y," ",1),FHYQUNA=$E(Y,$L(FHYQU)+1,$L(Y))
- W ?84,$J(FHYQU,6,0),?90,FHYQUNA S I2=$P(Y(0),"^",17) Q:'I2 S I1=I1/I2 Q:'I1
- S I1=+$J(I1,0,1)
- S I1=$S($L(I1)=1:" "_I1,$L(I1)=2:" "_I1,$L(I1)=3:" "_I1,$L(I1)=4:" "_I1,$L(I1)=5:" "_I1,$L(I1)=6:" "_I1,1:I1)
- W ?108,I1,?116,$P(Y(0),"^",6)
- I $G(FHIFLG) W ?126,$J(TOT,5,0) S FHIFLG=0
- Q
- B0 S LAB=$P(FHPAR,"^",10),R2=LAB=2*5+32
- F KK=0:0 S KK=$O(^TMP($J,"FH","I",KK)) Q:KK<1 F K12=0:0 S K12=$O(^TMP($J,"FH","I",KK,K12)) Q:K12<1 D B1
- F X1=1:1:18 W !
- Q
- B1 F X1=0:0 S X1=$O(^TMP($J,"FH","I",KK,K12,X1)) Q:X1<1 S (Y,I1)=^(X1) D B2
- Q
- B2 S Y(0)=^FHING(X1,0),UNT=$P(Y(0),"^",16) D EN2^FHREC1
- S I2=$P(Y(0),"^",17) Q:'I2 S I1=I1/I2
- S I1=$S(I1<1:1,I1#1<.1:I1\1,1:I1+.9\1)
- W !,$E($P(Y(0),"^",1),1,R2),!!,I1," ",$P(Y(0),"^",6),!!,$E($P(^FH(114,K12,0),"^",1),1,R2),! Q
- HDR S PG=PG+1 W @IOF,!,DTP,?48,"Advance Food Prep (Grand Total)",?125,"Page ",PG
- W !,FHRETYP,?(131-$L(FHP6)),FHP6
- ;W ! D:$P(FHPAR,"^",4)="Y" PRE
- W !,FHPREA S FHPREASA=FHPREA
- W ?(132-$L(TIMAFP)\2),TIMAFP
- W !!,"Recipe",?30,"Portion",?40,"Ingredient",?88,"Quantity",?108,"Storeroom Amount",?126,"Total"
- W ! F K=1:1:131 W "-"
- Q
- PRE S K=$P(X0,"^",12) S:K K=$P($G(^FH(114.2,K,0)),"^",1)
- W:K'="" K Q
- ;
- AAR ;prints AFP Adjusted Recipes
- ;
- K N,R S K4="" F P0=0:0 S K4=$O(^TMP($J,"AFP","T",K4)) Q:K4="" F L1=0:0 S L1=$O(^TMP($J,"AFP","T",K4,L1)) Q:L1<1 D AC0
- AR0 F K1=0:0 S K1=$O(N(K1)) Q:K1<1 K N(K1) D AR1
- G:$O(N(""))'="" AR0
- F R1=0:0 S R1=$O(R(R1)) Q:R1="" I $G(^FH(114,R1,0))'="" D:$P(^FH(114,R1,0),"^",8)'="N" AR3
- S NX="" F KK=0:0 S NX=$O(^TMP($J,"FH","R",NX)) Q:NX="" F R1=0:0 S R1=$O(^TMP($J,"FH","R",NX,R1)) Q:R1<1 S S1=R(R1) D AEN1
- Q
- AR1 F KK=0:0 S KK=$O(^FH(114,K1,"R",KK)) Q:KK<1 S Y=^(KK,0) D AR2
- Q
- AR2 S P1=R(K1),MUL=$P(^FH(114,K1,0),"^",2) Q:'MUL S MUL=P1/MUL
- S P1=$P(Y,"^",2)*MUL S:'$D(R(+Y)) R(+Y)=0 S R(+Y)=R(+Y)+P1 Q
- AR3 S X=$G(^FH(114,R1,0)),K4=$P(X,"^",12),K4=$S($D(^FH(114.2,+K4,0)):$P(^(0),"^",3),1:99)
- S K4="A"_$S(K4<10:"0"_K4,1:K4)_$E($P(X,"^",1),1,27),^TMP($J,"FH","R",K4,R1)="" Q
- AC0 S:'$D(R(L1)) R(L1)=0 S R(L1)=R(L1)+^TMP($J,"AFP","T",K4,L1),N(L1)="" Q
- ;
- AEN1 ; Adjust Recipe - R1 = Recipe File No., S1 = No. Portions
- S R0=^FH(114,R1,0),P1=$P(R0,"^",2) Q:P1<1!(S1<1)
- D DISP D LN S N=0,MUL=S1/P1 W !
- AN1 S N=$O(^FH(114,R1,"I",N)) G:N<1 AN2 S X=^(N,0),I2=+$P(X,"^",1),Y=$P(X,"^",2)*MUL
- S Y(0)=$G(^FHING(I2,0)),UNT=$P(Y(0),"^",16) D EN2^FHREC1
- W !!,$P(Y(0),"^",1),?60,Y G AN1
- AN2 F K=0:0 S K=$O(^FH(114,R1,"R",K)) Q:K<1 S Y(0)=^(K,0) I +Y(0) W !!,"*",$P(^FH(114,+Y(0),0),"^",1),?60,$J(MUL*$P(Y(0),"^",2),0,0)," Portions"
- D LN W ! F K=0:0 S K=$O(^FH(114,R1,"X",K)) Q:K<1 W !,^(K,0)
- D LN W ! Q:$G(^FH(114,R1,"DBX",0))=""
- S P="" W !,"Diabetic Exchange: "
- F K=0:0 S K=$O(^FH(114,R1,"DBX",K)) Q:K<1 S Z=^(K,0) S:P'="" P=P_", " S Z1=$S($P(Z,"^",2):$P(Z,"^",2),1:1)_" "_$P($G(^FH(114.1,+Z,0)),"^",1) D:$L(P)+$L(Z1)'<60 EX S P=P_Z1
- W:P'="" ?19,P,!
- D LN W ! Q
- EX W ?19,P S P="" W !
- Q
- DISP W @IOF W !?20,"A F P A D J U S T E D R E C I P E S",?71,$E(DTP,1,9)
- S N=$P(R0,"^",1) W !!?(80-$L(N)\2),N
- W !!,"Portion Size: ",$P(R0,"^",3),?40,"No. Portions: ",S1
- W !,"Prep. Time: ",$P(R0,"^",4),?40,"Srv. Utensil: " S Z=$P(R0,"^",6) I Z W $P(^FH(114.3,Z,0),"^",1)
- W !,"Equipment: " S N=$O(^FH(114,R1,"E",0)) I N>0 S Z=^(N,0) W $P(^FH(114.4,Z,0),"^",1)
- W ?40,"Category: " S Z=$P(R0,"^",7) I Z W $P(^FH(114.1,Z,0),"^",1)
- I N>0 F N=N:0 S N=$O(^FH(114,R1,"E",N)) Q:N<1 S Z=^(N,0) W !?14,$P(^FH(114.4,Z,0),"^",1)
- Q
- LN W !!,"- - - - - - - - - - - - - - - - - - - - - - - - - - -" Q
- AEN2 ; Print adjusted recipe
- BR1 ; Entry Point to Print adjusted recipe
- K R F K1=0:0 S K1=$O(^FH(114,R1,"R",K1)) Q:K1<1 S Y=^(K1,0) D BR2
- S PG=0 D AEN1 S PG=1
- F R1=0:0 S R1=$O(R(R1)) Q:R1="" S S1=R(R1) D AEN1
- Q
- BR2 S MUL=$P(^FH(114,R1,0),"^",2) Q:'MUL S MUL=S1/MUL
- S P1=$P(Y,"^",2)*MUL S:'$D(R(+Y)) R(+Y)=0 S R(+Y)=R(+Y)+P1
- Q
- KIL G KILL^XUSCLEAN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRO7 6924 printed Feb 18, 2025@23:21:03 Page 2
- FHPRO7 ; HISC/REL - Print Recipes ;3/26/96 15:14
- +1 ;;5.5;DIETETICS;**3**;Jan 28, 2005
- +2 KILL N,R
- SET K4=""
- FOR P0=0:0
- SET K4=$ORDER(^TMP($JOB,"FH","T",K4))
- if K4=""
- QUIT
- FOR L1=0:0
- SET L1=$ORDER(^TMP($JOB,"FH","T",K4,L1))
- if L1<1
- QUIT
- DO C0
- R0 FOR K1=0:0
- SET K1=$ORDER(N(K1))
- if K1<1
- QUIT
- KILL N(K1)
- DO R1
- +1 if $ORDER(N(""))'=""
- GOTO R0
- +2 FOR R1=0:0
- SET R1=$ORDER(R(R1))
- if R1=""
- QUIT
- IF $GET(^FH(114,R1,0))'=""
- if $PIECE(^FH(114,R1,0),"^",8)'="N"
- DO R3
- +3 SET NX=""
- FOR KK=0:0
- SET NX=$ORDER(^TMP($JOB,"FH","R",NX))
- if NX=""
- QUIT
- FOR R1=0:0
- SET R1=$ORDER(^TMP($JOB,"FH","R",NX,R1))
- if R1<1
- QUIT
- SET S1=R(R1)
- DO EN1^FHREC2
- +4 QUIT
- R1 FOR KK=0:0
- SET KK=$ORDER(^FH(114,K1,"R",KK))
- if KK<1
- QUIT
- SET Y=^(KK,0)
- DO R2
- +1 QUIT
- R2 SET P1=R(K1)
- SET MUL=$PIECE(^FH(114,K1,0),"^",2)
- if 'MUL
- QUIT
- SET MUL=P1/MUL
- +1 SET P1=$PIECE(Y,"^",2)*MUL
- if '$DATA(R(+Y))
- SET R(+Y)=0
- SET R(+Y)=R(+Y)+P1
- QUIT
- R3 SET X=$GET(^FH(114,R1,0))
- SET K4=$PIECE(X,"^",12)
- SET K4=$SELECT($DATA(^FH(114.2,+K4,0)):$PIECE(^(0),"^",3),1:99)
- +1 SET K4="A"_$SELECT(K4<10:"0"_K4,1:K4)_$EXTRACT($PIECE(X,"^",1),1,27)
- SET ^TMP($JOB,"FH","R",K4,R1)=""
- QUIT
- C0 if '$DATA(R(L1))
- SET R(L1)=0
- SET R(L1)=R(L1)+^TMP($JOB,"FH","T",K4,L1)
- SET N(L1)=""
- QUIT
- +1 ;
- +2 ;PROCESS Advance Food Prep
- P3 SET TIMAFPML=""
- +1 SET FHPREASA=""
- SET FHIFLG=0
- +2 SET K4=""
- SET PG=0
- FOR
- SET K4=$ORDER(^TMP($JOB,"AFP","T",K4))
- if K4=""
- QUIT
- FOR K0=0:0
- SET K0=$ORDER(^TMP($JOB,"AFP","T",K4,K0))
- if K0'>0
- QUIT
- SET FHIFLG=1
- DO P3P
- +3 QUIT
- P3P SET X0=$GET(^FH(114,K0,0))
- SET MUL=$PIECE(X0,"^",2)
- if 'MUL
- QUIT
- SET P1=^TMP($JOB,"AFP","T",K4,K0)
- SET MUL=P1/MUL
- +1 SET FHPREA="MISCELLANEOUS"
- +2 SET S1=$PIECE(X0,"^",12)
- IF S1
- SET FHPREA=$PIECE($GET(^FH(114.2,S1,0)),"^",1)
- SET S1=$PIECE($GET(^FH(114.2,S1,0)),"^",3)
- +3 SET FHUNAM=""
- +4 SET FHUTEN=$PIECE(X0,"^",6)
- if FHUTEN
- SET FHUNAM=$GET(^FH(114.3,FHUTEN,0))
- +5 SET FHPOSI=$PIECE(X0,"^",3)
- +6 SET S1=$SELECT(S1<1:99,S1<10:"0"_S1,1:S1)_$EXTRACT($PIECE(X0,"^",1),1,28)
- +7 KILL ^TMP($JOB,"FH")
- +8 SET ^TMP($JOB,"FH","I",S1,K0)=0
- SET ^(K0)=^(K0)+P1
- +9 FOR KK=0:0
- SET KK=$ORDER(^FH(114,K0,"I",KK))
- if KK<1
- QUIT
- SET Y=^(KK,0)
- DO P4
- +10 FOR KK=0:0
- SET KK=$ORDER(^FH(114,K0,"R",KK))
- if KK<1
- QUIT
- SET Y=^(KK,0)
- DO P6
- +11 DO Q2
- +12 QUIT
- P4 SET X1=+Y
- SET Q=$PIECE(Y,"^",2)*MUL
- +1 SET Y0=$GET(^FHING(X1,0))
- +2 SET S2=$PIECE(Y0,"^",12)
- if S2
- SET S2=$PIECE($GET(^FH(113.1,S2,0)),"^",3)
- +3 SET S2=$SELECT(S2<1:99,S2<10:"0"_S2,1:S2)_$EXTRACT($PIECE(Y0,"^",1),1,28)
- +4 if '$DATA(^TMP($JOB,"FH","I",S1,K0,S2,X1))
- SET ^TMP($JOB,"FH","I",S1,K0,S2,X1)=0
- SET ^(X1)=^(X1)+Q
- P5 ;
- +1 if '$DATA(^TMP($JOB,"FH","S",S2,X1,S1,K0))
- SET ^TMP($JOB,"FH","S",S2,X1,S1,K0)=0
- SET ^(K0)=^(K0)+Q
- QUIT
- P6 SET P1=$PIECE(Y,"^",2)*MUL
- if '$DATA(R(+Y))
- SET R(+Y)=0
- SET R(+Y)=R(+Y)+P1
- QUIT
- +1 ;
- Q2 ; Print AFP
- +1 SET OLD=""
- SET R1=""
- IF PG=0
- DO HDR
- S1 SET R1=$ORDER(^TMP($JOB,"FH","I",R1))
- IF R1=""
- WRITE !
- QUIT
- +1 FOR K11=0:0
- SET K11=$ORDER(^TMP($JOB,"FH","I",R1,K11))
- if K11<1
- QUIT
- SET TOT=^(K11)
- SET FLG=0
- SET R2=""
- SET X0=^FH(114,K11,0)
- DO S2
- +2 GOTO S1
- S2 ;I $P(FHPAR,"^",4)="Y",OLD'=$E(R1,1,2) S OLD=$E(R1,1,2),PG=0 D HDR
- S3 SET R2=$ORDER(^TMP($JOB,"FH","I",R1,K11,R2))
- if R2=""
- QUIT
- +1 FOR X1=0:0
- SET X1=$ORDER(^TMP($JOB,"FH","I",R1,K11,R2,X1))
- if X1<1
- QUIT
- DO S4
- +2 GOTO S3
- S4 if $Y>(IOSL-7)
- DO HDR
- WRITE !
- if FLG
- GOTO S5
- if (FHPREASA'=FHPREA)
- DO HDR
- WRITE !,$EXTRACT($PIECE(X0,"^",1),1,22)
- SET FLG=1
- +1 ;I $P(FHPAR,"^",4)'="Y"
- +2 SET Z=$PIECE(X0,"^",12)
- if Z
- SET Z=$PIECE(^FH(114.2,Z,0),"^",2)
- if Z'=""
- WRITE " (",Z,")"
- +3 WRITE ?30,FHPOSI
- S5 SET (Y,I1)=^TMP($JOB,"FH","I",R1,K11,R2,X1)
- +1 SET Y(0)=$GET(^FHING(X1,0))
- SET UNT=$PIECE(Y(0),"^",16)
- DO EN2^FHREC1
- +2 WRITE ?40,$EXTRACT($PIECE(Y(0),"^",1),1,42)
- +3 SET FHYQU=$PIECE(Y," ",1)
- SET FHYQUNA=$EXTRACT(Y,$LENGTH(FHYQU)+1,$LENGTH(Y))
- +4 WRITE ?84,$JUSTIFY(FHYQU,6,0),?90,FHYQUNA
- SET I2=$PIECE(Y(0),"^",17)
- if 'I2
- QUIT
- SET I1=I1/I2
- if 'I1
- QUIT
- +5 SET I1=+$JUSTIFY(I1,0,1)
- +6 SET I1=$SELECT($LENGTH(I1)=1:" "_I1,$LENGTH(I1)=2:" "_I1,$LENGTH(I1)=3:" "_I1,$LENGTH(I1)=4:" "_I1,$LENGTH(I1)=5:" "_I1,$LENGTH(I1)=6:" "_I1,1:I1)
- +7 WRITE ?108,I1,?116,$PIECE(Y(0),"^",6)
- +8 IF $GET(FHIFLG)
- WRITE ?126,$JUSTIFY(TOT,5,0)
- SET FHIFLG=0
- +9 QUIT
- B0 SET LAB=$PIECE(FHPAR,"^",10)
- SET R2=LAB=2*5+32
- +1 FOR KK=0:0
- SET KK=$ORDER(^TMP($JOB,"FH","I",KK))
- if KK<1
- QUIT
- FOR K12=0:0
- SET K12=$ORDER(^TMP($JOB,"FH","I",KK,K12))
- if K12<1
- QUIT
- DO B1
- +2 FOR X1=1:1:18
- WRITE !
- +3 QUIT
- B1 FOR X1=0:0
- SET X1=$ORDER(^TMP($JOB,"FH","I",KK,K12,X1))
- if X1<1
- QUIT
- SET (Y,I1)=^(X1)
- DO B2
- +1 QUIT
- B2 SET Y(0)=^FHING(X1,0)
- SET UNT=$PIECE(Y(0),"^",16)
- DO EN2^FHREC1
- +1 SET I2=$PIECE(Y(0),"^",17)
- if 'I2
- QUIT
- SET I1=I1/I2
- +2 SET I1=$SELECT(I1<1:1,I1#1<.1:I1\1,1:I1+.9\1)
- +3 WRITE !,$EXTRACT($PIECE(Y(0),"^",1),1,R2),!!,I1," ",$PIECE(Y(0),"^",6),!!,$EXTRACT($PIECE(^FH(114,K12,0),"^",1),1,R2),!
- QUIT
- HDR SET PG=PG+1
- WRITE @IOF,!,DTP,?48,"Advance Food Prep (Grand Total)",?125,"Page ",PG
- +1 WRITE !,FHRETYP,?(131-$LENGTH(FHP6)),FHP6
- +2 ;W ! D:$P(FHPAR,"^",4)="Y" PRE
- +3 WRITE !,FHPREA
- SET FHPREASA=FHPREA
- +4 WRITE ?(132-$LENGTH(TIMAFP)\2),TIMAFP
- +5 WRITE !!,"Recipe",?30,"Portion",?40,"Ingredient",?88,"Quantity",?108,"Storeroom Amount",?126,"Total"
- +6 WRITE !
- FOR K=1:1:131
- WRITE "-"
- +7 QUIT
- PRE SET K=$PIECE(X0,"^",12)
- if K
- SET K=$PIECE($GET(^FH(114.2,K,0)),"^",1)
- +1 if K'=""
- WRITE K
- QUIT
- +2 ;
- AAR ;prints AFP Adjusted Recipes
- +1 ;
- +2 KILL N,R
- SET K4=""
- FOR P0=0:0
- SET K4=$ORDER(^TMP($JOB,"AFP","T",K4))
- if K4=""
- QUIT
- FOR L1=0:0
- SET L1=$ORDER(^TMP($JOB,"AFP","T",K4,L1))
- if L1<1
- QUIT
- DO AC0
- AR0 FOR K1=0:0
- SET K1=$ORDER(N(K1))
- if K1<1
- QUIT
- KILL N(K1)
- DO AR1
- +1 if $ORDER(N(""))'=""
- GOTO AR0
- +2 FOR R1=0:0
- SET R1=$ORDER(R(R1))
- if R1=""
- QUIT
- IF $GET(^FH(114,R1,0))'=""
- if $PIECE(^FH(114,R1,0),"^",8)'="N"
- DO AR3
- +3 SET NX=""
- FOR KK=0:0
- SET NX=$ORDER(^TMP($JOB,"FH","R",NX))
- if NX=""
- QUIT
- FOR R1=0:0
- SET R1=$ORDER(^TMP($JOB,"FH","R",NX,R1))
- if R1<1
- QUIT
- SET S1=R(R1)
- DO AEN1
- +4 QUIT
- AR1 FOR KK=0:0
- SET KK=$ORDER(^FH(114,K1,"R",KK))
- if KK<1
- QUIT
- SET Y=^(KK,0)
- DO AR2
- +1 QUIT
- AR2 SET P1=R(K1)
- SET MUL=$PIECE(^FH(114,K1,0),"^",2)
- if 'MUL
- QUIT
- SET MUL=P1/MUL
- +1 SET P1=$PIECE(Y,"^",2)*MUL
- if '$DATA(R(+Y))
- SET R(+Y)=0
- SET R(+Y)=R(+Y)+P1
- QUIT
- AR3 SET X=$GET(^FH(114,R1,0))
- SET K4=$PIECE(X,"^",12)
- SET K4=$SELECT($DATA(^FH(114.2,+K4,0)):$PIECE(^(0),"^",3),1:99)
- +1 SET K4="A"_$SELECT(K4<10:"0"_K4,1:K4)_$EXTRACT($PIECE(X,"^",1),1,27)
- SET ^TMP($JOB,"FH","R",K4,R1)=""
- QUIT
- AC0 if '$DATA(R(L1))
- SET R(L1)=0
- SET R(L1)=R(L1)+^TMP($JOB,"AFP","T",K4,L1)
- SET N(L1)=""
- QUIT
- +1 ;
- AEN1 ; Adjust Recipe - R1 = Recipe File No., S1 = No. Portions
- +1 SET R0=^FH(114,R1,0)
- SET P1=$PIECE(R0,"^",2)
- if P1<1!(S1<1)
- QUIT
- +2 DO DISP
- DO LN
- SET N=0
- SET MUL=S1/P1
- WRITE !
- AN1 SET N=$ORDER(^FH(114,R1,"I",N))
- if N<1
- GOTO AN2
- SET X=^(N,0)
- SET I2=+$PIECE(X,"^",1)
- SET Y=$PIECE(X,"^",2)*MUL
- +1 SET Y(0)=$GET(^FHING(I2,0))
- SET UNT=$PIECE(Y(0),"^",16)
- DO EN2^FHREC1
- +2 WRITE !!,$PIECE(Y(0),"^",1),?60,Y
- GOTO AN1
- AN2 FOR K=0:0
- SET K=$ORDER(^FH(114,R1,"R",K))
- if K<1
- QUIT
- SET Y(0)=^(K,0)
- IF +Y(0)
- WRITE !!,"*",$PIECE(^FH(114,+Y(0),0),"^",1),?60,$JUSTIFY(MUL*$PIECE(Y(0),"^",2),0,0)," Portions"
- +1 DO LN
- WRITE !
- FOR K=0:0
- SET K=$ORDER(^FH(114,R1,"X",K))
- if K<1
- QUIT
- WRITE !,^(K,0)
- +2 DO LN
- WRITE !
- if $GET(^FH(114,R1,"DBX",0))=""
- QUIT
- +3 SET P=""
- WRITE !,"Diabetic Exchange: "
- +4 FOR K=0:0
- SET K=$ORDER(^FH(114,R1,"DBX",K))
- if K<1
- QUIT
- SET Z=^(K,0)
- if P'=""
- SET P=P_", "
- SET Z1=$SELECT($PIECE(Z,"^",2):$PIECE(Z,"^",2),1:1)_" "_$PIECE($GET(^FH(114.1,+Z,0)),"^",1)
- if $LENGTH(P)+$LENGTH(Z1)'<60
- DO EX
- SET P=P_Z1
- +5 if P'=""
- WRITE ?19,P,!
- +6 DO LN
- WRITE !
- QUIT
- EX WRITE ?19,P
- SET P=""
- WRITE !
- +1 QUIT
- DISP WRITE @IOF
- WRITE !?20,"A F P A D J U S T E D R E C I P E S",?71,$EXTRACT(DTP,1,9)
- +1 SET N=$PIECE(R0,"^",1)
- WRITE !!?(80-$LENGTH(N)\2),N
- +2 WRITE !!,"Portion Size: ",$PIECE(R0,"^",3),?40,"No. Portions: ",S1
- +3 WRITE !,"Prep. Time: ",$PIECE(R0,"^",4),?40,"Srv. Utensil: "
- SET Z=$PIECE(R0,"^",6)
- IF Z
- WRITE $PIECE(^FH(114.3,Z,0),"^",1)
- +4 WRITE !,"Equipment: "
- SET N=$ORDER(^FH(114,R1,"E",0))
- IF N>0
- SET Z=^(N,0)
- WRITE $PIECE(^FH(114.4,Z,0),"^",1)
- +5 WRITE ?40,"Category: "
- SET Z=$PIECE(R0,"^",7)
- IF Z
- WRITE $PIECE(^FH(114.1,Z,0),"^",1)
- +6 IF N>0
- FOR N=N:0
- SET N=$ORDER(^FH(114,R1,"E",N))
- if N<1
- QUIT
- SET Z=^(N,0)
- WRITE !?14,$PIECE(^FH(114.4,Z,0),"^",1)
- +7 QUIT
- LN WRITE !!,"- - - - - - - - - - - - - - - - - - - - - - - - - - -"
- QUIT
- AEN2 ; Print adjusted recipe
- BR1 ; Entry Point to Print adjusted recipe
- +1 KILL R
- FOR K1=0:0
- SET K1=$ORDER(^FH(114,R1,"R",K1))
- if K1<1
- QUIT
- SET Y=^(K1,0)
- DO BR2
- +2 SET PG=0
- DO AEN1
- SET PG=1
- +3 FOR R1=0:0
- SET R1=$ORDER(R(R1))
- if R1=""
- QUIT
- SET S1=R(R1)
- DO AEN1
- +4 QUIT
- BR2 SET MUL=$PIECE(^FH(114,R1,0),"^",2)
- if 'MUL
- QUIT
- SET MUL=S1/MUL
- +1 SET P1=$PIECE(Y,"^",2)*MUL
- if '$DATA(R(+Y))
- SET R(+Y)=0
- SET R(+Y)=R(+Y)+P1
- +2 QUIT
- KIL GOTO KILL^XUSCLEAN