- 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
