source: FOIAVistA/trunk/r/DIETETICS-FH/FHPRO4A.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1FHPRO4A ; HISC/REL/RVD - Meal Distribution Report ;7/7/94 09:18
2 ;;5.5;DIETETICS;**3**;Jan 28, 2005
3 ;RVD 5/23/05 - as part of AFP project.
4Q1 D SES S P0=0,OLD="" I $P(FHPAR,"^",7)'="Y" S PG=0 D HDR1
5 S K4="" F LL=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 N1=^(L1),Y0=^FH(114,L1,0) D S1
6 K P D HDR2 Q
7S1 I $P(FHPAR,"^",7)="Y",OLD'=$E(K4,1,2) S OLD=$E(K4,1,2),PG=0 D HDR1
8 D:$Y>(IOSL-6) HDR1 S P=$P(Y0,"^",3) W !!,$P(Y0,"^",1)
9 I $P(FHPAR,"^",7)'="Y" S Z=$P(Y0,"^",12) S:Z Z=$P(^FH(114.2,Z,0),"^",2) W:Z'="" " (",Z,")"
10 W ?40,P K Q S P=$P(P," ",1),UNT=$S(P["EA":"EACH",P["FL":"GAL",1:"LB"),TOT=0
11 S LL=41 F K=1:1:N S P0=P(K),N1=$G(^TMP($J,"FH","T",K4,L1,P0)),LL=LL+11 I N1 W ?LL,N1," por" S Q(K)=N1,TOT=TOT+N1
12 W ?S2,TOT," por",!
13 S LL=41 F K=1:1:N S LL=LL+11 I $G(Q(K)) S Y=P*Q(K) D UNT W ?LL,Y
14 S Y=P*TOT D UNT W ?S2,Y Q
15UNT I UNT="EACH" S Y=$J(Y+.999\1,0,0)_" EA" Q
16 I UNT="LB" S P1=Y/16,U1="#" G:P1>.125 U1 S Y=P1*16+.5\1,U1="OZ" G U2
17 S P1=Y/128 F P0=1:1:5 S Z=$P("1,4,8,16,128",",",P0) Q:(P1*Z)>.875
18 S U1=$P("GL QT PT CP OZ"," ",P0),P1=Z*P1
19U1 S Y="" S:P1#1>.875 P1=P1+1\1 S:P1'<1 Y=P1\1,P1=P1#1
20 I P1>.125 S:Y'="" Y=Y_"-" S Y=Y_$S(P1<.375:"1/4",P1<.625:"1/2",1:"3/4")
21U2 S Y=Y_" "_U1 Q
22SES K N,P,S S PD="",N=0
23 F P0=0:0 S P0=$O(^TMP($J,"FH",P0)) Q:P0<1 S Y=$P(^FH(119.72,P0,0),"^",4) S:Y="" Y=$E($P(^(0),"^",1),1,6) S S(Y_"~"_P0)=""
24 S Y="" F S Y=$O(S(Y)) Q:Y="" S N=N+1,P(N)=$P(Y,"~",2),PD=PD_$J($P(Y,"~",1),6)_" "
25 K S S S2=52+$L(PD),S1=S2+8 S:S1<73 S1=73 Q
26HDR1 S PG=PG+1 W @IOF,!,DTP,?(S1-35\2),"M E A L D I S T R I B U T I O N R E P O R T",?(S1-6),"Page ",PG
27 W !,FHRETYP,?(S1-$L(FHP6)),FHP6
28 W ! D:$P(FHPAR,"^",7)="Y" PRE W ?(S1-$L(TIM)\2),TIM
29 W !!,"Recipe",?40,"Portion",?52,PD," TOTAL"
30 S LN="",$P(LN,"-",S1+1)="" W !,LN Q
31PRE S Z=$P(Y0,"^",12) S:Z Z=$P($G(^FH(114.2,Z,0)),"^",1)
32 W:Z'="" Z Q
33HDR2 W !!!,"*** Note: Does NOT include add-ons and specials!",! Q
Note: See TracBrowser for help on using the repository browser.