FHNO6.m

FHNO6 ; HISC/REL/NCA - Supplemental Feeding Costs ;2/13/95  13:32 

 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53

 ;3/7/06 -P5- added outpatient SFs.

 W @IOF,!!?27,"SUPPLEMENTAL FEEDING COSTS",!!

D0 R !!,"Select by S=SUPPLEMENTAL FEEDING SITE or W=WARD: ",XX:DTIME G:'$T!("^"[XX) KIL

 I XX'?1U!("SW"'[XX) W *7," Enter S or W" G D0

 I XX="S" S WRD=$O(^FH(119.74,0)) I WRD'<1,$O(^FH(119.74,WRD))<1 G S0

 I XX="W" S WRD=$O(^FH(119.6,0)) I WRD'<1,$O(^FH(119.6,WRD))<1 G S0

 I XX="S" G D2

F1 R !!,"Select WARD (or ALL): ",X:DTIME G:'$T!("^"[X) KIL I X="ALL" S WRD=0

 E  K DIC S DIC="^FH(119.6,",DIC(0)="EQM" D ^DIC G:Y<1 F1 S WRD=+Y

 G S0

D2 R !!,"Select SUPPLEMENTAL FEEDING SITE (or ALL): ",X:DTIME G:'$T!("^"[X) KIL I X="ALL" S WRD=0

 I X'="ALL" K DIC S DIC="^FH(119.74,",DIC(0)="EMQ" D ^DIC G:Y<1 D2 S WRD=+Y

S0 S X="N" I 'WRD R !!,"SUMMARY only? Y// ",X:DTIME G:'$T!(X="^") KIL S:X="" X="Y" I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7,"  Answer YES or NO" G S0

 S SUM=X?1"Y".E

L0 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL

 I $D(IO("Q")) S FHPGM="Q1^FHNO6",FHLST="XX^WRD^SUM" D EN2^FH G KIL

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

