FHMTK1C.m

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

FOOT W ! S TL=TL+1 F NBR=1:1:3 S S1=$S(NBR=1:2,NBR=2:45,1:88) W:$D(MM(0,NBR)) ?S1,HD

 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 ---FHMTK1C   4590     printed  Feb 18, 2025@23:14:31                                                                                                                                                                                                     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 

FOOT       WRITE !

           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