ACHSDNS ; IHS/ITSC/PMF - DENIAL STATISTICS REPORT (1/2) ;7/27/10 16:15
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
;ACHS*3.1*6 4/24/03 IHS/SET/FCJ MULTIPLE CHANGES ADDED TO RUN 2 OTHER
; REPORTS BY DOS, COMMUNITY
; ADDED DEV LINE LABEL
; REQUEST TO SORT BY PAYOR WILL BE INCLUDED IN PATCH 7 BUT
; HAS BEEN STARTED
;ACHS*3.1*7 10/10/03 ITSC/SET/FCJ ADDED ACHSPRT IN LABEL DEV
;ACHS*3.1*18 7/19/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
;
;
SEL D QSEL
S ACHSRPT=$$DIR^ACHS("N^1:3:0","Select",1,"","^D QSEL^ACHSDNS",3)
G:ACHSRPT'?1N.3N K
D A2
Q
A2 ; --- Input date range
S ACHSBDT=$$DATE^ACHS("B","DENIAL STATISTICS")
G K:ACHSBDT<1
S ACHSEDT=$$DATE^ACHS("E","DENIAL STATISTICS")
G A2:ACHSEDT<1
I $$EBB^ACHS(ACHSBDT,ACHSEDT) G A2
S ACHSHAT=""
DEV S %ZIS="OPQ"
D ^%ZIS
I POP D HOME^%ZIS G K
G:'$D(IO("Q")) START
K IO("Q")
I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
;
S ZTRTN="START^ACHSDNS",ZTIO="",ZTDESC="CHS Denial Statistics, "_(ACHSBDT+17000000)_" to "_(ACHSEDT+17000000),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL ; Y2000
;
;ITSC/SET/FCJ ACHS*3.1*7 ADDED ACHSRPT
;F %="ACHSQIO","ACHSBDT","ACHSEDT" S ZTSAVE(%)=""
F %="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRPT" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ;
K ACHS,ACHSBDT,ACHSEDT,ACHSHAT,ACHSQIO,DTOUT,DUOUT,ZTIO,ZTSK
D ^%ZISC
Q
;
START ;EP - TaskMan.
ST ;
N ACHSMPRI
S ACHSISDT=ACHSBDT-1
K ^TMP($J,"ACHSDNS")
A ; --- START OF Loops
S ACHSSUB=$S((ACHSRPT<3):"SET",ACHSRPT=3:"SET3",ACHSRPT=4:"SET4")
DOI ;SORT BY DATE OF ISSUE
I ACHSRPT'=2 D
.F S ACHSISDT=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT)) Q:+ACHSISDT=0!(+ACHSISDT>ACHSEDT) D
..S DA=0,ACHSINST=0
..F S DA=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT,DA)) Q:+DA=0 D
...D B
...S:ACHS("A")'="TOTAL" $P(^TMP($J,"ACHSDNS","X","TOTALD"),U)=+$P($G(^TMP($J,"ACHSDNS","X","TOTALD")),U)+1
DOS ;SORT BY DATE OF SERVICE
I ACHSRPT=2 D
.F S ACHSISDT=$O(^ACHSDEN(DUZ(2),"D","ES",ACHSISDT)) Q:+ACHSISDT=0!(+ACHSISDT>ACHSEDT) D
..S DA=0
..F S DA=$O(^ACHSDEN(DUZ(2),"D","ES",ACHSISDT,DA)) Q:+DA=0 D B
;G:ACHSRPT<4 GRNDTOT
G GRNDTOT
B ; --- Loop thru Denial IENs
Q:'$D(^ACHSDEN(DUZ(2),"D",DA,0))
Q:'$D(^ACHSDEN(DUZ(2),"D",DA,100))
S ACHSTYPE=$P($G(^ACHSDEN(DUZ(2),"D",DA,100)),U,10)
Q:ACHSTYPE']""
Q:$P($G(^ACHSDEN(DUZ(2),"D",DA,0)),U)["#"
D DOLLARS
S ACHSMPRI=$P($G(^ACHSDEN(DUZ(2),"D",DA,400)),U,2)
I ACHSMPRI S ACHSMPRI=$P($G(^ACHSMPRI(ACHSMPRI,0)),U)
E S ACHSMPRI="UNKNOWN"
S ACHS("A")="TOTAL"
D @ACHSSUB
Q:'$G(^ACHSDEN(DUZ(2),"D",DA,250))
S ACHS("A")=$P($G(^ACHSDEN(DUZ(2),"D",DA,250)),U),ACHSREAS=$P($G(^ACHSDENS(+ACHS("A"),0)),U)
D @ACHSSUB
Q
;
GRNDTOT ; --- Compute Grand Total For each Group.
S ACHS=""
G1 ;
F S ACHS=$O(^TMP($J,"ACHSDNS",ACHS)) G END:ACHS="" D
.S ACHS(1)="",(ACHS("C"),ACHS("D"))=0
.F S ACHS(1)=$O(^TMP($J,"ACHSDNS",ACHS,ACHS(1))) Q:ACHS(1)="" D
..I ACHSRPT<3 D Q
...S ACHS("C")=ACHS("C")+$G(^TMP($J,"ACHSDNS",ACHS,ACHS(1)))
...S ACHS("D")=ACHS("D")+$P($G(^TMP($J,"ACHSDNS",ACHS,ACHS(1))),U,2)
..S ACHS(2)=""
..F S ACHS(2)=$O(^TMP($J,"ACHSDNS",ACHS,ACHS(1),ACHS(2))) Q:ACHS(2)="" D
...S ACHS(3)=""
...F S ACHS(3)=$O(^TMP($J,"ACHSDNS",ACHS,ACHS(1),ACHS(2),ACHS(3))) Q:ACHS(3)="" D
....S ACHS("C")=ACHS("C")+$G(^TMP($J,"ACHSDNS",ACHS,ACHS(1),ACHS(2),ACHS(3)))
....S ACHS("D")=ACHS("D")+$P($G(^TMP($J,"ACHSDNS",ACHS,ACHS(1),ACHS(2),ACHS(3))),U,2)
.S ^TMP($J,"ACHSDNS",ACHS,"TOTAL")=ACHS("C")_U_ACHS("D")
;
END ;
K ACHS,ACHSREAS,ACHSINS,ACHSINST
G ^ACHSDNS1
;
SET ;
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE),U)=+$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE)),U)+1
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE),U,2)=+$P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE),U,2)+ACHS("$")
;
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI),U)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI)),U)+1
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI),U,2)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI)),U,2)+ACHS("$")
Q
SET3 ;REPORT TYPE WITH COMMUNITY
I $P(^ACHSDEN(DUZ(2),"D",DA,0),U,6)="Y" D
.Q:'$D(^AUPNPAT($P(^ACHSDEN(DUZ(2),"D",DA,0),U,7),11))
.S ACHSCOM=$P(^AUPNPAT($P(^ACHSDEN(DUZ(2),"D",DA,0),U,7),11),U,17)
.Q:ACHSCOM=""
.S ACHSCOM=$P(^AUPNPAT($P(^ACHSDEN(DUZ(2),"D",DA,0),U,7),11),U,17)
.S ACHSST=$P(^AUTTCOM(ACHSCOM,0),U,3)
.S ACHSCOM=$P(^AUTTCOM(ACHSCOM,0),U)
I $P(^ACHSDEN(DUZ(2),"D",DA,0),U,6)="N" D
.Q:ACHSCOM=""
.S ACHSCOM=$P(^ACHSDEN(DUZ(2),"D",DA,10),U,3)
.S ACHSST=$P(^ACHSDEN(DUZ(2),"D",DA,10),U,4)
Q:ACHSCOM=""
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE),U)=+$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE)),U)+1
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE),U,2)=+$P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE),U,2)+ACHS("$")
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI),U)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI)),U)+1
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI),U,2)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI)),U,2)+ACHS("$")
S:(ACHS("A")'="TOTAL")&('$D(^TMP($J,"ACHSDNS","X",ACHSCOM,ACHSST,ACHS("A"),ACHSTYPE))) ^(ACHSTYPE)=""
Q
;
SET4 ;REPORT BY ALTERNATE RESOURCES
I ACHS("$")'=0,ACHS("A")="TOTAL" S ACHSINS="SELF PAY",ACHSINST=ACHS("$") D SETINS
I ACHS("A")'="TOTAL",ACHSINST'=0 S ACHSINS="SELF PAY",ACHS("$")=ACHSINST D SETINS
I $D(^ACHSDEN(DUZ(2),"D",DA,800)) D
.S DA(1)=0
.F S DA(1)=$O(^ACHSDEN(DUZ(2),"D",DA,800,DA(1))) Q:DA(1)'?1N.N D
..S %=$P(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0),U),ACHS("$")=$P(^(0),U,2)
..S ACHSINS=$S(%'?1.N:%,1:$P($G(^AUTNINS(%,0)),U))
..I ACHSINS'="MEDICAID",ACHSINS'="MEDICARE" S ACHSINS="OTHER INSURANCE/COVERAGE"
..Q:(ACHSINS="")!(ACHS("$"))
..D SETINS
Q
SETINS ;SET OTHER PAYMENT TYPES
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE),U)=+$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE)),U)+1
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE),U,2)=+$P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE),U,2)+ACHS("$")
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI),U)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI)),U)+1
S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI),U,2)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI)),U,2)+ACHS("$")
S:(ACHS("A")'="TOTAL")&('$D(^TMP($J,"ACHSDNS","X",ACHSINS,ACHS("A"),ACHSTYPE))) ^(ACHSTYPE)=""
Q
;
HDR ;EP
S ACHSPG=ACHSPG+1
;{ABK,7/19/10}W @IOF,!!,$$C^ACHS("*** CHS DENIAL/DEFERRED SERVICES ***",80),!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC
W @IOF,!!,$$C^ACHS("*** CHS DENIAL ***",80),!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC
I $D(ZTSK) S X="(task "_ZTSK_")" W ?79-$L(X),X
W !,$$C^ACHS("DENIAL FACILITY STATISTICS",80),!,ACHSTIME,!!,ACHST1,!!
W:ACHSRPT=3 !,"COMMUNITY: ",ACHSCOM,", ",$P(^DIC(5,ACHSST,0),U),!
W:ACHSRPT=4 !,"PAYOR: ",ACHSINS,!
I ACHSPART=1 W "DENIAL REASON",?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
I ACHSPART=2 W ?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
;{ABK,7/19/10}I ACHSPART=3 W "TYPE OF DEFERRED SERVICE",?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
I ACHSPART=3 W "TYPE OF UNMET NEED",?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
W !,$$REPEAT^XLFSTR("=",79),!
Q
;
DOLLARS ;EP - Get Dollar Amount for each Denial.
S ACHS("$")=$S(+$P($G(^ACHSDEN(DUZ(2),"D",DA,100)),U,9):+$P($G(^ACHSDEN(DUZ(2),"D",DA,100)),U,9),1:+$P($G(^ACHSDEN(DUZ(2),"D",DA,100)),U,8))
;
I $D(^ACHSDEN(DUZ(2),"D",DA,200)) F DA(1)=0:0 S DA(1)=$O(^ACHSDEN(DUZ(2),"D",DA,200,DA(1))) Q:'DA(1) D
.I $D(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)) D
..S ACHS("$")=ACHS("$")+$S(+$P($G(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)),U,3):$P($G(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)),U,3),1:+$P($G(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)),U,2))
;
I $D(^ACHSDEN(DUZ(2),"D",DA,210)) F DA(1)=0:0 S DA(1)=$O(^ACHSDEN(DUZ(2),"D",DA,210,DA(1))) Q:'DA(1) D
.I $D(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)) D
..S ACHS("$")=ACHS("$")+$S(+$P($G(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)),U,7):+$P($G(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)),U,7),1:+$P($G(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)),U,6))
;
I $D(^ACHSDEN(DUZ(2),"D",DA,800)) F DA(1)=0:0 S DA(1)=$O(^ACHSDEN(DUZ(2),"D",DA,800,DA(1))) Q:'DA(1) D
.I $D(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0)) S ACHS("$")=ACHS("$")-(+$P($G(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0)),U,2))
Q
;
QSEL ;
W !!?20,"1) Print Report by Date of Issue"
W !?20,"2) Print Report by Date of Service"
W !?20,"3) Print Report by Community"
;W !?20,"4) Print Report by Primary Payor"
Q
ACHSDNS ; IHS/ITSC/PMF - DENIAL STATISTICS REPORT (1/2) ;7/27/10 16:15
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
+2 ;ACHS*3.1*6 4/24/03 IHS/SET/FCJ MULTIPLE CHANGES ADDED TO RUN 2 OTHER
+3 ; REPORTS BY DOS, COMMUNITY
+4 ; ADDED DEV LINE LABEL
+5 ; REQUEST TO SORT BY PAYOR WILL BE INCLUDED IN PATCH 7 BUT
+6 ; HAS BEEN STARTED
+7 ;ACHS*3.1*7 10/10/03 ITSC/SET/FCJ ADDED ACHSPRT IN LABEL DEV
+8 ;ACHS*3.1*18 7/19/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
+9 ;
+10 ;
SEL DO QSEL
+1 SET ACHSRPT=$$DIR^ACHS("N^1:3:0","Select",1,"","^D QSEL^ACHSDNS",3)
+2 IF ACHSRPT'?1N.3N
GOTO K
+3 DO A2
+4 QUIT
A2 ; --- Input date range
+1 SET ACHSBDT=$$DATE^ACHS("B","DENIAL STATISTICS")
+2 IF ACHSBDT<1
GOTO K
+3 SET ACHSEDT=$$DATE^ACHS("E","DENIAL STATISTICS")
+4 IF ACHSEDT<1
GOTO A2
+5 IF $$EBB^ACHS(ACHSBDT,ACHSEDT)
GOTO A2
+6 SET ACHSHAT=""
DEV SET %ZIS="OPQ"
+1 DO ^%ZIS
+2 IF POP
DO HOME^%ZIS
GOTO K
+3 IF '$DATA(IO("Q"))
GOTO START
+4 KILL IO("Q")
+5 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+6 ;
+7 ; Y2000
SET ZTRTN="START^ACHSDNS"
SET ZTIO=""
SET ZTDESC="CHS Denial Statistics, "_(ACHSBDT+17000000)_" to "_(ACHSEDT+17000000)
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+8 ;
+9 ;ITSC/SET/FCJ ACHS*3.1*7 ADDED ACHSRPT
+10 ;F %="ACHSQIO","ACHSBDT","ACHSEDT" S ZTSAVE(%)=""
+11 FOR %="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRPT"
SET ZTSAVE(%)=""
+12 DO ^%ZTLOAD
+13 IF '$DATA(ZTSK)
GOTO DEV
K ;
+1 KILL ACHS,ACHSBDT,ACHSEDT,ACHSHAT,ACHSQIO,DTOUT,DUOUT,ZTIO,ZTSK
+2 DO ^%ZISC
+3 QUIT
+4 ;
START ;EP - TaskMan.
ST ;
+1 NEW ACHSMPRI
+2 SET ACHSISDT=ACHSBDT-1
+3 KILL ^TMP($JOB,"ACHSDNS")
A ; --- START OF Loops
+1 SET ACHSSUB=$SELECT((ACHSRPT<3):"SET",ACHSRPT=3:"SET3",ACHSRPT=4:"SET4")
DOI ;SORT BY DATE OF ISSUE
+1 IF ACHSRPT'=2
Begin DoDot:1
+2 FOR
SET ACHSISDT=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT))
IF +ACHSISDT=0!(+ACHSISDT>ACHSEDT)
QUIT
Begin DoDot:2
+3 SET DA=0
SET ACHSINST=0
+4 FOR
SET DA=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT,DA))
IF +DA=0
QUIT
Begin DoDot:3
+5 DO B
+6 IF ACHS("A")'="TOTAL"
SET $PIECE(^TMP($JOB,"ACHSDNS","X","TOTALD"),U)=+$PIECE($GET(^TMP($JOB,"ACHSDNS","X","TOTALD")),U)+1
End DoDot:3
End DoDot:2
End DoDot:1
DOS ;SORT BY DATE OF SERVICE
+1 IF ACHSRPT=2
Begin DoDot:1
+2 FOR
SET ACHSISDT=$ORDER(^ACHSDEN(DUZ(2),"D","ES",ACHSISDT))
IF +ACHSISDT=0!(+ACHSISDT>ACHSEDT)
QUIT
Begin DoDot:2
+3 SET DA=0
+4 FOR
SET DA=$ORDER(^ACHSDEN(DUZ(2),"D","ES",ACHSISDT,DA))
IF +DA=0
QUIT
DO B
End DoDot:2
End DoDot:1
+5 ;G:ACHSRPT<4 GRNDTOT
+6 GOTO GRNDTOT
B ; --- Loop thru Denial IENs
+1 IF '$DATA(^ACHSDEN(DUZ(2),"D",DA,0))
QUIT
+2 IF '$DATA(^ACHSDEN(DUZ(2),"D",DA,100))
QUIT
+3 SET ACHSTYPE=$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,100)),U,10)
+4 IF ACHSTYPE']""
QUIT
+5 IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,0)),U)["#"
QUIT
+6 DO DOLLARS
+7 SET ACHSMPRI=$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,400)),U,2)
+8 IF ACHSMPRI
SET ACHSMPRI=$PIECE($GET(^ACHSMPRI(ACHSMPRI,0)),U)
+9 IF '$TEST
SET ACHSMPRI="UNKNOWN"
+10 SET ACHS("A")="TOTAL"
+11 DO @ACHSSUB
+12 IF '$GET(^ACHSDEN(DUZ(2),"D",DA,250))
QUIT
+13 SET ACHS("A")=$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,250)),U)
SET ACHSREAS=$PIECE($GET(^ACHSDENS(+ACHS("A"),0)),U)
+14 DO @ACHSSUB
+15 QUIT
+16 ;
GRNDTOT ; --- Compute Grand Total For each Group.
+1 SET ACHS=""
G1 ;
+1 FOR
SET ACHS=$ORDER(^TMP($JOB,"ACHSDNS",ACHS))
IF ACHS=""
GOTO END
Begin DoDot:1
+2 SET ACHS(1)=""
SET (ACHS("C"),ACHS("D"))=0
+3 FOR
SET ACHS(1)=$ORDER(^TMP($JOB,"ACHSDNS",ACHS,ACHS(1)))
IF ACHS(1)=""
QUIT
Begin DoDot:2
+4 IF ACHSRPT<3
Begin DoDot:3
+5 SET ACHS("C")=ACHS("C")+$GET(^TMP($JOB,"ACHSDNS",ACHS,ACHS(1)))
+6 SET ACHS("D")=ACHS("D")+$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS,ACHS(1))),U,2)
End DoDot:3
QUIT
+7 SET ACHS(2)=""
+8 FOR
SET ACHS(2)=$ORDER(^TMP($JOB,"ACHSDNS",ACHS,ACHS(1),ACHS(2)))
IF ACHS(2)=""
QUIT
Begin DoDot:3
+9 SET ACHS(3)=""
+10 FOR
SET ACHS(3)=$ORDER(^TMP($JOB,"ACHSDNS",ACHS,ACHS(1),ACHS(2),ACHS(3)))
IF ACHS(3)=""
QUIT
Begin DoDot:4
+11 SET ACHS("C")=ACHS("C")+$GET(^TMP($JOB,"ACHSDNS",ACHS,ACHS(1),ACHS(2),ACHS(3)))
+12 SET ACHS("D")=ACHS("D")+$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS,ACHS(1),ACHS(2),ACHS(3))),U,2)
End DoDot:4
End DoDot:3
End DoDot:2
+13 SET ^TMP($JOB,"ACHSDNS",ACHS,"TOTAL")=ACHS("C")_U_ACHS("D")
End DoDot:1
+14 ;
END ;
+1 KILL ACHS,ACHSREAS,ACHSINS,ACHSINST
+2 GOTO ^ACHSDNS1
+3 ;
SET ;
+1 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSTYPE),U)=+$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSTYPE)),U)+1
+2 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSTYPE),U,2)=+$PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSTYPE),U,2)+ACHS("$")
+3 ;
+4 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI),U)=$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI)),U)+1
+5 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI),U,2)=$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI)),U,2)+ACHS("$")
+6 QUIT
SET3 ;REPORT TYPE WITH COMMUNITY
+1 IF $PIECE(^ACHSDEN(DUZ(2),"D",DA,0),U,6)="Y"
Begin DoDot:1
+2 IF '$DATA(^AUPNPAT($PIECE(^ACHSDEN(DUZ(2),"D",DA,0),U,7),11))
QUIT
+3 SET ACHSCOM=$PIECE(^AUPNPAT($PIECE(^ACHSDEN(DUZ(2),"D",DA,0),U,7),11),U,17)
+4 IF ACHSCOM=""
QUIT
+5 SET ACHSCOM=$PIECE(^AUPNPAT($PIECE(^ACHSDEN(DUZ(2),"D",DA,0),U,7),11),U,17)
+6 SET ACHSST=$PIECE(^AUTTCOM(ACHSCOM,0),U,3)
+7 SET ACHSCOM=$PIECE(^AUTTCOM(ACHSCOM,0),U)
End DoDot:1
+8 IF $PIECE(^ACHSDEN(DUZ(2),"D",DA,0),U,6)="N"
Begin DoDot:1
+9 IF ACHSCOM=""
QUIT
+10 SET ACHSCOM=$PIECE(^ACHSDEN(DUZ(2),"D",DA,10),U,3)
+11 SET ACHSST=$PIECE(^ACHSDEN(DUZ(2),"D",DA,10),U,4)
End DoDot:1
+12 IF ACHSCOM=""
QUIT
+13 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE),U)=+$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE)),U)+1
+14 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE),U,2)=+$PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE),U,2)+ACHS("$")
+15 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI),U)=$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI)),U)+1
+16 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI),U,2)=$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI)),U,2)+ACHS("$")
+17 IF (ACHS("A")'="TOTAL")&('$DATA(^TMP($JOB,"ACHSDNS","X",ACHSCOM,ACHSST,ACHS("A"),ACHSTYPE)))
SET ^(ACHSTYPE)=""
+18 QUIT
+19 ;
SET4 ;REPORT BY ALTERNATE RESOURCES
+1 IF ACHS("$")'=0
IF ACHS("A")="TOTAL"
SET ACHSINS="SELF PAY"
SET ACHSINST=ACHS("$")
DO SETINS
+2 IF ACHS("A")'="TOTAL"
IF ACHSINST'=0
SET ACHSINS="SELF PAY"
SET ACHS("$")=ACHSINST
DO SETINS
+3 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,800))
Begin DoDot:1
+4 SET DA(1)=0
+5 FOR
SET DA(1)=$ORDER(^ACHSDEN(DUZ(2),"D",DA,800,DA(1)))
IF DA(1)'?1N.N
QUIT
Begin DoDot:2
+6 SET %=$PIECE(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0),U)
SET ACHS("$")=$PIECE(^(0),U,2)
+7 SET ACHSINS=$SELECT(%'?1.N:%,1:$PIECE($GET(^AUTNINS(%,0)),U))
+8 IF ACHSINS'="MEDICAID"
IF ACHSINS'="MEDICARE"
SET ACHSINS="OTHER INSURANCE/COVERAGE"
+9 IF (ACHSINS="")!(ACHS("$"))
QUIT
+10 DO SETINS
End DoDot:2
End DoDot:1
+11 QUIT
SETINS ;SET OTHER PAYMENT TYPES
+1 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE),U)=+$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE)),U)+1
+2 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE),U,2)=+$PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE),U,2)+ACHS("$")
+3 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI),U)=$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI)),U)+1
+4 SET $PIECE(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI),U,2)=$PIECE($GET(^TMP($JOB,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI)),U,2)+ACHS("$")
+5 IF (ACHS("A")'="TOTAL")&('$DATA(^TMP($JOB,"ACHSDNS","X",ACHSINS,ACHS("A"),ACHSTYPE)))
SET ^(ACHSTYPE)=""
+6 QUIT
+7 ;
HDR ;EP
+1 SET ACHSPG=ACHSPG+1
+2 ;{ABK,7/19/10}W @IOF,!!,$$C^ACHS("*** CHS DENIAL/DEFERRED SERVICES ***",80),!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC
+3 WRITE @IOF,!!,$$C^ACHS("*** CHS DENIAL ***",80),!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,ACHSLOC
+4 IF $DATA(ZTSK)
SET X="(task "_ZTSK_")"
WRITE ?79-$LENGTH(X),X
+5 WRITE !,$$C^ACHS("DENIAL FACILITY STATISTICS",80),!,ACHSTIME,!!,ACHST1,!!
+6 IF ACHSRPT=3
WRITE !,"COMMUNITY: ",ACHSCOM,", ",$PIECE(^DIC(5,ACHSST,0),U),!
+7 IF ACHSRPT=4
WRITE !,"PAYOR: ",ACHSINS,!
+8 IF ACHSPART=1
WRITE "DENIAL REASON",?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
+9 IF ACHSPART=2
WRITE ?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
+10 ;{ABK,7/19/10}I ACHSPART=3 W "TYPE OF DEFERRED SERVICE",?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
+11 IF ACHSPART=3
WRITE "TYPE OF UNMET NEED",?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
+12 WRITE !,$$REPEAT^XLFSTR("=",79),!
+13 QUIT
+14 ;
DOLLARS ;EP - Get Dollar Amount for each Denial.
+1 SET ACHS("$")=$SELECT(+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,100)),U,9):+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,100)),U,9),1:+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,100)),U,8))
+2 ;
+3 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,200))
FOR DA(1)=0:0
SET DA(1)=$ORDER(^ACHSDEN(DUZ(2),"D",DA,200,DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:1
+4 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0))
Begin DoDot:2
+5 SET ACHS("$")=ACHS("$")+$SELECT(+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)),U,3):$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)),U,3),1:+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)),U,2))
End DoDot:2
End DoDot:1
+6 ;
+7 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,210))
FOR DA(1)=0:0
SET DA(1)=$ORDER(^ACHSDEN(DUZ(2),"D",DA,210,DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:1
+8 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0))
Begin DoDot:2
+9 SET ACHS("$")=ACHS("$")+$SELECT(+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)),U,7):+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)),U,7),1:+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)),U,6))
End DoDot:2
End DoDot:1
+10 ;
+11 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,800))
FOR DA(1)=0:0
SET DA(1)=$ORDER(^ACHSDEN(DUZ(2),"D",DA,800,DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:1
+12 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0))
SET ACHS("$")=ACHS("$")-(+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0)),U,2))
End DoDot:1
+13 QUIT
+14 ;
QSEL ;
+1 WRITE !!?20,"1) Print Report by Date of Issue"
+2 WRITE !?20,"2) Print Report by Date of Service"
+3 WRITE !?20,"3) Print Report by Community"
+4 ;W !?20,"4) Print Report by Primary Payor"
+5 QUIT