Q1 ; Print Supplemental Feeding Cost Report

 S (FHSUMHD,FHSUM)=0 D NOW^%DTC S DTP=% D DTP^FH S PTIM=DTP,PG=0 K ^TMP($J)

 I 'SUM,'WRD S FHSUM=1

 F KK=0:0 S KK=$O(^FH(119.6,KK)) Q:KK<1  S X0=$G(^(KK,0)) D

 .I XX="W",WRD,WRD'=KK Q

 .I XX="S",WRD,$P(X0,"^",9)'=WRD Q

 .S P0=$P(X0,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0),TNOD=$S(SUM:"0",XX="S":"99~"_$P($G(^FH(119.74,+$P(X0,"^",9),0)),"^",1),1:P0_"~"_$P(X0,"^",1))

 .F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",KK,FHDFN)) Q:FHDFN<1  S ADM=$G(^FHPT("AW",KK,FHDFN)) I ADM>0 D

 ..S $P(^TMP($J,"T",TNOD,0),"^",1)=$P($G(^TMP($J,"T",TNOD,0)),"^",1)+1

 ..I FHSUM S $P(^TMP($J,"FH","GRAND TOTAL",0),"^",1)=$P($G(^TMP($J,"FH","GRAND TOTAL",0)),"^",1)+1

 ..S (NO,Y)="" I $D(^FHPT(FHDFN,"A",ADM,0)) S NO=$P(^(0),"^",7)

 ..Q:'NO  S Y=$G(^FHPT(FHDFN,"A",ADM,"SF",NO,0))

 ..S PD=$P(Y,"^",29) S:PD="" PD="D"

 ..S $P(^TMP($J,"T",TNOD,0),"^",PD'="D"+2)=$P(^TMP($J,"T",TNOD,0),"^",PD'="D"+2)+1

 ..I FHSUM S $P(^TMP($J,"FH","GRAND TOTAL",0),"^",PD'="D"+2)=$P(^TMP($J,"FH","GRAND TOTAL",0),"^",PD'="D"+2)+1

 ..F L=5:2:28 S Z=$P(Y,"^",L),Q=$P(Y,"^",L+1) I Z'="" S:'Q Q=1 S:'$D(^TMP($J,"T",TNOD,Z,PD)) ^TMP($J,"T",TNOD,Z,PD)=0 S ^(PD)=^(PD)+Q I FHSUM D

 ...S:'$D(^TMP($J,"FH","GRAND TOTAL",Z,PD)) ^TMP($J,"FH","GRAND TOTAL",Z,PD)=0 S ^(PD)=^(PD)+Q

 ..Q

 .Q

 ;

 S NAM="" F  S NAM=$O(^FH(118,"B",NAM)) Q:NAM=""  F Z=0:0 S Z=$O(^FH(118,"B",NAM,Z)) Q:Z<1  I $O(^(Z,0))="" S REC=$P($G(^FH(118,Z,0)),"^",7),CU=$P($G(^FH(114,+REC,0)),"^",13),^TMP($J,"P",NAM_"~"_Z)=CU

 S TNOD="" F  S TNOD=$O(^TMP($J,"T",TNOD)) Q:TNOD=""  D

 .S FHOUT=0

 .Q:$O(^TMP($J,"T",TNOD,0))=""  D HDR S (T1,T2)=0

 .S NAM="" F  S NAM=$O(^TMP($J,"P",NAM)) Q:NAM=""  S CU=^(NAM) D

 ..S Z=$P(NAM,"~",2) I '$D(^TMP($J,"T",TNOD,Z)) Q

 ..S A1=$G(^TMP($J,"T",TNOD,Z,"D")),A2=$G(^("T")),T1=A1*CU+T1,T2=A2*CU+T2 D:$Y>(IOSL-8) HDR

 ..W !,$E($P(NAM,"~",1),1,24),?25,$J(CU,7,3),$J(A1,7),$J(A1*CU,8,2),$J(A2,8),$J(A2*CU,8,2),$J(A1+A2,8),$J(A1+A2*CU,8,2) Q

 .D:$Y>(IOSL-13) HDR W !!,"Total",?39,$J(T1,8,2),$J(T2,16,2),$J(T1+T2,16,2)

 .S CTR=$G(^TMP($J,"T",TNOD,0)),WP=$P(CTR,"^",1),WPD=$P(CTR,"^",2),WPT=$P(CTR,"^",3)

 .W !!,"Cost/Patient:",?32,$J(WP,7),?39,$J(T1/WP,8,2),?47,$J(WP,8),?55,$J(T2/WP,8,2),?63,$J(WP,8),?71,$J(T1+T2/WP,8,2)

 .W !,"Cost/Recipient:" W:WPD ?32,$J(WPD,7),?39,$J(T1/WPD,8,2) W:WPT ?47,$J(WPT,8),?55,$J(T2/WPT,8,2) W:(WPD+WPT) ?63,$J(WPD+WPT,8),?71,$J(T1+T2/(WPD+WPT),8,2)

 .W !!,"Recipient %:" W:WPD ?39,$J(WPD/WP*100,8,0) W:WPT ?55,$J(WPT/WP*100,8,0) W:(WPD+WPT) ?71,$J(WPD+WPT/WP*100,8,0) W ! Q

 I FHSUM D GRD

 ;

