FHADR3A ; HISC/NCA - Facility Workload ;6/18/93 11:30
;;5.5;DIETETICS;;Jan 28, 2005
EN2 ; Calculate Inpats Days of Care and Outpats treated in
; Hosp & Sat Clinics
K AMS,T1,T2,TD S AMS="" F K=1:1:8 S T1(K)=""
F K=1:1:4 S TD(K)=0
F QR=1:1:4 S QTR=QR,PRE=FHYR_"0"_QTR_"00" D Q2^FHADRPT D
.Q:'SDT!('EDT)
.K N S S=0 F K=1:1:24 S N(K)=0
.S STR1=""
.S D1=SDT\1 F L1=0:0 D Q:X>EDT
..S Y0=$G(^FH(117,D1,0)),Y1=$G(^(1))
..S:Y0'="" S=S+1
..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(3)=N(1)-N(2)*3,N(6)=N(4)-N(5)*3,N(9)=N(7)-N(8)*3
..S N(10)=N(3)+N(6)+N(9)+N(11)+N(12)+N(13)+N(14)+N(15)+N(16)
..S N(22)=N(1)-N(2),N(23)=N(4)-N(5),N(24)=N(7)-N(8)
..S N(17)=N(17)+N(10),N(18)=N(18)+N(22)
..S N(19)=N(19)+N(23),N(20)=N(20)+N(24)
..S X1=D1,X2=1 D C^%DTC
..S D1=X
..Q
.S N(21)=N(18)+N(19)+N(20)
.S $P(T1(QTR),"^",1)=$P(T1(QTR),"^",1)+N(17)
.S $P(T1(QTR),"^",2)=$P(T1(QTR),"^",2)+N(20)
.S $P(T1(QTR),"^",3)=$P(T1(QTR),"^",3)+N(19)
.S $P(T1(QTR),"^",4)=$P(T1(QTR),"^",4)+N(18)
.S $P(T1(QTR),"^",5)=$P(T1(QTR),"^",5)+N(21)
.S TD(QTR)=TD(QTR)+S
.S $P(^FH(117.3,PRE,1),"^",5)=N(17)
.S STR=$G(^FH(117.3,PRE,1))
.S $P(T1(5),"^",QTR)=$P(T1(5),"^",QTR)+$P(STR,"^",1)
.S $P(T1(5),"^",5)=$P(T1(5),"^",5)+$P(STR,"^",1)
.S $P(T1(6),"^",QTR)=$P(T1(6),"^",QTR)+$P(STR,"^",1)
.S NUM=$P(STR,"^",3) Q:NUM<1
.S CTR=$P($G(^FH(117.3,PRE,"CLIN",0)),"^",4) Q:CTR="" Q:CTR'=NUM
.F NUM=0:0 S NUM=$O(^FH(117.3,PRE,"CLIN",NUM)) Q:NUM<1 S STR1=$G(^(NUM,0)) D
..S SAT=$P(STR1,"^",1)
..I SAT'="" S:'$D(T2(SAT)) T2(SAT)=""
..S $P(T2(SAT),"^",QTR)=$P(T2(SAT),"^",QTR)+$P(STR1,"^",2)
..S $P(T2(SAT),"^",5)=$P(T2(SAT),"^",5)+$P(STR1,"^",2)
..S $P(T1(5),"^",5)=$P(T1(5),"^",5)+$P(STR1,"^",2)
..S $P(T1(6),"^",QTR)=$P(T1(6),"^",QTR)+$P(STR1,"^",2)
..Q
.Q
D HDR1 S (FIN,FTO,YD)=0
W !,?15,"Hospital ",?61
F I=1:1:4 S X=$P(T1(I),"^",2),X2=0 D COMMA^%DTC W X S FIN=FIN+$P(T1(I),"^",2)
S X=FIN,X2=0 D COMMA^%DTC W ?112,X S FTO=FTO+FIN,FIN=0
W !,?15,"Nursing Home ",?61
F I=1:1:4 S X=$P(T1(I),"^",3),X2=0 D COMMA^%DTC W X S FIN=FIN+$P(T1(I),"^",3)
S X=FIN,X2=0 D COMMA^%DTC W ?112,X S FTO=FTO+FIN,FIN=0
W !,?15,"Domicillary ",?61
F I=1:1:4 S X=$P(T1(I),"^",4),X2=0 D COMMA^%DTC W X S FIN=FIN+$P(T1(I),"^",4)
S X=FIN,X2=0 D COMMA^%DTC W ?112,X S FTO=FTO+FIN,FIN=0
W !,?15,"Total Inpatient Days ",?61
F I=1:1:4 S X=$P(T1(I),"^",5),X2=0 D COMMA^%DTC W X
S X=FTO,X2=0 D COMMA^%DTC W ?112,X
W !!!,?13,"OUTPATIENTS TREATED",!?15,"Hospital Clinic ",?61
F I=1:1:4 S X=$P(T1(5),"^",I),X2=0 D COMMA^%DTC W X S FIN=FIN+$P(T1(5),"^",I)
S X=FIN,X2=0 D COMMA^%DTC W ?112,X S FIN=0
S (CT,Z)=0 F K=0:0 S Z=$O(T2(Z)) Q:Z="" S CT=CT+1 D
.W !,?15,"Satellite Location ",CT," ",Z,?61
.F J=1:1:4 S X=$P(T2(Z),"^",J),X2=0 D COMMA^%DTC W X
.S X=$P(T2(Z),"^",5),X2=0 D COMMA^%DTC W ?112,X
.Q
W !,?15,"Total Outpatients Treated ",?61
F I=1:1:4 S X=$P(T1(6),"^",I),X2=0 D COMMA^%DTC W X S FIN=FIN+$P(T1(6),"^",I)
S X=FIN,X2=0 D COMMA^%DTC W ?112,X S FIN=0
D:$Y'<LIN HDR^FHADRPT D HDR2
W !!!!?13,"SERVED MEALS SUMMARY",!!?65,"1st Qtr 2nd Qtr 3rd Qtr 4th Qtr Yearly"
W !!?15,"Total Served Meals",?61
F I=1:1:4 S X=$P(T1(I),"^",1),X2=0 D COMMA^%DTC W X S FIN=FIN+$P(T1(I),"^",1)
S X=FIN,X2=0 D COMMA^%DTC W ?112,X
W !,?15,"Average Daily Meals",?61 S FIN=0
F I=1:1:4 S X=$S(+TD(I)'<1:$P(T1(I),"^",1)/TD(I),1:""),$P(AMS,"^",I)=X,X2=0,FIN=FIN+$P(T1(I),"^",1),YD=YD+TD(I) D COMMA^%DTC W X
S X=$S(YD'<1:FIN/YD,1:""),X2=0 D COMMA^%DTC W ?112,X
K N,T1,T2,TD Q
HDR1 ; Print heading for Facility Workload
D:$Y'<(LIN-20) HDR^FHADRPT
W !!!?13,"S E C T I O N II F A C I L I T Y W O R K L O A D S T A T I S T I C S"
W !!!!,?13,"INPATIENT DAYS OF CARE" W ?65,"1st Qtr 2nd Qtr 3rd Qtr 4th Qtr YTD Total" Q
HDR2 ; Print Heading for Workload Statistics
D:$Y'<(LIN-14) HDR^FHADRPT
W !!!!!!?13,"S E C T I O N III D I E T E T I C W O R K L O A D S T A T I S T I C S"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHADR3A 4074 printed Sep 23, 2025@19:22:30 Page 2
FHADR3A ; HISC/NCA - Facility Workload ;6/18/93 11:30
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN2 ; Calculate Inpats Days of Care and Outpats treated in
+1 ; Hosp & Sat Clinics
+2 KILL AMS,T1,T2,TD
SET AMS=""
FOR K=1:1:8
SET T1(K)=""
+3 FOR K=1:1:4
SET TD(K)=0
+4 FOR QR=1:1:4
SET QTR=QR
SET PRE=FHYR_"0"_QTR_"00"
DO Q2^FHADRPT
Begin DoDot:1
+5 if 'SDT!('EDT)
QUIT
+6 KILL N
SET S=0
FOR K=1:1:24
SET N(K)=0
+7 SET STR1=""
+8 SET D1=SDT\1
FOR L1=0:0
Begin DoDot:2
+9 SET Y0=$GET(^FH(117,D1,0))
SET Y1=$GET(^(1))
+10 if Y0'=""
SET S=S+1
+11 SET K=1
FOR L=1,2,4,5,7,8
SET K=K+1
SET N(L)=$PIECE(Y0,"^",K)
+12 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)
+13 SET N(3)=N(1)-N(2)*3
SET N(6)=N(4)-N(5)*3
SET N(9)=N(7)-N(8)*3
+14 SET N(10)=N(3)+N(6)+N(9)+N(11)+N(12)+N(13)+N(14)+N(15)+N(16)
+15 SET N(22)=N(1)-N(2)
SET N(23)=N(4)-N(5)
SET N(24)=N(7)-N(8)
+16 SET N(17)=N(17)+N(10)
SET N(18)=N(18)+N(22)
+17 SET N(19)=N(19)+N(23)
SET N(20)=N(20)+N(24)
+18 SET X1=D1
SET X2=1
DO C^%DTC
+19 SET D1=X
+20 QUIT
End DoDot:2
if X>EDT
QUIT
+21 SET N(21)=N(18)+N(19)+N(20)
+22 SET $PIECE(T1(QTR),"^",1)=$PIECE(T1(QTR),"^",1)+N(17)
+23 SET $PIECE(T1(QTR),"^",2)=$PIECE(T1(QTR),"^",2)+N(20)
+24 SET $PIECE(T1(QTR),"^",3)=$PIECE(T1(QTR),"^",3)+N(19)
+25 SET $PIECE(T1(QTR),"^",4)=$PIECE(T1(QTR),"^",4)+N(18)
+26 SET $PIECE(T1(QTR),"^",5)=$PIECE(T1(QTR),"^",5)+N(21)
+27 SET TD(QTR)=TD(QTR)+S
+28 SET $PIECE(^FH(117.3,PRE,1),"^",5)=N(17)
+29 SET STR=$GET(^FH(117.3,PRE,1))
+30 SET $PIECE(T1(5),"^",QTR)=$PIECE(T1(5),"^",QTR)+$PIECE(STR,"^",1)
+31 SET $PIECE(T1(5),"^",5)=$PIECE(T1(5),"^",5)+$PIECE(STR,"^",1)
+32 SET $PIECE(T1(6),"^",QTR)=$PIECE(T1(6),"^",QTR)+$PIECE(STR,"^",1)
+33 SET NUM=$PIECE(STR,"^",3)
if NUM<1
QUIT
+34 SET CTR=$PIECE($GET(^FH(117.3,PRE,"CLIN",0)),"^",4)
if CTR=""
QUIT
if CTR'=NUM
QUIT
+35 FOR NUM=0:0
SET NUM=$ORDER(^FH(117.3,PRE,"CLIN",NUM))
if NUM<1
QUIT
SET STR1=$GET(^(NUM,0))
Begin DoDot:2
+36 SET SAT=$PIECE(STR1,"^",1)
+37 IF SAT'=""
if '$DATA(T2(SAT))
SET T2(SAT)=""
+38 SET $PIECE(T2(SAT),"^",QTR)=$PIECE(T2(SAT),"^",QTR)+$PIECE(STR1,"^",2)
+39 SET $PIECE(T2(SAT),"^",5)=$PIECE(T2(SAT),"^",5)+$PIECE(STR1,"^",2)
+40 SET $PIECE(T1(5),"^",5)=$PIECE(T1(5),"^",5)+$PIECE(STR1,"^",2)
+41 SET $PIECE(T1(6),"^",QTR)=$PIECE(T1(6),"^",QTR)+$PIECE(STR1,"^",2)
+42 QUIT
End DoDot:2
+43 QUIT
End DoDot:1
+44 DO HDR1
SET (FIN,FTO,YD)=0
+45 WRITE !,?15,"Hospital ",?61
+46 FOR I=1:1:4
SET X=$PIECE(T1(I),"^",2)
SET X2=0
DO COMMA^%DTC
WRITE X
SET FIN=FIN+$PIECE(T1(I),"^",2)
+47 SET X=FIN
SET X2=0
DO COMMA^%DTC
WRITE ?112,X
SET FTO=FTO+FIN
SET FIN=0
+48 WRITE !,?15,"Nursing Home ",?61
+49 FOR I=1:1:4
SET X=$PIECE(T1(I),"^",3)
SET X2=0
DO COMMA^%DTC
WRITE X
SET FIN=FIN+$PIECE(T1(I),"^",3)
+50 SET X=FIN
SET X2=0
DO COMMA^%DTC
WRITE ?112,X
SET FTO=FTO+FIN
SET FIN=0
+51 WRITE !,?15,"Domicillary ",?61
+52 FOR I=1:1:4
SET X=$PIECE(T1(I),"^",4)
SET X2=0
DO COMMA^%DTC
WRITE X
SET FIN=FIN+$PIECE(T1(I),"^",4)
+53 SET X=FIN
SET X2=0
DO COMMA^%DTC
WRITE ?112,X
SET FTO=FTO+FIN
SET FIN=0
+54 WRITE !,?15,"Total Inpatient Days ",?61
+55 FOR I=1:1:4
SET X=$PIECE(T1(I),"^",5)
SET X2=0
DO COMMA^%DTC
WRITE X
+56 SET X=FTO
SET X2=0
DO COMMA^%DTC
WRITE ?112,X
+57 WRITE !!!,?13,"OUTPATIENTS TREATED",!?15,"Hospital Clinic ",?61
+58 FOR I=1:1:4
SET X=$PIECE(T1(5),"^",I)
SET X2=0
DO COMMA^%DTC
WRITE X
SET FIN=FIN+$PIECE(T1(5),"^",I)
+59 SET X=FIN
SET X2=0
DO COMMA^%DTC
WRITE ?112,X
SET FIN=0
+60 SET (CT,Z)=0
FOR K=0:0
SET Z=$ORDER(T2(Z))
if Z=""
QUIT
SET CT=CT+1
Begin DoDot:1
+61 WRITE !,?15,"Satellite Location ",CT," ",Z,?61
+62 FOR J=1:1:4
SET X=$PIECE(T2(Z),"^",J)
SET X2=0
DO COMMA^%DTC
WRITE X
+63 SET X=$PIECE(T2(Z),"^",5)
SET X2=0
DO COMMA^%DTC
WRITE ?112,X
+64 QUIT
End DoDot:1
+65 WRITE !,?15,"Total Outpatients Treated ",?61
+66 FOR I=1:1:4
SET X=$PIECE(T1(6),"^",I)
SET X2=0
DO COMMA^%DTC
WRITE X
SET FIN=FIN+$PIECE(T1(6),"^",I)
+67 SET X=FIN
SET X2=0
DO COMMA^%DTC
WRITE ?112,X
SET FIN=0
+68 if $Y'<LIN
DO HDR^FHADRPT
DO HDR2
+69 WRITE !!!!?13,"SERVED MEALS SUMMARY",!!?65,"1st Qtr 2nd Qtr 3rd Qtr 4th Qtr Yearly"
+70 WRITE !!?15,"Total Served Meals",?61
+71 FOR I=1:1:4
SET X=$PIECE(T1(I),"^",1)
SET X2=0
DO COMMA^%DTC
WRITE X
SET FIN=FIN+$PIECE(T1(I),"^",1)
+72 SET X=FIN
SET X2=0
DO COMMA^%DTC
WRITE ?112,X
+73 WRITE !,?15,"Average Daily Meals",?61
SET FIN=0
+74 FOR I=1:1:4
SET X=$SELECT(+TD(I)'<1:$PIECE(T1(I),"^",1)/TD(I),1:"")
SET $PIECE(AMS,"^",I)=X
SET X2=0
SET FIN=FIN+$PIECE(T1(I),"^",1)
SET YD=YD+TD(I)
DO COMMA^%DTC
WRITE X
+75 SET X=$SELECT(YD'<1:FIN/YD,1:"")
SET X2=0
DO COMMA^%DTC
WRITE ?112,X
+76 KILL N,T1,T2,TD
QUIT
HDR1 ; Print heading for Facility Workload
+1 if $Y'<(LIN-20)
DO HDR^FHADRPT
+2 WRITE !!!?13,"S E C T I O N II F A C I L I T Y W O R K L O A D S T A T I S T I C S"
+3 WRITE !!!!,?13,"INPATIENT DAYS OF CARE"
WRITE ?65,"1st Qtr 2nd Qtr 3rd Qtr 4th Qtr YTD Total"
QUIT
HDR2 ; Print Heading for Workload Statistics
+1 if $Y'<(LIN-14)
DO HDR^FHADRPT
+2 WRITE !!!!!!?13,"S E C T I O N III D I E T E T I C W O R K L O A D S T A T I S T I C S"
+3 QUIT
