ACHSDNS1 ; IHS/ITSC/PMF - DENIAL STATISTICS REPORT (2/2) ; [ 10/31/2003 11:46 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6**;JUNE 11, 2001
;ACHS*3.1*6 4.24.04 IHS/SET/FCJ MULTIPLE CHANGES TO PRINT 3 NEW REPORT
; REPORTS BY DOS, COMMUNITY AND PAYOR
;S $P(^TMP($J,"ACHSDNS",0),U,1,2)="^ACHSDNS1"
D BRPT^ACHSFU
K ^TMP($J,"ACHSDNS",0,"ACHSQIO")
S ACHSRES="",ACHSPART=1,(ACHS(3),ACHS(4),ACHS(5))=0
S Y=ACHSBDT X ^DD("DD") S ACHS("BDT")=Y,Y=ACHSEDT X ^DD("DD")
S ACHS("EDT")=Y,ACHST1=$$C^XBFUNC("For the period "_ACHS("BDT")_" through "_ACHS("EDT"),80)
D:ACHSRPT<3 HDR^ACHSDNS G:'$D(^DD(9002071.01,110,0)) END
F I=1:1 Q:$P($P(^DD(9002071.01,110,0),U,3),";",I)="" S ACHS=$P($P(^(0),U,3),";",I),ACHS($P(ACHS,":"))=$P(ACHS,":",2)
S ACHSSUB=$S(ACHSRPT<3:"A1",ACHSRPT=3:"A3",ACHSRPT=4:"A4")
A ; Main loop.
I ACHSRPT>2 S ACHSBM=ACHSBM+5 D @ACHSSUB G K
S ACHSRES=$O(^TMP($J,"ACHSDNS",ACHSRES))
I ACHSRES'="0" G TOTALS:+ACHSRES=0,A:'$D(^ACHSDENS(ACHSRES,0))
S ACHSTYPE="",ACHSTOT1=+$P(^TMP($J,"ACHSDNS",ACHSRES,"TOTAL"),U),ACHSTOT2=+$P(^("TOTAL"),U,2)
I ACHSRES'="0" W $P(^ACHSDENS(ACHSRES,0),U),! S ACHS(5)=ACHS(5)+1
;
A6 D @ACHSSUB
W !,ACHS("-"),!
I $Y>ACHSBM D RTRN^ACHS G K:$D(DUOUT)!$D(DTOUT) D HDR^ACHSDNS
G A
;
TOTALS ;
S ACHSPART=2
I ACHS(5)<1 W !,"(No denials for standard reasons are on file for this time period.)" G NEED
D RTRN^ACHS
G K:$D(DUOUT)!$D(DTOUT)
D HDR^ACHSDNS
S ACHSTYPE="",ACHSRES="TOTAL" W !,"TOTALS.........",!! S ACHSTOT1=$P(^TMP($J,"ACHSDNS","TOTAL","TOTAL"),U),ACHSTOT2=$P(^("TOTAL"),U,2)
D @ACHSSUB
S ACHS(1)=$P(^TMP($J,"ACHSDNS","TOTAL","TOTAL"),U),ACHS(2)=$P(^("TOTAL"),U,2),X=ACHS(2),X2="2$" D COMMA^%DTC W !,ACHS("="),!,"GRAND TOTALS:",?42,$J(ACHS(1),6),?59,X,!,ACHS("="),!
;
NEED ;
S ACHSPART=3
D RTRN^ACHS
G K:$D(DUOUT)!$D(DTOUT)
D HDR^ACHSDNS S ACHSTYPE="",ACHSRES="SURG" W !,"UNMET NEED: SURGICAL"
I '$D(^TMP($J,"ACHSDNS",ACHSRES)) W " (NONE)" G N1
W !! S ACHSTOT1=$P(^TMP($J,"ACHSDNS","SURG","TOTAL"),U),ACHSTOT2=$P(^("TOTAL"),U,2),ACHS(3)=ACHSTOT1,ACHS(4)=ACHSTOT2
D @ACHSSUB
;
N1 ;
S ACHSRES="NONSURG",ACHSTYPE="" W !,ACHS("-"),!!,"UNMET NEED: NON-SURGICAL"
I '$D(^TMP($J,"ACHSDNS",ACHSRES)) W " (NONE)" G NEEDTOT
W !! S ACHSTOT1=$P(^TMP($J,"ACHSDNS","NONSURG","TOTAL"),U),ACHSTOT2=$P(^("TOTAL"),U,2),ACHS(3)=ACHS(3)+ACHSTOT1,ACHS(4)=ACHS(4)+ACHSTOT2
D @ACHSSUB
;
NEEDTOT ;
W !,ACHS("="),!
I ACHS(3) S X=ACHS(4),X2="2$" D COMMA^%DTC W "GRAND TOTALS:",?42,$J(ACHS(3),6),?59,X,!,ACHS("="),!
;
END ; Kill vars, do ERPT, quit.
D RTRN^ACHS W @IOF
K ;
K ACHSQUIT,ACHSCOM,ACHSINS,ACHSST,ACHSSUB,ACHSRPT
K A,ACHSISDT,ACHSPART,ACHSRES,ACHSTOT1,ACHSTOT2,ACHSTYPE,DA,ZTSK
D ERPT^ACHS
Q
;
A1 ;PRINT DATE OF SERVICE OR DATE OF ISSUE REPORT
;
S ACHSTYPE=$O(^TMP($J,"ACHSDNS",ACHSRES,ACHSTYPE)) Q:ACHSTYPE=""!(ACHSTYPE="TOTAL") S ACHS(1)=+$P(^(ACHSTYPE),U),ACHS(2)=+$P(^(ACHSTYPE),U,2)
S ACHS(ACHSTYPE)=$G(ACHS(ACHSTYPE)) I ACHS(ACHSTYPE)="" S ACHS(ACHSTYPE)="UNKNOWN TYPE"
W ?41-$L(ACHS(ACHSTYPE)),ACHS(ACHSTYPE),":",?42,$J(ACHS(1),6),$J(ACHS(1)/$S(ACHSTOT1:ACHSTOT1,1:1)*100,6,1),"%"
S ACHSTOT2=$G(ACHSTOT2)
S X=ACHS(2),X2=2 D COMMA^%DTC W ?59,X,$J(ACHS(2)/$S(ACHSTOT2:ACHSTOT2,1:1)*100,6,1),"%",!
G A1
A3 ;PRINT COMMUNITY REPORT
S ACHSCOM="",ACHSQUIT=0
F S ACHSCOM=$O(^TMP($J,"ACHSDNS","X",ACHSCOM)) Q:ACHSCOM="" D Q:ACHSQUIT=1
.Q:(ACHSCOM="TOTAL")!(ACHSCOM="TOTALD")
.S ACHSST=""
.F S ACHSST=$O(^TMP($J,"ACHSDNS","X",ACHSCOM,ACHSST)) Q:ACHSST'?1N.N D Q:ACHSQUIT=1
..D HDR^ACHSDNS
..S ACHSRES=""
..F S ACHSRES=$O(^TMP($J,"ACHSDNS","X",ACHSCOM,ACHSST,ACHSRES)) Q:ACHSRES'?1N.N D Q:ACHSQUIT=1
...S ACHSTYPE="" F S ACHSTYPE=$O(^TMP($J,"ACHSDNS","X",ACHSCOM,ACHSST,ACHSRES,ACHSTYPE)) Q:ACHSTYPE="" D
....S ACHS(ACHSTYPE)=$G(ACHS(ACHSTYPE)) I ACHS(ACHSTYPE)="" S ACHS(ACHSTYPE)="UNKNOWN TYPE"
....S ACHS(1)=+$P(^TMP($J,"ACHSDNS",ACHSRES,ACHSCOM,ACHSST,ACHSTYPE),U),ACHS(2)=+$P(^(ACHSTYPE),U,2)
....D PRT
..Q:ACHSQUIT=1
..S ACHSTYPE=""
..F S ACHSTYPE=$O(^TMP($J,"ACHSDNS","TOTAL",ACHSCOM,ACHSST,ACHSTYPE)) Q:ACHSTYPE="" D
...S ACHS(1)=$P(^TMP($J,"ACHSDNS","TOTAL",ACHSCOM,ACHSST,ACHSTYPE),U),ACHS(2)=$P(^(ACHSTYPE),U,2)
...S ACHS(ACHSTYPE)=$G(ACHS(ACHSTYPE)) I ACHS(ACHSTYPE)="" S ACHS(ACHSTYPE)="UNKNOWN TYPE"
...D PRTOT
..D GRNDTOT
Q
A4 ;PRINT OTHER RESOURCE REPORT....
S ACHSINS="",ACHSQUIT=0
F S ACHSINS=$O(^TMP($J,"ACHSDNS","X",ACHSINS)) Q:ACHSINS="TOTAL" D Q:ACHSQUIT=1
.D HDR^ACHSDNS
.S ACHSRES=""
.F S ACHSRES=$O(^TMP($J,"ACHSDNS","X",ACHSINS,ACHSRES)) Q:ACHSRES'?1N.N D Q:ACHSQUIT=1
..S ACHSTYPE=""
..F S ACHSTYPE=$O(^TMP($J,"ACHSDNS","X",ACHSINS,ACHSRES,ACHSTYPE)) Q:ACHSTYPE="" D
...S ACHS(ACHSTYPE)=$G(ACHS(ACHSTYPE)) I ACHS(ACHSTYPE)="" S ACHS(ACHSTYPE)="UNKNOWN TYPE"
...S ACHS(1)=+$P(^TMP($J,"ACHSDNS",ACHSRES,ACHSINS,ACHSTYPE),U),ACHS(2)=+$P(^(ACHSTYPE),U,2)
...D PRT
.;PRINT TOTALS
.S ACHSTYPE=0
.F S ACHSTYPE=$O(^TMP($J,"ACHSDNS","TOTAL",ACHSINS,ACHSTYPE)) Q:ACHSTYPE="" D Q:ACHSQUIT=1
..S ACHS(1)=$P(^TMP($J,"ACHSDNS","TOTAL",ACHSINS,ACHSTYPE),U),ACHS(2)=$P(^(ACHSTYPE),U,2)
..S ACHS(ACHSTYPE)=$G(ACHS(ACHSTYPE)) I ACHS(ACHSTYPE)="" S ACHS(ACHSTYPE)="UNKNOWN TYPE"
..D PRTOT
.Q:ACHSQUIT=1
.D GRNDTOT
Q
PRTOT ;PRINT TOTALS FOR COMMUNITY AND PAYOR REPORT
W !,"TOTAL "
S ACHSTOT1=$P(^TMP($J,"ACHSDNS","TOTAL","TOTAL"),U),ACHSTOT2=$P(^("TOTAL"),U,2)
S:ACHSRPT=4 ACHSTOT1=$P(^TMP($J,"ACHSDNS","X","TOTALD"),U)
;W ?41-$L(ACHS(ACHSTYPE)),ACHS(ACHSTYPE),$J(ACHS(1),6),$J(ACHS(1)/$S(ACHSTOT1:ACHSTOT1,1:1)*100,6,1),"%"
W ?41-$L(ACHS(ACHSTYPE)),ACHS(ACHSTYPE),":",?42,$J(ACHS(1),6),$J(ACHS(1)/$S(ACHSTOT1:ACHSTOT1,1:1)*100,6,1),"%"
S X=ACHS(2),X2="2$" D COMMA^%DTC
W ?59,X,$J(ACHS(2)/$S(ACHSTOT2:ACHSTOT2,1:1)*100,6,1),"%",!
Q
GRNDTOT ;
S X=ACHSTOT2,X2="2$" D COMMA^%DTC
W ACHS("="),!,"GRAND TOTALS:"
W ?42,$J(ACHSTOT1,6)
W ?59,X,!,ACHS("="),!
D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT)
Q
PRT ;PRINT TOTALS
S ACHSTOT1=+$P(^TMP($J,"ACHSDNS",ACHSRES,"TOTAL"),U),ACHSTOT2=+$P(^("TOTAL"),U,2)
W !,$P(^ACHSDENS(ACHSRES,0),U),!
W ?41-$L(ACHS(ACHSTYPE)),ACHS(ACHSTYPE),":",?42,$J(ACHS(1),6),$J(ACHS(1)/$S(ACHSTOT1:ACHSTOT1,1:1)*100,6,1),"%"
S ACHSTOT2=$G(ACHSTOT2)
S X=ACHS(2),X2=2 D COMMA^%DTC W ?59,X,$J(ACHS(2)/$S(ACHSTOT2:ACHSTOT2,1:1)*100,6,1),"%",!
W !,ACHS("-"),!
I $Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR^ACHSDNS
Q
ACHSDNS1 ; IHS/ITSC/PMF - DENIAL STATISTICS REPORT (2/2) ; [ 10/31/2003 11:46 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6**;JUNE 11, 2001
+2 ;ACHS*3.1*6 4.24.04 IHS/SET/FCJ MULTIPLE CHANGES TO PRINT 3 NEW REPORT
+3 ; REPORTS BY DOS, COMMUNITY AND PAYOR
+4 ;S $P(^TMP($J,"ACHSDNS",0),U,1,2)="^ACHSDNS1"
+5 DO BRPT^ACHSFU
+6 KILL ^TMP($JOB,"ACHSDNS",0,"ACHSQIO")
+7 SET ACHSRES=""
SET ACHSPART=1
SET (ACHS(3),ACHS(4),ACHS(5))=0
+8 SET Y=ACHSBDT
XECUTE ^DD("DD")
SET ACHS("BDT")=Y
SET Y=ACHSEDT
XECUTE ^DD("DD")
+9 SET ACHS("EDT")=Y
SET ACHST1=$$C^XBFUNC("For the period "_ACHS("BDT")_" through "_ACHS("EDT"),80)
+10 IF ACHSRPT<3
DO HDR^ACHSDNS
IF '$DATA(^DD(9002071.01,110,0))
GOTO END
+11 FOR I=1:1
IF $PIECE($PIECE(^DD(9002071.01,110,0),U,3),";",I)=""
QUIT
SET ACHS=$PIECE($PIECE(^(0),U,3),";",I)
SET ACHS($PIECE(ACHS,":"))=$PIECE(ACHS,":",2)
+12 SET ACHSSUB=$SELECT(ACHSRPT<3:"A1",ACHSRPT=3:"A3",ACHSRPT=4:"A4")
A ; Main loop.
+1 IF ACHSRPT>2
SET ACHSBM=ACHSBM+5
DO @ACHSSUB
GOTO K
+2 SET ACHSRES=$ORDER(^TMP($JOB,"ACHSDNS",ACHSRES))
+3 IF ACHSRES'="0"
IF +ACHSRES=0
GOTO TOTALS
IF '$DATA(^ACHSDENS(ACHSRES,0))
GOTO A
+4 SET ACHSTYPE=""
SET ACHSTOT1=+$PIECE(^TMP($JOB,"ACHSDNS",ACHSRES,"TOTAL"),U)
SET ACHSTOT2=+$PIECE(^("TOTAL"),U,2)
+5 IF ACHSRES'="0"
WRITE $PIECE(^ACHSDENS(ACHSRES,0),U),!
SET ACHS(5)=ACHS(5)+1
+6 ;
A6 DO @ACHSSUB
+1 WRITE !,ACHS("-"),!
+2 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO K
DO HDR^ACHSDNS
+3 GOTO A
+4 ;
TOTALS ;
+1 SET ACHSPART=2
+2 IF ACHS(5)<1
WRITE !,"(No denials for standard reasons are on file for this time period.)"
GOTO NEED
+3 DO RTRN^ACHS
+4 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO K
+5 DO HDR^ACHSDNS
+6 SET ACHSTYPE=""
SET ACHSRES="TOTAL"
WRITE !,"TOTALS.........",!!
SET ACHSTOT1=$PIECE(^TMP($JOB,"ACHSDNS","TOTAL","TOTAL"),U)
SET ACHSTOT2=$PIECE(^("TOTAL"),U,2)
+7 DO @ACHSSUB
+8 SET ACHS(1)=$PIECE(^TMP($JOB,"ACHSDNS","TOTAL","TOTAL"),U)
SET ACHS(2)=$PIECE(^("TOTAL"),U,2)
SET X=ACHS(2)
SET X2="2$"
DO COMMA^%DTC
WRITE !,ACHS("="),!,"GRAND TOTALS:",?42,$JUSTIFY(ACHS(1),6),?59,X,!,ACHS("="),!
+9 ;
NEED ;
+1 SET ACHSPART=3
+2 DO RTRN^ACHS
+3 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO K
+4 DO HDR^ACHSDNS
SET ACHSTYPE=""
SET ACHSRES="SURG"
WRITE !,"UNMET NEED: SURGICAL"
+5 IF '$DATA(^TMP($JOB,"ACHSDNS",ACHSRES))
WRITE " (NONE)"
GOTO N1
+6 WRITE !!
SET ACHSTOT1=$PIECE(^TMP($JOB,"ACHSDNS","SURG","TOTAL"),U)
SET ACHSTOT2=$PIECE(^("TOTAL"),U,2)
SET ACHS(3)=ACHSTOT1
SET ACHS(4)=ACHSTOT2
+7 DO @ACHSSUB
+8 ;
N1 ;
+1 SET ACHSRES="NONSURG"
SET ACHSTYPE=""
WRITE !,ACHS("-"),!!,"UNMET NEED: NON-SURGICAL"
+2 IF '$DATA(^TMP($JOB,"ACHSDNS",ACHSRES))
WRITE " (NONE)"
GOTO NEEDTOT
+3 WRITE !!
SET ACHSTOT1=$PIECE(^TMP($JOB,"ACHSDNS","NONSURG","TOTAL"),U)
SET ACHSTOT2=$PIECE(^("TOTAL"),U,2)
SET ACHS(3)=ACHS(3)+ACHSTOT1
SET ACHS(4)=ACHS(4)+ACHSTOT2
+4 DO @ACHSSUB
+5 ;
NEEDTOT ;
+1 WRITE !,ACHS("="),!
+2 IF ACHS(3)
SET X=ACHS(4)
SET X2="2$"
DO COMMA^%DTC
WRITE "GRAND TOTALS:",?42,$JUSTIFY(ACHS(3),6),?59,X,!,ACHS("="),!
+3 ;
END ; Kill vars, do ERPT, quit.
+1 DO RTRN^ACHS
WRITE @IOF
K ;
+1 KILL ACHSQUIT,ACHSCOM,ACHSINS,ACHSST,ACHSSUB,ACHSRPT
+2 KILL A,ACHSISDT,ACHSPART,ACHSRES,ACHSTOT1,ACHSTOT2,ACHSTYPE,DA,ZTSK
+3 DO ERPT^ACHS
+4 QUIT
+5 ;
A1 ;PRINT DATE OF SERVICE OR DATE OF ISSUE REPORT
+1 ;
+2 SET ACHSTYPE=$ORDER(^TMP($JOB,"ACHSDNS",ACHSRES,ACHSTYPE))
IF ACHSTYPE=""!(ACHSTYPE="TOTAL")
QUIT
SET ACHS(1)=+$PIECE(^(ACHSTYPE),U)
SET ACHS(2)=+$PIECE(^(ACHSTYPE),U,2)
+3 SET ACHS(ACHSTYPE)=$GET(ACHS(ACHSTYPE))
IF ACHS(ACHSTYPE)=""
SET ACHS(ACHSTYPE)="UNKNOWN TYPE"
+4 WRITE ?41-$LENGTH(ACHS(ACHSTYPE)),ACHS(ACHSTYPE),":",?42,$JUSTIFY(ACHS(1),6),$JUSTIFY(ACHS(1)/$SELECT(ACHSTOT1:ACHSTOT1,1:1)*100,6,1),"%"
+5 SET ACHSTOT2=$GET(ACHSTOT2)
+6 SET X=ACHS(2)
SET X2=2
DO COMMA^%DTC
WRITE ?59,X,$JUSTIFY(ACHS(2)/$SELECT(ACHSTOT2:ACHSTOT2,1:1)*100,6,1),"%",!
+7 GOTO A1
A3 ;PRINT COMMUNITY REPORT
+1 SET ACHSCOM=""
SET ACHSQUIT=0
+2 FOR
SET ACHSCOM=$ORDER(^TMP($JOB,"ACHSDNS","X",ACHSCOM))
IF ACHSCOM=""
QUIT
Begin DoDot:1
+3 IF (ACHSCOM="TOTAL")!(ACHSCOM="TOTALD")
QUIT
+4 SET ACHSST=""
+5 FOR
SET ACHSST=$ORDER(^TMP($JOB,"ACHSDNS","X",ACHSCOM,ACHSST))
IF ACHSST'?1N.N
QUIT
Begin DoDot:2
+6 DO HDR^ACHSDNS
+7 SET ACHSRES=""
+8 FOR
SET ACHSRES=$ORDER(^TMP($JOB,"ACHSDNS","X",ACHSCOM,ACHSST,ACHSRES))
IF ACHSRES'?1N.N
QUIT
Begin DoDot:3
+9 SET ACHSTYPE=""
FOR
SET ACHSTYPE=$ORDER(^TMP($JOB,"ACHSDNS","X",ACHSCOM,ACHSST,ACHSRES,ACHSTYPE))
IF ACHSTYPE=""
QUIT
Begin DoDot:4
+10 SET ACHS(ACHSTYPE)=$GET(ACHS(ACHSTYPE))
IF ACHS(ACHSTYPE)=""
SET ACHS(ACHSTYPE)="UNKNOWN TYPE"
+11 SET ACHS(1)=+$PIECE(^TMP($JOB,"ACHSDNS",ACHSRES,ACHSCOM,ACHSST,ACHSTYPE),U)
SET ACHS(2)=+$PIECE(^(ACHSTYPE),U,2)
+12 DO PRT
End DoDot:4
End DoDot:3
IF ACHSQUIT=1
QUIT
+13 IF ACHSQUIT=1
QUIT
+14 SET ACHSTYPE=""
+15 FOR
SET ACHSTYPE=$ORDER(^TMP($JOB,"ACHSDNS","TOTAL",ACHSCOM,ACHSST,ACHSTYPE))
IF ACHSTYPE=""
QUIT
Begin DoDot:3
+16 SET ACHS(1)=$PIECE(^TMP($JOB,"ACHSDNS","TOTAL",ACHSCOM,ACHSST,ACHSTYPE),U)
SET ACHS(2)=$PIECE(^(ACHSTYPE),U,2)
+17 SET ACHS(ACHSTYPE)=$GET(ACHS(ACHSTYPE))
IF ACHS(ACHSTYPE)=""
SET ACHS(ACHSTYPE)="UNKNOWN TYPE"
+18 DO PRTOT
End DoDot:3
+19 DO GRNDTOT
End DoDot:2
IF ACHSQUIT=1
QUIT
End DoDot:1
IF ACHSQUIT=1
QUIT
+20 QUIT
A4 ;PRINT OTHER RESOURCE REPORT....
+1 SET ACHSINS=""
SET ACHSQUIT=0
+2 FOR
SET ACHSINS=$ORDER(^TMP($JOB,"ACHSDNS","X",ACHSINS))
IF ACHSINS="TOTAL"
QUIT
Begin DoDot:1
+3 DO HDR^ACHSDNS
+4 SET ACHSRES=""
+5 FOR
SET ACHSRES=$ORDER(^TMP($JOB,"ACHSDNS","X",ACHSINS,ACHSRES))
IF ACHSRES'?1N.N
QUIT
Begin DoDot:2
+6 SET ACHSTYPE=""
+7 FOR
SET ACHSTYPE=$ORDER(^TMP($JOB,"ACHSDNS","X",ACHSINS,ACHSRES,ACHSTYPE))
IF ACHSTYPE=""
QUIT
Begin DoDot:3
+8 SET ACHS(ACHSTYPE)=$GET(ACHS(ACHSTYPE))
IF ACHS(ACHSTYPE)=""
SET ACHS(ACHSTYPE)="UNKNOWN TYPE"
+9 SET ACHS(1)=+$PIECE(^TMP($JOB,"ACHSDNS",ACHSRES,ACHSINS,ACHSTYPE),U)
SET ACHS(2)=+$PIECE(^(ACHSTYPE),U,2)
+10 DO PRT
End DoDot:3
End DoDot:2
IF ACHSQUIT=1
QUIT
+11 ;PRINT TOTALS
+12 SET ACHSTYPE=0
+13 FOR
SET ACHSTYPE=$ORDER(^TMP($JOB,"ACHSDNS","TOTAL",ACHSINS,ACHSTYPE))
IF ACHSTYPE=""
QUIT
Begin DoDot:2
+14 SET ACHS(1)=$PIECE(^TMP($JOB,"ACHSDNS","TOTAL",ACHSINS,ACHSTYPE),U)
SET ACHS(2)=$PIECE(^(ACHSTYPE),U,2)
+15 SET ACHS(ACHSTYPE)=$GET(ACHS(ACHSTYPE))
IF ACHS(ACHSTYPE)=""
SET ACHS(ACHSTYPE)="UNKNOWN TYPE"
+16 DO PRTOT
End DoDot:2
IF ACHSQUIT=1
QUIT
+17 IF ACHSQUIT=1
QUIT
+18 DO GRNDTOT
End DoDot:1
IF ACHSQUIT=1
QUIT
+19 QUIT
PRTOT ;PRINT TOTALS FOR COMMUNITY AND PAYOR REPORT
+1 WRITE !,"TOTAL "
+2 SET ACHSTOT1=$PIECE(^TMP($JOB,"ACHSDNS","TOTAL","TOTAL"),U)
SET ACHSTOT2=$PIECE(^("TOTAL"),U,2)
+3 IF ACHSRPT=4
SET ACHSTOT1=$PIECE(^TMP($JOB,"ACHSDNS","X","TOTALD"),U)
+4 ;W ?41-$L(ACHS(ACHSTYPE)),ACHS(ACHSTYPE),$J(ACHS(1),6),$J(ACHS(1)/$S(ACHSTOT1:ACHSTOT1,1:1)*100,6,1),"%"
+5 WRITE ?41-$LENGTH(ACHS(ACHSTYPE)),ACHS(ACHSTYPE),":",?42,$JUSTIFY(ACHS(1),6),$JUSTIFY(ACHS(1)/$SELECT(ACHSTOT1:ACHSTOT1,1:1)*100,6,1),"%"
+6 SET X=ACHS(2)
SET X2="2$"
DO COMMA^%DTC
+7 WRITE ?59,X,$JUSTIFY(ACHS(2)/$SELECT(ACHSTOT2:ACHSTOT2,1:1)*100,6,1),"%",!
+8 QUIT
GRNDTOT ;
+1 SET X=ACHSTOT2
SET X2="2$"
DO COMMA^%DTC
+2 WRITE ACHS("="),!,"GRAND TOTALS:"
+3 WRITE ?42,$JUSTIFY(ACHSTOT1,6)
+4 WRITE ?59,X,!,ACHS("="),!
+5 DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+6 QUIT
PRT ;PRINT TOTALS
+1 SET ACHSTOT1=+$PIECE(^TMP($JOB,"ACHSDNS",ACHSRES,"TOTAL"),U)
SET ACHSTOT2=+$PIECE(^("TOTAL"),U,2)
+2 WRITE !,$PIECE(^ACHSDENS(ACHSRES,0),U),!
+3 WRITE ?41-$LENGTH(ACHS(ACHSTYPE)),ACHS(ACHSTYPE),":",?42,$JUSTIFY(ACHS(1),6),$JUSTIFY(ACHS(1)/$SELECT(ACHSTOT1:ACHSTOT1,1:1)*100,6,1),"%"
+4 SET ACHSTOT2=$GET(ACHSTOT2)
+5 SET X=ACHS(2)
SET X2=2
DO COMMA^%DTC
WRITE ?59,X,$JUSTIFY(ACHS(2)/$SELECT(ACHSTOT2:ACHSTOT2,1:1)*100,6,1),"%",!
+6 WRITE !,ACHS("-"),!
+7 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR^ACHSDNS
+8 QUIT
