Routine: FHADM21

FHADM21 ; HISC/REL/NCA - Served Meals Report ;1/23/98  16:07

 ;;5.5;DIETETICS;;Jan 28, 2005

EN2 ; Print Meals Report

 ; Check for multidivisional site

 I $P($G(^FH(119.9,1,0)),U,20)'="N" D ^FHMADM21 Q

 D NOW^%DTC S DT=%\1 D DT^FHADM2 G:"^"[X KIL

 W !!,"The report requires a 132 column printer.",!

 K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL

 I $D(IO("Q")) S FHPGM="Q1^FHADM21",FHLST="EDT^SDT" D EN2^FH G KIL

 U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL

Q1 S DTP=SDT\1 D DTP^FH S DTE=DTP_" to " S DTP=EDT\1 D DTP^FH S DTE=DTE_DTP

 S X=SDT D DOW^%DTC S DOW=Y+1

 D NOW^%DTC S DTP=% D DTP^FH S HDT=DTP,PG=0 D HDR

 K S F K=1:1:21 S S(K)=0

 S D1=SDT,(ND,TD)=0 F L1=0:0 D N1 S X1=D1,X2=1 D C^%DTC Q:X>EDT  S D1=X,DOW=DOW+1 S:DOW=8 DOW=1

 F K=1:1:18 S N(K)=$J($S(ND:S(K)/ND,1:0),0,0),N(K)=$J($S(N(K)<1:"",1:N(K)),5)_" ",S(K)=$S(S(K)<1:$J("",6),S(K)<100000:$J(S(K),5)_" ",1:$J(S(K),6))

 F K=19:1:21 S N(K)=$J($S(TD:S(K)/TD,1:0),0,0),N(K)=$J($S(N(K)<1:"",1:N(K)),5)_" ",S(K)=$S(S(K)<1:$J("",6),S(K)<100000:$J(S(K),5)_" ",1:$J(S(K),6))

 D LN W !?4,"Total",?15,"|",S(1),S(2),S(3),"|",S(4),S(5),S(6),"|",S(7),S(8),S(9),"|",S(10),"|",S(11),S(13),S(16),"|",S(17),"|",S(18),"|",S(19),S(20),S(21),!

 W:ND ?4,"Avg. ",?15,"|",N(1),N(2),N(3),"|",N(4),N(5),N(6),"|",N(7),N(8),N(9),"|",N(10),"|",N(11),N(13),N(16),"|",N(17),"|",N(18),"|",N(19),N(20),N(21),!

HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !,HDT,?44,"S E R V E D   M E A L S   W O R K S H E E T",?125,"Page ",PG

 W !!?(131-$L(DTE)\2),DTE

 W !!,?15,"|",?32,"MEALS SERVED ON INPATIENT BASIS",?79,"|",?82,"MEALS SERVED TO OTHERS",?105,"| TOTAL| SERVED TRAYS DATA"

 W !,?15,"|",?19,"DOMICILIARY",?34,"| NURSING HOME CU",?53,"|",?59,"HOSPITAL",?72,"| TOTAL|",?98,"| TOTAL| MEALS|"

 W !,?15,"|  Inp.  Abs.  Meal|  Inp.  Abs.  Meal|  Inp.  Abs.  Meal|      | Outp.  Paid Grat.|      |      |  Cafe   NPO Trays"

 W !,?15,"|   A     B     C  |   D     E     F  |   G     H     I  |   J  |   K     M    Q   |      |   R  |   T      U    V"

LN W ! F K=1:1:131 W "-"

N1 S Y0=$G(^FH(117,D1,0)),Y1=$G(^(1))

 K N S K=1 F L=1,2,4,5,7,8 S K=K+1,N(L)=$P(Y0,"^",K)

 S K=10 F L=1:3:16 S K=K+1,N(K)=$P(Y1,"^",L)+$P(Y1,"^",L+1)+$P(Y1,"^",L+2)

 S N(19)=$P(Y1,"^",19),N(20)=$P(Y1,"^",20)

 S N(3)=N(1)-N(2)*3,N(6)=N(4)-N(5)*3,N(9)=N(7)-N(8)*3,N(10)=N(3)+N(6)+N(9)

 S N(16)=N(14)+N(15)+N(16),N(13)=N(12)+N(13),N(17)=N(11)+N(13)+N(16),N(18)=N(10)+N(17),N(19)=N(19)+N(17),N(21)=N(18)-N(19)-N(20) S:N(18) ND=ND+1 S:N(20) TD=TD+1

 F K=1:1:21 S S(K)=S(K)+N(K)

 F K=1:1:21 S N(K)=$J($S(N(K)<1:"",1:N(K)),5)_" "

 S DTP=D1 D DTP^FH D:$Y>(IOSL-8) HDR

 W !,$P("Sun Mon Tue Wed Thu Fri Sat"," ",DOW)," ",DTP

 W ?15,"|",N(1),N(2),N(3),"|",N(4),N(5),N(6),"|",N(7),N(8),N(9),"|",N(10),"|",N(11),N(13),N(16),"|",N(17),"|",N(18),"|",N(19),N(20),N(21) Q

KIL ; Kill all used Variables

 G KILL^XUSCLEAN

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHADM21   2886     printed  Feb 18, 2025@23:12:44                                                                                                                                                                                                     Page 2

FHADM21   ; HISC/REL/NCA - Served Meals Report ;1/23/98  16:07

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

EN2       ; Print Meals Report

 +1       ; Check for multidivisional site

 +2        IF $PIECE($GET(^FH(119.9,1,0)),U,20)'="N"

               DO ^FHMADM21

               QUIT

 +3        DO NOW^%DTC

           SET DT=%\1

           DO DT^FHADM2

           if "^"[X

               GOTO KIL

 +4        WRITE !!,"The report requires a 132 column printer.",!

 +5        KILL IOP,%ZIS

           SET %ZIS("A")="Print on Device: "

           SET %ZIS="MQ"

           WRITE !

           DO ^%ZIS

           KILL %ZIS,IOP

           if POP

               GOTO KIL

 +6        IF $DATA(IO("Q"))

               SET FHPGM="Q1^FHADM21"

               SET FHLST="EDT^SDT"

               DO EN2^FH

               GOTO KIL

 +7        USE IO

           DO Q1

           DO ^%ZISC

           KILL %ZIS,IOP

           GOTO KIL

Q1         SET DTP=SDT\1

           DO DTP^FH

           SET DTE=DTP_" to "

           SET DTP=EDT\1

           DO DTP^FH

           SET DTE=DTE_DTP

 +1        SET X=SDT

           DO DOW^%DTC

           SET DOW=Y+1

 +2        DO NOW^%DTC

           SET DTP=%

           DO DTP^FH

           SET HDT=DTP

           SET PG=0

           DO HDR

 +3        KILL S

           FOR K=1:1:21

               SET S(K)=0

 +4        SET D1=SDT

           SET (ND,TD)=0

           FOR L1=0:0

               DO N1

               SET X1=D1

               SET X2=1

               DO C^%DTC

               if X>EDT

                   QUIT

               SET D1=X

               SET DOW=DOW+1

               if DOW=8

                   SET DOW=1

 +5        FOR K=1:1:18

               SET N(K)=$JUSTIFY($SELECT(ND:S(K)/ND,1:0),0,0)

               SET N(K)=$JUSTIFY($SELECT(N(K)<1:"",1:N(K)),5)_" "

               SET S(K)=$SELECT(S(K)<1:$JUSTIFY("",6),S(K)<100000:$JUSTIFY(S(K),5)_" ",1:$JUSTIFY(S(K),6))

 +6        FOR K=19:1:21

               SET N(K)=$JUSTIFY($SELECT(TD:S(K)/TD,1:0),0,0)

               SET N(K)=$JUSTIFY($SELECT(N(K)<1:"",1:N(K)),5)_" "

               SET S(K)=$SELECT(S(K)<1:$JUSTIFY("",6),S(K)<100000:$JUSTIFY(S(K),5)_" ",1:$JUSTIFY(S(K),6))

 +7        DO LN

           WRITE !?4,"Total",?15,"|",S(1),S(2),S(3),"|",S(4),S(5),S(6),"|",S(7),S(8),S(9),"|",S(10),"|",S(11),S(13),S(16),"|",S(17),"|",S(18),"|",S(19),S(20),S(21),!

 +8        if ND

               WRITE ?4,"Avg. ",?15,"|",N(1),N(2),N(3),"|",N(4),N(5),N(6),"|",N(7),N(8),N(9),"|",N(10),"|",N(11),N(13),N(16),"|",N(17),"|",N(18),"|",N(19),N(20),N(21),!

 +9        QUIT

HDR        if '($EXTRACT(IOST,1,2)'="C-"&'PG)

               WRITE @IOF

           SET PG=PG+1

           WRITE !,HDT,?44,"S E R V E D   M E A L S   W O R K S H E E T",?125,"Page ",PG

 +1        WRITE !!?(131-$LENGTH(DTE)\2),DTE

 +2        WRITE !!,?15,"|",?32,"MEALS SERVED ON INPATIENT BASIS",?79,"|",?82,"MEALS SERVED TO OTHERS",?105,"| TOTAL| SERVED TRAYS DATA"

 +3        WRITE !,?15,"|",?19,"DOMICILIARY",?34,"| NURSING HOME CU",?53,"|",?59,"HOSPITAL",?72,"| TOTAL|",?98,"| TOTAL| MEALS|"

 +4        WRITE !,?15,"|  Inp.  Abs.  Meal|  Inp.  Abs.  Meal|  Inp.  Abs.  Meal|      | Outp.  Paid Grat.|      |      |  Cafe   NPO Trays"

 +5        WRITE !,?15,"|   A     B     C  |   D     E     F  |   G     H     I  |   J  |   K     M    Q   |      |   R  |   T      U    V"

LN         WRITE !

           FOR K=1:1:131

               WRITE "-"

 +1        QUIT

N1         SET Y0=$GET(^FH(117,D1,0))

           SET Y1=$GET(^(1))

 +1        KILL N

           SET K=1

           FOR L=1,2,4,5,7,8

               SET K=K+1

               SET N(L)=$PIECE(Y0,"^",K)

 +2        SET K=10

           FOR L=1:3:16

               SET K=K+1

               SET N(K)=$PIECE(Y1,"^",L)+$PIECE(Y1,"^",L+1)+$PIECE(Y1,"^",L+2)

 +3        SET N(19)=$PIECE(Y1,"^",19)

           SET N(20)=$PIECE(Y1,"^",20)

 +4        SET N(3)=N(1)-N(2)*3

           SET N(6)=N(4)-N(5)*3

           SET N(9)=N(7)-N(8)*3

           SET N(10)=N(3)+N(6)+N(9)

 +5        SET N(16)=N(14)+N(15)+N(16)

           SET N(13)=N(12)+N(13)

           SET N(17)=N(11)+N(13)+N(16)

           SET N(18)=N(10)+N(17)

           SET N(19)=N(19)+N(17)

           SET N(21)=N(18)-N(19)-N(20)

           if N(18)

               SET ND=ND+1

           if N(20)

               SET TD=TD+1

 +6        FOR K=1:1:21

               SET S(K)=S(K)+N(K)

 +7        FOR K=1:1:21

               SET N(K)=$JUSTIFY($SELECT(N(K)<1:"",1:N(K)),5)_" "

 +8        SET DTP=D1

           DO DTP^FH

           if $Y>(IOSL-8)

               DO HDR

 +9        WRITE !,$PIECE("Sun Mon Tue Wed Thu Fri Sat"," ",DOW)," ",DTP

 +10       WRITE ?15,"|",N(1),N(2),N(3),"|",N(4),N(5),N(6),"|",N(7),N(8),N(9),"|",N(10),"|",N(11),N(13),N(16),"|",N(17),"|",N(18),"|",N(19),N(20),N(21)

           QUIT

KIL       ; Kill all used Variables

 +1        GOTO KILL^XUSCLEAN

FHADM21.m