SFO ;process outpt SFs.

 K ^TMP($J) S (FHSUM,FHSUMHD)=0

 S FHDFNSV="",FHOUT=1

 I 'SUM,'WRD S FHSUM=1

 F FHI=DT-1:0 S FHI=$O(^FHPT("RM",FHI)) Q:(FHI'>0)!(FHI>DT)  F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHI,FHDFN)) Q:FHDFN'>0  D

 .F FHJ=0:0 S FHJ=$O(^FHPT("RM",FHI,FHDFN,FHJ)) Q:FHJ'>0  I ($P($G(^FHPT(FHDFN,"OP",FHJ,0)),U,15)'="C") D

 ..S FHDA15=$G(^FHPT(FHDFN,"OP",FHJ,0))

 ..S FHMEAL=$P(FHDA15,U,4),FHLOC=$P(FHDA15,U,3) Q:'$G(FHLOC)

 ..S FHLOX0=$G(^FH(119.6,FHLOC,0))

 ..I XX="W",WRD,WRD'=FHLOC Q

 ..I XX="S",WRD,$P(FHLOX0,"^",9)'=WRD Q

 ..S P0=$P(FHLOX0,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0),TNOD=$S(SUM:"0",XX="S":"99~"_$P($G(^FH(119.74,+$P(FHLOX0,"^",9),0)),"^",1),1:P0_"~"_$P(FHLOX0,"^",1))

 ..;I FHDFNSV'=FHDFN S $P(^TMP($J,"T",TNOD,0),"^",1)=$P($G(^TMP($J,"T",TNOD,0)),"^",1)+1

 ..S $P(^TMP($J,"T",TNOD,0),"^",1)=$P($G(^TMP($J,"T",TNOD,0)),"^",1)+1

 ..I FHSUM S $P(^TMP($J,"FH","GRAND TOTAL",0),"^",1)=$P($G(^TMP($J,"FH","GRAND TOTAL",0)),"^",1)+1

 ..S:$D(^FHPT(FHDFN,"OP",FHJ,"SF",0)) FHSF=$P(^FHPT(FHDFN,"OP",FHJ,"SF",0),U,3)

 ..Q:'$G(FHSF)

 ..S FHDA15SF=$G(^FHPT(FHDFN,"OP",FHJ,"SF",FHSF,0))

 ..Q:$P(FHDA15SF,U,32)

 ..S PD=$P(FHDA15SF,"^",29) S:PD="" PD="D"

 ..;S $P(^TMP($J,"T",TNOD,0),"^",1)=$P($G(^TMP($J,"T",TNOD,0)),"^",1)+1

 ..S $P(^TMP($J,"T",TNOD,0),"^",PD'="D"+2)=$P(^TMP($J,"T",TNOD,0),"^",PD'="D"+2)+1

 ..I FHSUM S $P(^TMP($J,"FH","GRAND TOTAL",0),"^",PD'="D"+2)=$P(^TMP($J,"FH","GRAND TOTAL",0),"^",PD'="D"+2)+1

 ..F L=5:2:28 S Z=$P(FHDA15SF,"^",L),Q=$P(FHDA15SF,"^",L+1) I Z'="" S:'Q Q=1 S:'$D(^TMP($J,"T",TNOD,Z,PD)) ^TMP($J,"T",TNOD,Z,PD)=0 S ^(PD)=^(PD)+Q I FHSUM D

 ...S:'$D(^TMP($J,"FH","GRAND TOTAL",Z,PD)) ^TMP($J,"FH","GRAND TOTAL",Z,PD)=0 S ^(PD)=^(PD)+Q

 ..S FHDFNSV=FHDFN

 ;

 S NAM="" F  S NAM=$O(^FH(118,"B",NAM)) Q:NAM=""  F Z=0:0 S Z=$O(^FH(118,"B",NAM,Z)) Q:Z<1  I $O(^(Z,0))="" S REC=$P($G(^FH(118,Z,0)),"^",7),CU=$P($G(^FH(114,+REC,0)),"^",13),^TMP($J,"P",NAM_"~"_Z)=CU

 S TNOD="" F  S TNOD=$O(^TMP($J,"T",TNOD)) Q:TNOD=""  D

 .Q:$O(^TMP($J,"T",TNOD,0))=""  D HDR S (T1,T2)=0

 .S NAM="" F  S NAM=$O(^TMP($J,"P",NAM)) Q:NAM=""  S CU=^(NAM) D

 ..S Z=$P(NAM,"~",2) I '$D(^TMP($J,"T",TNOD,Z)) Q

 ..S A1=$G(^TMP($J,"T",TNOD,Z,"D")),A2=$G(^("T")),T1=A1*CU+T1,T2=A2*CU+T2 D:$Y>(IOSL-8) HDR

 ..W !,$E($P(NAM,"~",1),1,24),?25,$J(CU,7,3),$J(A1,7),$J(A1*CU,8,2),$J(A2,8),$J(A2*CU,8,2),$J(A1+A2,8),$J(A1+A2*CU,8,2) Q

 .D:$Y>(IOSL-13) HDR W !!,"Total",?39,$J(T1,8,2),$J(T2,16,2),$J(T1+T2,16,2)

 .S CTR=$G(^TMP($J,"T",TNOD,0)),WP=$P(CTR,"^",1),WPD=$P(CTR,"^",2),WPT=$P(CTR,"^",3)

 .W !!,"SF Cost/Patient Meal:",?32,$J(WP,7),?39,$J(T1/WP,8,2),?47,$J(WP,8),?55,$J(T2/WP,8,2),?63,$J(WP,8),?71,$J(T1+T2/WP,8,2)

 .W !,"SF Cost/Recipient Meal:" W:WPD ?32,$J(WPD,7),?39,$J(T1/WPD,8,2) W:WPT ?47,$J(WPT,8),?55,$J(T2/WPT,8,2) W:(WPD+WPT) ?63,$J(WPD+WPT,8),?71,$J(T1+T2/(WPD+WPT),8,2)

 .W !!,"Recipient Meal %:" W:WPD ?39,$J(WPD/WP*100,8,0) W:WPT ?55,$J(WPT/WP*100,8,0) W:(WPD+WPT) ?71,$J(WPD+WPT/WP*100,8,0) W ! Q

 I FHSUM D OGRD

 Q

