FHPRF1A ; HISC/REL/RVD - Print Forecast ;4/25/93 16:48
;;5.5;DIETETICS;;Jan 28, 2005
;
STRT D NOW^%DTC S NOW=%
S DTP=D1\1 D DTP^FH S TIM=$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",DOW)_"DAY "_DTP
S:'$D(FHSITENM) FHSITENM=""
K S,D,N S L1=50
F P0=0:0 S P0=$O(^TMP($J,P0)) Q:P0'>0 S X=^FH(119.72,P0,0),N1=$P(X,"^",1),N2=$P(X,"^",2),N3=$P(X,"^",4) S:N3="" N3=$E(N1,1,6) S S(N3,P0)=$J(N3,8)_"^"_N2,L1=L1+8
S:L1<80 L1=80
S Z="F O R E C A S T E D D I E T C E N S U S"
S DTP=NOW D DTP^FH W:$E(IOST,1,2)="C-" @IOF W !,DTP,?(L1-$L(Z)\2),Z
S Z=$P(^FH(119.71,FHP,0),"^",1)
W !,FHSITENM
W !,?(L1-$L(Z)\2),Z,!!?(L1-$L(TIM)\2),TIM
W !!?(L1-31\2),"P R O D U C T I O N D I E T S",!!
S X="",FHCNTX=0 F S X=$O(S(X)) Q:X="" S FHCNTX=FHCNTX+1
S FHSP1=31
S:FHCNTX=5 FHSP1=18
S:FHCNTX=4 FHSP1=19
S:FHCNTX=3 FHSP1=25
S:FHCNTX=2 FHSP1=31
S:FHCNTX=1 FHSP1=37
S FHSP2=33
S:FHCNTX=5 FHSP2=20
S:FHCNTX=4 FHSP2=21
S:FHCNTX=3 FHSP2=27
S:FHCNTX=2 FHSP2=33
S:FHCNTX=1 FHSP2=39
W ?FHSP1
;
S X="" F S X=$O(S(X)) Q:X="" F K=0:0 S K=$O(S(X,K)) Q:K="" W $P(S(X,K),"^",1)
W " Tray Cafe Total"
S:L1>80 L1=80 S LN="",$P(LN,"-",L1)="" W !,LN,! K LN
F P1=0:0 S P1=$O(^FH(116.2,"AP",P1)) Q:P1<1 F K=0:0 S K=$O(^FH(116.2,"AP",P1,K)) Q:K<1 I $D(^TMP($J,0,K)) D PRO
W !!,"TOTAL MEALS",?FHSP2 S (N("T"),N("C"),N("D"),N("G"))=""
S X="" F S X=$O(S(X)) Q:X="" F K1=0:0 S K1=$O(S(X,K1)) Q:K1="" S Z=$G(^TMP($J,K1)),TYP=$P(S(X,K1),"^",2) S:Z N(TYP)=N(TYP)+Z W $J(Z,6)," "
S:N("D") N("T")=N("T")+N("D") W $J(N("T"),6),$J(N("C"),6),$J(N("T")+N("C"),7) Q
W !!!,"*** Includes other gratuitous/paid meals.",! K S,D,N,P Q
PRO S (N("T"),N("C"),N("D"),N("G"))="" W !,$E($P($G(^FH(116.2,K,0)),"^",1),1,20),?FHSP2
S X="" F S X=$O(S(X)) Q:X="" F K1=0:0 S K1=$O(S(X,K1)) Q:K1="" S Z=$G(^TMP($J,K1,K)),TYP=$P(S(X,K1),"^",2) S:Z N(TYP)=N(TYP)+Z W $J(Z,6)," "
S:N("D") N("T")=N("T")+N("D") W $J(N("T"),6),$J(N("C"),6),$J(N("T")+N("C"),7) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRF1A 1983 printed Dec 13, 2024@01:54:26 Page 2
FHPRF1A ; HISC/REL/RVD - Print Forecast ;4/25/93 16:48
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 ;
STRT DO NOW^%DTC
SET NOW=%
+1 SET DTP=D1\1
DO DTP^FH
SET TIM=$PIECE("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",DOW)_"DAY "_DTP
+2 if '$DATA(FHSITENM)
SET FHSITENM=""
+3 KILL S,D,N
SET L1=50
+4 FOR P0=0:0
SET P0=$ORDER(^TMP($JOB,P0))
if P0'>0
QUIT
SET X=^FH(119.72,P0,0)
SET N1=$PIECE(X,"^",1)
SET N2=$PIECE(X,"^",2)
SET N3=$PIECE(X,"^",4)
if N3=""
SET N3=$EXTRACT(N1,1,6)
SET S(N3,P0)=$JUSTIFY(N3,8)_"^"_N2
SET L1=L1+8
+5 if L1<80
SET L1=80
+6 SET Z="F O R E C A S T E D D I E T C E N S U S"
+7 SET DTP=NOW
DO DTP^FH
if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !,DTP,?(L1-$LENGTH(Z)\2),Z
+8 SET Z=$PIECE(^FH(119.71,FHP,0),"^",1)
+9 WRITE !,FHSITENM
+10 WRITE !,?(L1-$LENGTH(Z)\2),Z,!!?(L1-$LENGTH(TIM)\2),TIM
+11 WRITE !!?(L1-31\2),"P R O D U C T I O N D I E T S",!!
+12 SET X=""
SET FHCNTX=0
FOR
SET X=$ORDER(S(X))
if X=""
QUIT
SET FHCNTX=FHCNTX+1
+13 SET FHSP1=31
+14 if FHCNTX=5
SET FHSP1=18
+15 if FHCNTX=4
SET FHSP1=19
+16 if FHCNTX=3
SET FHSP1=25
+17 if FHCNTX=2
SET FHSP1=31
+18 if FHCNTX=1
SET FHSP1=37
+19 SET FHSP2=33
+20 if FHCNTX=5
SET FHSP2=20
+21 if FHCNTX=4
SET FHSP2=21
+22 if FHCNTX=3
SET FHSP2=27
+23 if FHCNTX=2
SET FHSP2=33
+24 if FHCNTX=1
SET FHSP2=39
+25 WRITE ?FHSP1
+26 ;
+27 SET X=""
FOR
SET X=$ORDER(S(X))
if X=""
QUIT
FOR K=0:0
SET K=$ORDER(S(X,K))
if K=""
QUIT
WRITE $PIECE(S(X,K),"^",1)
+28 WRITE " Tray Cafe Total"
+29 if L1>80
SET L1=80
SET LN=""
SET $PIECE(LN,"-",L1)=""
WRITE !,LN,!
KILL LN
+30 FOR P1=0:0
SET P1=$ORDER(^FH(116.2,"AP",P1))
if P1<1
QUIT
FOR K=0:0
SET K=$ORDER(^FH(116.2,"AP",P1,K))
if K<1
QUIT
IF $DATA(^TMP($JOB,0,K))
DO PRO
+31 WRITE !!,"TOTAL MEALS",?FHSP2
SET (N("T"),N("C"),N("D"),N("G"))=""
+32 SET X=""
FOR
SET X=$ORDER(S(X))
if X=""
QUIT
FOR K1=0:0
SET K1=$ORDER(S(X,K1))
if K1=""
QUIT
SET Z=$GET(^TMP($JOB,K1))
SET TYP=$PIECE(S(X,K1),"^",2)
if Z
SET N(TYP)=N(TYP)+Z
WRITE $JUSTIFY(Z,6)," "
+33 if N("D")
SET N("T")=N("T")+N("D")
WRITE $JUSTIFY(N("T"),6),$JUSTIFY(N("C"),6),$JUSTIFY(N("T")+N("C"),7)
QUIT
+34 WRITE !!!,"*** Includes other gratuitous/paid meals.",!
KILL S,D,N,P
QUIT
PRO SET (N("T"),N("C"),N("D"),N("G"))=""
WRITE !,$EXTRACT($PIECE($GET(^FH(116.2,K,0)),"^",1),1,20),?FHSP2
+1 SET X=""
FOR
SET X=$ORDER(S(X))
if X=""
QUIT
FOR K1=0:0
SET K1=$ORDER(S(X,K1))
if K1=""
QUIT
SET Z=$GET(^TMP($JOB,K1,K))
SET TYP=$PIECE(S(X,K1),"^",2)
if Z
SET N(TYP)=N(TYP)+Z
WRITE $JUSTIFY(Z,6)," "
+2 if N("D")
SET N("T")=N("T")+N("D")
WRITE $JUSTIFY(N("T"),6),$JUSTIFY(N("C"),6),$JUSTIFY(N("T")+N("C"),7)
QUIT
