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),!
Q
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 "-"
Q
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 Oct 16, 2024@17:47:12 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