GRD S NAM="" F  S NAM=$O(^FH(118,"B",NAM)) Q:NAM=""  F Z=0:0 S Z=$O(^FH(118,"B",NAM,Z)) Q:Z<1  I $O(^(Z,0))="" S REC=$P($G(^FH(118,Z,0)),"^",7),CU=$P($G(^FH(114,+REC,0)),"^",13),^TMP($J,"P",NAM_"~"_Z)=CU

 S FHSUMHD=1

 S TNOD="" F  S TNOD=$O(^TMP($J,"FH",TNOD)) Q:TNOD=""  D

 .S FHOUT=0

 .Q:$O(^TMP($J,"FH",TNOD,0))=""  D HDR S (T1,T2)=0

 .S NAM="" F  S NAM=$O(^TMP($J,"P",NAM)) Q:NAM=""  S CU=^(NAM) D

 ..S Z=$P(NAM,"~",2) I '$D(^TMP($J,"FH",TNOD,Z)) Q

 ..S A1=$G(^TMP($J,"FH",TNOD,Z,"D")),A2=$G(^("T")),T1=A1*CU+T1,T2=A2*CU+T2 D:$Y>(IOSL-8) HDR

 ..W !,$E($P(NAM,"~",1),1,24),?25,$J(CU,7,3),$J(A1,7),$J(A1*CU,8,2),$J(A2,8),$J(A2*CU,8,2),$J(A1+A2,8),$J(A1+A2*CU,8,2) Q

 .D:$Y>(IOSL-13) HDR W !!,"Grand Total",?39,$J(T1,8,2),$J(T2,16,2),$J(T1+T2,16,2)

 .S CTR=$G(^TMP($J,"FH",TNOD,0)),WP=$P(CTR,"^",1),WPD=$P(CTR,"^",2),WPT=$P(CTR,"^",3)

 .W !!,"Cost/Patient:",?32,$J(WP,7),?39,$J(T1/WP,8,2),?47,$J(WP,8),?55,$J(T2/WP,8,2),?63,$J(WP,8),?71,$J(T1+T2/WP,8,2)

 .W !,"Cost/Recipient:" W:WPD ?32,$J(WPD,7),?39,$J(T1/WPD,8,2) W:WPT ?47,$J(WPT,8),?55,$J(T2/WPT,8,2) W:(WPD+WPT) ?63,$J(WPD+WPT,8),?71,$J(T1+T2/(WPD+WPT),8,2)

 .W !!,"Recipient %:" W:WPD ?39,$J(WPD/WP*100,8,0) W:WPT ?55,$J(WPT/WP*100,8,0) W:(WPD+WPT) ?71,$J(WPD+WPT/WP*100,8,0) W ! Q

 Q

 ;

