- FHPRO4A ; HISC/REL/RVD - Meal Distribution Report ;7/7/94 09:18
- ;;5.5;DIETETICS;**3**;Jan 28, 2005
- ;RVD 5/23/05 - as part of AFP project.
- Q1 D SES S P0=0,OLD="" I $P(FHPAR,"^",7)'="Y" S PG=0 D HDR1
- 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
- K P D HDR2 Q
- S1 I $P(FHPAR,"^",7)="Y",OLD'=$E(K4,1,2) S OLD=$E(K4,1,2),PG=0 D HDR1
- D:$Y>(IOSL-6) HDR1 S P=$P(Y0,"^",3) W !!,$P(Y0,"^",1)
- I $P(FHPAR,"^",7)'="Y" S Z=$P(Y0,"^",12) S:Z Z=$P(^FH(114.2,Z,0),"^",2) W:Z'="" " (",Z,")"
- W ?40,P K Q S P=$P(P," ",1),UNT=$S(P["EA":"EACH",P["FL":"GAL",1:"LB"),TOT=0
- 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
- W ?S2,TOT," por",!
- 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
- S Y=P*TOT D UNT W ?S2,Y Q
- UNT I UNT="EACH" S Y=$J(Y+.999\1,0,0)_" EA" Q
- I UNT="LB" S P1=Y/16,U1="#" G:P1>.125 U1 S Y=P1*16+.5\1,U1="OZ" G U2
- S P1=Y/128 F P0=1:1:5 S Z=$P("1,4,8,16,128",",",P0) Q:(P1*Z)>.875
- S U1=$P("GL QT PT CP OZ"," ",P0),P1=Z*P1
- U1 S Y="" S:P1#1>.875 P1=P1+1\1 S:P1'<1 Y=P1\1,P1=P1#1
- I P1>.125 S:Y'="" Y=Y_"-" S Y=Y_$S(P1<.375:"1/4",P1<.625:"1/2",1:"3/4")
- U2 S Y=Y_" "_U1 Q
- SES K N,P,S S PD="",N=0
- 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)=""
- 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)_" "
- K S S S2=52+$L(PD),S1=S2+8 S:S1<73 S1=73 Q
- HDR1 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
- W !,FHRETYP,?(S1-$L(FHP6)),FHP6
- W ! D:$P(FHPAR,"^",7)="Y" PRE W ?(S1-$L(TIM)\2),TIM
- W !!,"Recipe",?40,"Portion",?52,PD," TOTAL"
- S LN="",$P(LN,"-",S1+1)="" W !,LN Q
- PRE S Z=$P(Y0,"^",12) S:Z Z=$P($G(^FH(114.2,Z,0)),"^",1)
- W:Z'="" Z Q
- HDR2 W !!!,"*** Note: Does NOT include add-ons and specials!",! Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRO4A 1974 printed Mar 13, 2025@20:59:16 Page 2
- FHPRO4A ; HISC/REL/RVD - Meal Distribution Report ;7/7/94 09:18
- +1 ;;5.5;DIETETICS;**3**;Jan 28, 2005
- +2 ;RVD 5/23/05 - as part of AFP project.
- Q1 DO SES
- SET P0=0
- SET OLD=""
- IF $PIECE(FHPAR,"^",7)'="Y"
- SET PG=0
- DO HDR1
- +1 SET K4=""
- FOR LL=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
- SET N1=^(L1)
- SET Y0=^FH(114,L1,0)
- DO S1
- +2 KILL P
- DO HDR2
- QUIT
- S1 IF $PIECE(FHPAR,"^",7)="Y"
- IF OLD'=$EXTRACT(K4,1,2)
- SET OLD=$EXTRACT(K4,1,2)
- SET PG=0
- DO HDR1
- +1 if $Y>(IOSL-6)
- DO HDR1
- SET P=$PIECE(Y0,"^",3)
- WRITE !!,$PIECE(Y0,"^",1)
- +2 IF $PIECE(FHPAR,"^",7)'="Y"
- SET Z=$PIECE(Y0,"^",12)
- if Z
- SET Z=$PIECE(^FH(114.2,Z,0),"^",2)
- if Z'=""
- WRITE " (",Z,")"
- +3 WRITE ?40,P
- KILL Q
- SET P=$PIECE(P," ",1)
- SET UNT=$SELECT(P["EA":"EACH",P["FL":"GAL",1:"LB")
- SET TOT=0
- +4 SET LL=41
- FOR K=1:1:N
- SET P0=P(K)
- SET N1=$GET(^TMP($JOB,"FH","T",K4,L1,P0))
- SET LL=LL+11
- IF N1
- WRITE ?LL,N1," por"
- SET Q(K)=N1
- SET TOT=TOT+N1
- +5 WRITE ?S2,TOT," por",!
- +6 SET LL=41
- FOR K=1:1:N
- SET LL=LL+11
- IF $GET(Q(K))
- SET Y=P*Q(K)
- DO UNT
- WRITE ?LL,Y
- +7 SET Y=P*TOT
- DO UNT
- WRITE ?S2,Y
- QUIT
- UNT IF UNT="EACH"
- SET Y=$JUSTIFY(Y+.999\1,0,0)_" EA"
- QUIT
- +1 IF UNT="LB"
- SET P1=Y/16
- SET U1="#"
- if P1>.125
- GOTO U1
- SET Y=P1*16+.5\1
- SET U1="OZ"
- GOTO U2
- +2 SET P1=Y/128
- FOR P0=1:1:5
- SET Z=$PIECE("1,4,8,16,128",",",P0)
- if (P1*Z)>.875
- QUIT
- +3 SET U1=$PIECE("GL QT PT CP OZ"," ",P0)
- SET P1=Z*P1
- U1 SET Y=""
- if P1#1>.875
- SET P1=P1+1\1
- if P1'<1
- SET Y=P1\1
- SET P1=P1#1
- +1 IF P1>.125
- if Y'=""
- SET Y=Y_"-"
- SET Y=Y_$SELECT(P1<.375:"1/4",P1<.625:"1/2",1:"3/4")
- U2 SET Y=Y_" "_U1
- QUIT
- SES KILL N,P,S
- SET PD=""
- SET N=0
- +1 FOR P0=0:0
- SET P0=$ORDER(^TMP($JOB,"FH",P0))
- if P0<1
- QUIT
- SET Y=$PIECE(^FH(119.72,P0,0),"^",4)
- if Y=""
- SET Y=$EXTRACT($PIECE(^(0),"^",1),1,6)
- SET S(Y_"~"_P0)=""
- +2 SET Y=""
- FOR
- SET Y=$ORDER(S(Y))
- if Y=""
- QUIT
- SET N=N+1
- SET P(N)=$PIECE(Y,"~",2)
- SET PD=PD_$JUSTIFY($PIECE(Y,"~",1),6)_" "
- +3 KILL S
- SET S2=52+$LENGTH(PD)
- SET S1=S2+8
- if S1<73
- SET S1=73
- QUIT
- HDR1 SET PG=PG+1
- WRITE @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
- +1 WRITE !,FHRETYP,?(S1-$LENGTH(FHP6)),FHP6
- +2 WRITE !
- if $PIECE(FHPAR,"^",7)="Y"
- DO PRE
- WRITE ?(S1-$LENGTH(TIM)\2),TIM
- +3 WRITE !!,"Recipe",?40,"Portion",?52,PD," TOTAL"
- +4 SET LN=""
- SET $PIECE(LN,"-",S1+1)=""
- WRITE !,LN
- QUIT
- PRE SET Z=$PIECE(Y0,"^",12)
- if Z
- SET Z=$PIECE($GET(^FH(114.2,Z,0)),"^",1)
- +1 if Z'=""
- WRITE Z
- QUIT
- HDR2 WRITE !!!,"*** Note: Does NOT include add-ons and specials!",!
- QUIT
