FHMTK1C ; HISC/NCA/RVD - Print Tray Tickets ;6/21/2017 13:45
;;5.5;DIETETICS;**43**;Jan 28, 2005;Build 66
PRT ; Print 3 person per page
START I $G(TABREC)="YES" QUIT
S TL=0 D CHKH
W !! S TL=TL+2 F N1=1:1:3 D
.I 'MFLG S MEALDT=$S(MEAL="B":"Breakfast",MEAL="N":"Noon",1:"Evening")_" "_MDT
.E S MEALDT=$S(N1=1:"Breakfast",N1=2:"Noon",1:"Evening")_" "_MDT
.I '$D(MM(0,N1)) Q
.S MMMDT=$P(MM(0,N1),U,7) I MMMDT'="" S MEALDT=$S(MMMDT="B":"Breakfast",MMMDT="N":"Noon",1:"Evening")_" "_MDT
.S MEALDT=$J("",40-$L(MEALDT)\2)_MEALDT
.I $D(MM(0,N1)) W ?$S(N1=1:2,N1=2:45,1:88),MEALDT
.Q
W ! S TL=TL+1 F N1=1:1 Q:'$D(PP(N1)) W ! S TL=TL+1 F NBR=1:1:3 I $D(PP(N1,NBR)) W ?$S(NBR=1:2,NBR=2:45,1:88),PP(N1,NBR)
W ! S TL=TL+1
F N1=1:1 Q:'$D(MM(N1)) D:(TL+2)'<($S(FHBOT="Y":LN-5,1:LN-3)) NXT W !! S TL=TL+2 F NBR=1:1:3 I $D(MM(N1,NBR)) W ?$S(NBR=1:2,NBR=2:45,1:88),MM(N1,NBR)
I TL<LN F L1=TL:1:$S(FHBOT="Y":LN-2,1:LN) W !
I FHBOT="Y" D HEAD W @IOF Q
E D FOOT
W @IOF Q
NXT ; Print Next Page
W !! S TL=TL+2 F NM=1:1:3 I $D(MM(0,NM)) W ?$S(NM=1:12,NM=2:57,1:100),"(More Items Next Pg)"
I TL<LN F L1=TL:1:$S(FHBOT="Y":LN-2,1:LN) W !
I FHBOT="Y" D HEAD W @IOF G N1
E D FOOT
N1 W @IOF S TL=0 D CHKH
W !! S TL=TL+2 F XX=1:1:3 D
.I 'MFLG S MEALDT=$S(MEAL="B":"Breakfast",MEAL="N":"Noon",1:"Evening")_" "_MDT
.E S MEALDT=$S(XX=1:"Breakfast",XX=2:"Noon",1:"Evening")_" "_MDT
.I '$D(MM(0,XX)) Q
.S MMMDT=$P(MM(0,XX),U,7) I MMMDT'="" S MEALDT=$S(MMMDT="B":"Breakfast",MMMDT="N":"Noon",1:"Evening")_" "_MDT
.S MEALDT=$J("",40-$L(MEALDT)\2)_MEALDT
.I $D(MM(0,XX)) W ?$S(XX=1:2,XX=2:45,1:88),MEALDT," (Cont.)"
.W ! S TL=TL+1 Q
Q
CHKH ; Check whether name header should be on bottom
I FHBOT="Y" W ! S TL=TL+1 D FOOT W ! S TL=TL+1 Q
E D HEAD
Q
HEAD F NM=1:1:3 W ! S TL=TL+1 F NBR=1:1:3 S X=$P($G(MM(0,NBR)),"^",NM) I X'="" D
.S S1=$S(NBR=1:2,NBR=2:45,1:88) I NM=1 W ?S1,X Q
.; Print special flags
.I NM=3 W ?S1,$$NOTE^FHMTK1D(MM(0,NBR),NBR,MFLG,MEAL)
.W ?(S1+38-$L(X)),X Q
Q
Q
LIST ; Print Tabulated Recipe List for Service Points
S PG=0 I 'MFLG D L1 Q
F MEAL="B","N","E" D L1
D:SUM SUM Q
Q
L1 S:LS(MEAL)<80 LS(MEAL)=80 S MEALDT=$S(MEAL="B":"Breakfast",MEAL="N":"Noon",1:"Evening")_" "_MDT,PG=PG+1
W:$E(IOST,1,2)="C-" @IOF W !,HD,!!!?(LS(MEAL)-42\2),"T A B U L A T E D R E C I P E L I S T",?(LS(MEAL)-8),"Page ",PG
W !!?(LS(MEAL)-$L(MEALDT)\2),MEALDT,!!,$S(ALL:"ALL",FHP:$P($G(^FH(119.73,FHP,0)),"^",1),1:$P($G(^FH(119.6,+W1,0)),"^",1)),!
W !!,"R E C I P E S",?29
S X="" F S X=$O(DP(MEAL,X)) Q:X="" F K=0:0 S K=$O(DP(MEAL,X,K)) Q:K="" W $P(DP(MEAL,X,K),"^",1)
W " Total",!
S X8="" F S X8=$O(^TMP($J,"CTR",MEAL,X8)) Q:X8="" W !!,$P(X8,"~",3),?31 D PRO
S TOT=0 W !!!,"TOTAL RECIPES",?31 S X="" F S X=$O(DP(MEAL,X)) Q:X="" D
.F K=0:0 S K=$O(DP(MEAL,X,K)) Q:K<1 D
..S Z=$G(P(MEAL,X,K)),TOT=TOT+Z
..I 'Z W $J("",8)_" " Q
..W $S(Z#1>0:$J(Z,8,2),1:$J(Z,8))_" " Q
.Q
W $S(TOT#1>0:$J(TOT,9,2),1:$J(TOT,9)) W:MFLG @IOF Q
PRO S FTOT=0,X="" F S X=$O(DP(MEAL,X)) Q:X="" D
.F K=0:0 S K=$O(DP(MEAL,X,K)) Q:K<1 D
..S Z=$G(^TMP($J,"CTR",MEAL,X8,K)),FTOT=FTOT+Z,P(MEAL,X,K)=P(MEAL,X,K)+Z
..I 'Z W $J("",8)_" " Q
..;W $S(Z#1>0:$J(Z,8,1),1:$J(Z,6)_" ")_" " Q
..W $S(Z#1>0:$J(Z,8,2),1:$J(Z,8))_" " Q
.Q
W $S(FTOT#1>0:$J(FTOT,9,2),1:$J(FTOT,9)_" ")
Q
SUM S:SL<80 SL=80 S MEALDT="All Meals "_MDT S PG=0 D HDR
S X8="" F S X8=$O(^TMP($J,"TOT",X8)) Q:X8="" D
.I $Y>LN W @IOF D HDR
.W !!,$P(X8,"~",3),?31 D PR1 Q
S TOT=0 W !!!,"TOTAL RECIPES",?31 S X="" F S X=$O(TP(X)) Q:X="" D
.F K=0:0 S K=$O(TP(X,K)) Q:K<1 D
..S Z=$G(T1(X,K)),TOT=TOT+Z
..I 'Z W $J("",8)_" " Q
..W $S(Z#1>0:$J(Z,8,2),1:$J(Z,8))_" " Q
.Q
W $S(TOT#1>0:$J(TOT,9,2),1:$J(TOT,9)) Q
PR1 S FTOT=0,X="" F S X=$O(TP(X)) Q:X="" D
.F K=0:0 S K=$O(TP(X,K)) Q:K<1 D
..S Z=$G(^TMP($J,"TOT",X8,K)),FTOT=FTOT+Z,T1(X,K)=T1(X,K)+Z
..I 'Z W $J("",8)_" " Q
..;W $S(Z#1>0:$J(Z,8,1),1:$J(Z,6)_" ")_" " Q
..W $S(Z#1>0:$J(Z,8,2),1:$J(Z,8))_" " Q
.Q
W $S(FTOT#1>0:$J(FTOT,9,2),1:$J(FTOT,9)_" ")
Q
HDR ; Consolidated Recipe List Heading
S PG=PG+1 W !,HD,!!!?(SL-48\2),"C O N S O L I D A T E D R E C I P E L I S T",?(SL-8),"Page ",PG
W !!?(SL-$L(MEALDT)\2),MEALDT,!!,$S(ALL:"ALL",FHP:$P($G(^FH(119.73,FHP,0)),"^",1),1:$P($G(^FH(119.6,+W1,0)),"^",1)),!
W !!,"R E C I P E S",?29
S X="" F S X=$O(TP(X)) Q:X="" F K=0:0 S K=$O(TP(X,K)) Q:K="" W $P(TP(X,K),"^",1)
W " Total",! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHMTK1C 4590 printed Apr 09, 2024@20:56:41 Page 2
FHMTK1C ; HISC/NCA/RVD - Print Tray Tickets ;6/21/2017 13:45
+1 ;;5.5;DIETETICS;**43**;Jan 28, 2005;Build 66
PRT ; Print 3 person per page
START IF $GET(TABREC)="YES"
QUIT
+1 SET TL=0
DO CHKH
+2 WRITE !!
SET TL=TL+2
FOR N1=1:1:3
Begin DoDot:1
+3 IF 'MFLG
SET MEALDT=$SELECT(MEAL="B":"Breakfast",MEAL="N":"Noon",1:"Evening")_" "_MDT
+4 IF '$TEST
SET MEALDT=$SELECT(N1=1:"Breakfast",N1=2:"Noon",1:"Evening")_" "_MDT
+5 IF '$DATA(MM(0,N1))
QUIT
+6 SET MMMDT=$PIECE(MM(0,N1),U,7)
IF MMMDT'=""
SET MEALDT=$SELECT(MMMDT="B":"Breakfast",MMMDT="N":"Noon",1:"Evening")_" "_MDT
+7 SET MEALDT=$JUSTIFY("",40-$LENGTH(MEALDT)\2)_MEALDT
+8 IF $DATA(MM(0,N1))
WRITE ?$SELECT(N1=1:2,N1=2:45,1:88),MEALDT
+9 QUIT
End DoDot:1
+10 WRITE !
SET TL=TL+1
FOR N1=1:1
if '$DATA(PP(N1))
QUIT
WRITE !
SET TL=TL+1
FOR NBR=1:1:3
IF $DATA(PP(N1,NBR))
WRITE ?$SELECT(NBR=1:2,NBR=2:45,1:88),PP(N1,NBR)
+11 WRITE !
SET TL=TL+1
+12 FOR N1=1:1
if '$DATA(MM(N1))
QUIT
if (TL+2)'<($SELECT(FHBOT="Y"
DO NXT
WRITE !!
SET TL=TL+2
FOR NBR=1:1:3
IF $DATA(MM(N1,NBR))
WRITE ?$SELECT(NBR=1:2,NBR=2:45,1:88),MM(N1,NBR)
+13 IF TL<LN
FOR L1=TL:1:$SELECT(FHBOT="Y":LN-2,1:LN)
WRITE !
+14 IF FHBOT="Y"
DO HEAD
WRITE @IOF
QUIT
+15 IF '$TEST
DO FOOT
+16 WRITE @IOF
QUIT
NXT ; Print Next Page
+1 WRITE !!
SET TL=TL+2
FOR NM=1:1:3
IF $DATA(MM(0,NM))
WRITE ?$SELECT(NM=1:12,NM=2:57,1:100),"(More Items Next Pg)"
+2 IF TL<LN
FOR L1=TL:1:$SELECT(FHBOT="Y":LN-2,1:LN)
WRITE !
+3 IF FHBOT="Y"
DO HEAD
WRITE @IOF
GOTO N1
+4 IF '$TEST
DO FOOT
N1 WRITE @IOF
SET TL=0
DO CHKH
+1 WRITE !!
SET TL=TL+2
FOR XX=1:1:3
Begin DoDot:1
+2 IF 'MFLG
SET MEALDT=$SELECT(MEAL="B":"Breakfast",MEAL="N":"Noon",1:"Evening")_" "_MDT
+3 IF '$TEST
SET MEALDT=$SELECT(XX=1:"Breakfast",XX=2:"Noon",1:"Evening")_" "_MDT
+4 IF '$DATA(MM(0,XX))
QUIT
+5 SET MMMDT=$PIECE(MM(0,XX),U,7)
IF MMMDT'=""
SET MEALDT=$SELECT(MMMDT="B":"Breakfast",MMMDT="N":"Noon",1:"Evening")_" "_MDT
+6 SET MEALDT=$JUSTIFY("",40-$LENGTH(MEALDT)\2)_MEALDT
+7 IF $DATA(MM(0,XX))
WRITE ?$SELECT(XX=1:2,XX=2:45,1:88),MEALDT," (Cont.)"
+8 WRITE !
SET TL=TL+1
QUIT
End DoDot:1
+9 QUIT
CHKH ; Check whether name header should be on bottom
+1 IF FHBOT="Y"
WRITE !
SET TL=TL+1
DO FOOT
WRITE !
SET TL=TL+1
QUIT
+2 IF '$TEST
DO HEAD
+3 QUIT
HEAD FOR NM=1:1:3
WRITE !
SET TL=TL+1
FOR NBR=1:1:3
SET X=$PIECE($GET(MM(0,NBR)),"^",NM)
IF X'=""
Begin DoDot:1
+1 SET S1=$SELECT(NBR=1:2,NBR=2:45,1:88)
IF NM=1
WRITE ?S1,X
QUIT
+2 ; Print special flags
+3 IF NM=3
WRITE ?S1,$$NOTE^FHMTK1D(MM(0,NBR),NBR,MFLG,MEAL)
+4 WRITE ?(S1+38-$LENGTH(X)),X
QUIT
End DoDot:1
+5 QUIT
SET TL=TL+1
FOR NBR=1:1:3
SET S1=$SELECT(NBR=1:2,NBR=2:45,1:88)
if $DATA(MM(0,NBR))
WRITE ?S1,HD
+1 QUIT
LIST ; Print Tabulated Recipe List for Service Points
+1 SET PG=0
IF 'MFLG
DO L1
QUIT
+2 FOR MEAL="B","N","E"
DO L1
+3 if SUM
DO SUM
QUIT
+4 QUIT
L1 if LS(MEAL)<80
SET LS(MEAL)=80
SET MEALDT=$SELECT(MEAL="B":"Breakfast",MEAL="N":"Noon",1:"Evening")_" "_MDT
SET PG=PG+1
+1 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !,HD,!!!?(LS(MEAL)-42\2),"T A B U L A T E D R E C I P E L I S T",?(LS(MEAL)-8),"Page ",PG
+2 WRITE !!?(LS(MEAL)-$LENGTH(MEALDT)\2),MEALDT,!!,$SELECT(ALL:"ALL",FHP:$PIECE($GET(^FH(119.73,FHP,0)),"^",1),1:$PIECE($GET(^FH(119.6,+W1,0)),"^",1)),!
+3 WRITE !!,"R E C I P E S",?29
+4 SET X=""
FOR
SET X=$ORDER(DP(MEAL,X))
if X=""
QUIT
FOR K=0:0
SET K=$ORDER(DP(MEAL,X,K))
if K=""
QUIT
WRITE $PIECE(DP(MEAL,X,K),"^",1)
+5 WRITE " Total",!
+6 SET X8=""
FOR
SET X8=$ORDER(^TMP($JOB,"CTR",MEAL,X8))
if X8=""
QUIT
WRITE !!,$PIECE(X8,"~",3),?31
DO PRO
+7 SET TOT=0
WRITE !!!,"TOTAL RECIPES",?31
SET X=""
FOR
SET X=$ORDER(DP(MEAL,X))
if X=""
QUIT
Begin DoDot:1
+8 FOR K=0:0
SET K=$ORDER(DP(MEAL,X,K))
if K<1
QUIT
Begin DoDot:2
+9 SET Z=$GET(P(MEAL,X,K))
SET TOT=TOT+Z
+10 IF 'Z
WRITE $JUSTIFY("",8)_" "
QUIT
+11 WRITE $SELECT(Z#1>0:$JUSTIFY(Z,8,2),1:$JUSTIFY(Z,8))_" "
QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 WRITE $SELECT(TOT#1>0:$JUSTIFY(TOT,9,2),1:$JUSTIFY(TOT,9))
if MFLG
WRITE @IOF
QUIT
PRO SET FTOT=0
SET X=""
FOR
SET X=$ORDER(DP(MEAL,X))
if X=""
QUIT
Begin DoDot:1
+1 FOR K=0:0
SET K=$ORDER(DP(MEAL,X,K))
if K<1
QUIT
Begin DoDot:2
+2 SET Z=$GET(^TMP($JOB,"CTR",MEAL,X8,K))
SET FTOT=FTOT+Z
SET P(MEAL,X,K)=P(MEAL,X,K)+Z
+3 IF 'Z
WRITE $JUSTIFY("",8)_" "
QUIT
+4 ;W $S(Z#1>0:$J(Z,8,1),1:$J(Z,6)_" ")_" " Q
+5 WRITE $SELECT(Z#1>0:$JUSTIFY(Z,8,2),1:$JUSTIFY(Z,8))_" "
QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 WRITE $SELECT(FTOT#1>0:$JUSTIFY(FTOT,9,2),1:$JUSTIFY(FTOT,9)_" ")
+8 QUIT
SUM if SL<80
SET SL=80
SET MEALDT="All Meals "_MDT
SET PG=0
DO HDR
+1 SET X8=""
FOR
SET X8=$ORDER(^TMP($JOB,"TOT",X8))
if X8=""
QUIT
Begin DoDot:1
+2 IF $Y>LN
WRITE @IOF
DO HDR
+3 WRITE !!,$PIECE(X8,"~",3),?31
DO PR1
QUIT
End DoDot:1
+4 SET TOT=0
WRITE !!!,"TOTAL RECIPES",?31
SET X=""
FOR
SET X=$ORDER(TP(X))
if X=""
QUIT
Begin DoDot:1
+5 FOR K=0:0
SET K=$ORDER(TP(X,K))
if K<1
QUIT
Begin DoDot:2
+6 SET Z=$GET(T1(X,K))
SET TOT=TOT+Z
+7 IF 'Z
WRITE $JUSTIFY("",8)_" "
QUIT
+8 WRITE $SELECT(Z#1>0:$JUSTIFY(Z,8,2),1:$JUSTIFY(Z,8))_" "
QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 WRITE $SELECT(TOT#1>0:$JUSTIFY(TOT,9,2),1:$JUSTIFY(TOT,9))
QUIT
PR1 SET FTOT=0
SET X=""
FOR
SET X=$ORDER(TP(X))
if X=""
QUIT
Begin DoDot:1
+1 FOR K=0:0
SET K=$ORDER(TP(X,K))
if K<1
QUIT
Begin DoDot:2
+2 SET Z=$GET(^TMP($JOB,"TOT",X8,K))
SET FTOT=FTOT+Z
SET T1(X,K)=T1(X,K)+Z
+3 IF 'Z
WRITE $JUSTIFY("",8)_" "
QUIT
+4 ;W $S(Z#1>0:$J(Z,8,1),1:$J(Z,6)_" ")_" " Q
+5 WRITE $SELECT(Z#1>0:$JUSTIFY(Z,8,2),1:$JUSTIFY(Z,8))_" "
QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 WRITE $SELECT(FTOT#1>0:$JUSTIFY(FTOT,9,2),1:$JUSTIFY(FTOT,9)_" ")
+8 QUIT
HDR ; Consolidated Recipe List Heading
+1 SET PG=PG+1
WRITE !,HD,!!!?(SL-48\2),"C O N S O L I D A T E D R E C I P E L I S T",?(SL-8),"Page ",PG
+2 WRITE !!?(SL-$LENGTH(MEALDT)\2),MEALDT,!!,$SELECT(ALL:"ALL",FHP:$PIECE($GET(^FH(119.73,FHP,0)),"^",1),1:$PIECE($GET(^FH(119.6,+W1,0)),"^",1)),!
+3 WRITE !!,"R E C I P E S",?29
+4 SET X=""
FOR
SET X=$ORDER(TP(X))
if X=""
QUIT
FOR K=0:0
SET K=$ORDER(TP(X,K))
if K=""
QUIT
WRITE $PIECE(TP(X,K),"^",1)
+5 WRITE " Total",!
QUIT