OGRD S NAM="" F  S NAM=$O(^FH(118,"B",NAM)) Q:NAM=""  F Z=0:0 S Z=$O(^FH(118,"B",NAM,Z)) Q:Z<1  I $O(^(Z,0))="" S REC=$P($G(^FH(118,Z,0)),"^",7),CU=$P($G(^FH(114,+REC,0)),"^",13),^TMP($J,"P",NAM_"~"_Z)=CU

 S FHSUMHD=1

 S TNOD="" F  S TNOD=$O(^TMP($J,"FH",TNOD)) Q:TNOD=""  D

 .Q:$O(^TMP($J,"FH",TNOD,0))=""  D HDR S (T1,T2)=0

 .S NAM="" F  S NAM=$O(^TMP($J,"P",NAM)) Q:NAM=""  S CU=^(NAM) D

 ..S Z=$P(NAM,"~",2) I '$D(^TMP($J,"FH",TNOD,Z)) Q

 ..S A1=$G(^TMP($J,"FH",TNOD,Z,"D")),A2=$G(^("T")),T1=A1*CU+T1,T2=A2*CU+T2 D:$Y>(IOSL-8) HDR

 ..W !,$E($P(NAM,"~",1),1,24),?25,$J(CU,7,3),$J(A1,7),$J(A1*CU,8,2),$J(A2,8),$J(A2*CU,8,2),$J(A1+A2,8),$J(A1+A2*CU,8,2) Q

 .D:$Y>(IOSL-13) HDR W !!,"Grand Total",?39,$J(T1,8,2),$J(T2,16,2),$J(T1+T2,16,2)

 .S CTR=$G(^TMP($J,"FH",TNOD,0)),WP=$P(CTR,"^",1),WPD=$P(CTR,"^",2),WPT=$P(CTR,"^",3)

 .W !!,"SF Cost/Patient Meal:",?32,$J(WP,7),?39,$J(T1/WP,8,2),?47,$J(WP,8),?55,$J(T2/WP,8,2),?63,$J(WP,8),?71,$J(T1+T2/WP,8,2)

 .W !,"SF Cost/Recipient Meal:" W:WPD ?32,$J(WPD,7),?39,$J(T1/WPD,8,2) W:WPT ?47,$J(WPT,8),?55,$J(T2/WPT,8,2) W:(WPD+WPT) ?63,$J(WPD+WPT,8),?71,$J(T1+T2/(WPD+WPT),8,2)

 .W !!,"Recipient Meal %:" W:WPD ?39,$J(WPD/WP*100,8,0) W:WPT ?55,$J(WPT/WP*100,8,0) W:(WPD+WPT) ?71,$J(WPD+WPT/WP*100,8,0) W ! Q

 Q

 ;

HDR ; Print Header

 W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1

 W !,PTIM,!!?11,"S U P P L E M E N T A L   F E E D I N G   C O S T S",?73,"Page ",PG

 W !!,$S(FHOUT=1:"***OUTPATIENT***",1:"***INPATIENT***")

 I 'FHSUMHD S Y=$S(SUM:"CONSOLIDATED",1:$P(TNOD,"~",2)) W ?(80-$L(Y)\2),Y

 I FHSUMHD S Y="GRAND TOTAL" W ?(80-$L(Y)\2),Y

 W !!?38,"DIETARY",?52,"THERAPEUTIC",?71,"TOTAL",!,"Supplemental Feeding",?28,"Cost    Qty   Total     Qty   Total     Qty   Total",! Q

KIL K ^TMP($J) G KILL^XUSCLEAN

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHNO6   9751     printed  Feb 18, 2025@23:18:45                                                                                                                                                                                                       Page 2

FHNO6     ; HISC/REL/NCA - Supplemental Feeding Costs ;2/13/95  13:32 

 +1       ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53

 +2       ;3/7/06 -P5- added outpatient SFs.

 +3        WRITE @IOF,!!?27,"SUPPLEMENTAL FEEDING COSTS",!!

D0         READ !!,"Select by S=SUPPLEMENTAL FEEDING SITE or W=WARD: ",XX:DTIME

           if '$TEST!("^"[XX)

               GOTO KIL

 +1        IF XX'?1U!("SW"'[XX)

               WRITE *7," Enter S or W"

               GOTO D0

 +2        IF XX="S"

               SET WRD=$ORDER(^FH(119.74,0))

               IF WRD'<1

                   IF $ORDER(^FH(119.74,WRD))<1

                       GOTO S0

 +3        IF XX="W"

               SET WRD=$ORDER(^FH(119.6,0))

               IF WRD'<1

                   IF $ORDER(^FH(119.6,WRD))<1

                       GOTO S0

 +4        IF XX="S"

               GOTO D2

F1         READ !!,"Select WARD (or ALL): ",X:DTIME

           if '$TEST!("^"[X)

               GOTO KIL

           IF X="ALL"

               SET WRD=0

 +1       IF '$TEST

               KILL DIC

               SET DIC="^FH(119.6,"

               SET DIC(0)="EQM"

               DO ^DIC

               if Y<1

                   GOTO F1

               SET WRD=+Y

 +2        GOTO S0

D2         READ !!,"Select SUPPLEMENTAL FEEDING SITE (or ALL): ",X:DTIME

           if '$TEST!("^"[X)

               GOTO KIL

           IF X="ALL"

               SET WRD=0

 +1        IF X'="ALL"

               KILL DIC

               SET DIC="^FH(119.74,"

               SET DIC(0)="EMQ"

               DO ^DIC

               if Y<1

                   GOTO D2

               SET WRD=+Y

S0         SET X="N"

           IF 'WRD

               READ !!,"SUMMARY only? Y// ",X:DTIME

               if '$TEST!(X="^")

                   GOTO KIL

               if X=""

                   SET X="Y"

               IF $PIECE("YES",X,1)'=""

                   IF $PIECE("NO",X,1)'=""

                       WRITE *7,"  Answer YES or NO"

                       GOTO S0

 +1        SET SUM=X?1"Y".E

L0         WRITE !

           KILL IOP,%ZIS

           SET %ZIS("A")="Select LIST Printer: "

           SET %ZIS="MQ"

           DO ^%ZIS

           KILL %ZIS,IOP

           if POP

               GOTO KIL

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

               SET FHPGM="Q1^FHNO6"

               SET FHLST="XX^WRD^SUM"

               DO EN2^FH

               GOTO KIL

 +2        USE IO

           DO Q1

           DO ^%ZISC

           KILL %ZIS,IOP

           GOTO KIL

Q1        ; Print Supplemental Feeding Cost Report

 +1        SET (FHSUMHD,FHSUM)=0

           DO NOW^%DTC

           SET DTP=%

           DO DTP^FH

           SET PTIM=DTP

           SET PG=0

           KILL ^TMP($JOB)

 +2        IF 'SUM

               IF 'WRD

                   SET FHSUM=1

 +3        FOR KK=0:0

               SET KK=$ORDER(^FH(119.6,KK))

               if KK<1

                   QUIT 

               SET X0=$GET(^(KK,0))

               Begin DoDot:1

 +4                IF XX="W"

                       IF WRD

                           IF WRD'=KK

                               QUIT 

 +5                IF XX="S"

                       IF WRD

                           IF $PIECE(X0,"^",9)'=WRD

                               QUIT 

 +6                SET P0=$PIECE(X0,"^",4)

                   SET P0=$SELECT(P0<1:99,P0<10:"0"_P0,1:P0)

                   SET TNOD=$SELECT(SUM:"0",XX="S":"99~"_$PIECE($GET(^FH(119.74,+$PIECE(X0,"^",9),0)),"^",1),1:P0_"~"_$PIECE(X0,"^",1))

 +7                FOR FHDFN=0:0

                       SET FHDFN=$ORDER(^FHPT("AW",KK,FHDFN))

                       if FHDFN<1

                           QUIT 

                       SET ADM=$GET(^FHPT("AW",KK,FHDFN))

                       IF ADM>0

                           Begin DoDot:2

 +8                            SET $PIECE(^TMP($JOB,"T",TNOD,0),"^",1)=$PIECE($GET(^TMP($JOB,"T",TNOD,0)),"^",1)+1

 +9                            IF FHSUM

                                   SET $PIECE(^TMP($JOB,"FH","GRAND TOTAL",0),"^",1)=$PIECE($GET(^TMP($JOB,"FH","GRAND TOTAL",0)),"^",1)+1

 +10                           SET (NO,Y)=""

                               IF $DATA(^FHPT(FHDFN,"A",ADM,0))

                                   SET NO=$PIECE(^(0),"^",7)

 +11                           if 'NO

                                   QUIT 

                               SET Y=$GET(^FHPT(FHDFN,"A",ADM,"SF",NO,0))

 +12                           SET PD=$PIECE(Y,"^",29)

                               if PD=""

                                   SET PD="D"

 +13                           SET $PIECE(^TMP($JOB,"T",TNOD,0),"^",PD'="D"+2)=$PIECE(^TMP($JOB,"T",TNOD,0),"^",PD'="D"+2)+1

 +14                           IF FHSUM

                                   SET $PIECE(^TMP($JOB,"FH","GRAND TOTAL",0),"^",PD'="D"+2)=$PIECE(^TMP($JOB,"FH","GRAND TOTAL",0),"^",PD'="D"+2)+1

 +15                           FOR L=5:2:28

                                   SET Z=$PIECE(Y,"^",L)

                                   SET Q=$PIECE(Y,"^",L+1)

                                   IF Z'=""

                                       if 'Q

                                           SET Q=1

                                       if '$DATA(^TMP($JOB,"T",TNOD,Z,PD))

                                           SET ^TMP($JOB,"T",TNOD,Z,PD)=0

                                       SET ^(PD)=^(PD)+Q

                                       IF FHSUM

                                           Begin DoDot:3

 +16                                           if '$DATA(^TMP($JOB,"FH","GRAND TOTAL",Z,PD))

                                                   SET ^TMP($JOB,"FH","GRAND TOTAL",Z,PD)=0

                                               SET ^(PD)=^(PD)+Q

                                           End DoDot:3

 +17                           QUIT 

                           End DoDot:2

 +18               QUIT 

               End DoDot:1

 +19      ;

 +20       SET NAM=""

           FOR 

               SET NAM=$ORDER(^FH(118,"B",NAM))

               if NAM=""

                   QUIT 

               FOR Z=0:0

                   SET Z=$ORDER(^FH(118,"B",NAM,Z))

                   if Z<1

                       QUIT 

                   IF $ORDER(^(Z,0))=""

                       SET REC=$PIECE($GET(^FH(118,Z,0)),"^",7)

                       SET CU=$PIECE($GET(^FH(114,+REC,0)),"^",13)

                       SET ^TMP($JOB,"P",NAM_"~"_Z)=CU

 +21       SET TNOD=""

           FOR 

               SET TNOD=$ORDER(^TMP($JOB,"T",TNOD))

               if TNOD=""

                   QUIT 

               Begin DoDot:1

 +22               SET FHOUT=0

 +23               if $ORDER(^TMP($JOB,"T",TNOD,0))=""

                       QUIT 

                   DO HDR

                   SET (T1,T2)=0

 +24               SET NAM=""

                   FOR 

                       SET NAM=$ORDER(^TMP($JOB,"P",NAM))

                       if NAM=""

                           QUIT 

                       SET CU=^(NAM)

                       Begin DoDot:2

 +25                       SET Z=$PIECE(NAM,"~",2)

                           IF '$DATA(^TMP($JOB,"T",TNOD,Z))

                               QUIT 

 +26                       SET A1=$GET(^TMP($JOB,"T",TNOD,Z,"D"))

                           SET A2=$GET(^("T"))

                           SET T1=A1*CU+T1

                           SET T2=A2*CU+T2

                           if $Y>(IOSL-8)

                               DO HDR

 +27                       WRITE !,$EXTRACT($PIECE(NAM,"~",1),1,24),?25,$JUSTIFY(CU,7,3),$JUSTIFY(A1,7),$JUSTIFY(A1*CU,8,2),$JUSTIFY(A2,8),$JUSTIFY(A2*CU,8,2),$JUSTIFY(A1+A2,8),$JUSTIFY(A1+A2*CU,8,2)

                           QUIT 

                       End DoDot:2

 +28               if $Y>(IOSL-13)

                       DO HDR

                   WRITE !!,"Total",?39,$JUSTIFY(T1,8,2),$JUSTIFY(T2,16,2),$JUSTIFY(T1+T2,16,2)

 +29               SET CTR=$GET(^TMP($JOB,"T",TNOD,0))

                   SET WP=$PIECE(CTR,"^",1)

                   SET WPD=$PIECE(CTR,"^",2)

                   SET WPT=$PIECE(CTR,"^",3)

 +30               WRITE !!,"Cost/Patient:",?32,$JUSTIFY(WP,7),?39,$JUSTIFY(T1/WP,8,2),?47,$JUSTIFY(WP,8),?55,$JUSTIFY(T2/WP,8,2),?63,$JUSTIFY(WP,8),?71,$JUSTIFY(T1+T2/WP,8,2)

 +31               WRITE !,"Cost/Recipient:"

                   if WPD

                       WRITE ?32,$JUSTIFY(WPD,7),?39,$JUSTIFY(T1/WPD,8,2)

                   if WPT

                       WRITE ?47,$JUSTIFY(WPT,8),?55,$JUSTIFY(T2/WPT,8,2)

                   if (WPD+WPT)

                       WRITE ?63,$JUSTIFY(WPD+WPT,8),?71,$JUSTIFY(T1+T2/(WPD+WPT),8,2)

 +32               WRITE !!,"Recipient %:"

                   if WPD

                       WRITE ?39,$JUSTIFY(WPD/WP*100,8,0)

                   if WPT

                       WRITE ?55,$JUSTIFY(WPT/WP*100,8,0)

                   if (WPD+WPT)

                       WRITE ?71,$JUSTIFY(WPD+WPT/WP*100,8,0)

                   WRITE !

                   QUIT 

               End DoDot:1

 +33       IF FHSUM

               DO GRD

 +34      ;

SFO       ;process outpt SFs.

 +1        KILL ^TMP($JOB)

           SET (FHSUM,FHSUMHD)=0

 +2        SET FHDFNSV=""

           SET FHOUT=1

 +3        IF 'SUM

               IF 'WRD

                   SET FHSUM=1

 +4        FOR FHI=DT-1:0

               SET FHI=$ORDER(^FHPT("RM",FHI))