ACHSDNA ; IHS/ITSC/PMF - DENIAL LIST ALPHA BY PATIENT ;7/27/10 16:17
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**1,6,18**;JUNE 11, 2001
;;ACHS*3.1*1; make call to ACHSDNI into call to ACHSDNA
;;ACHS*3.1*6; Add close device
;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
;
K X2,X3
A2 ;
S %=$$DIR^ACHS("Y","ALL DENIALS","YES","Enter 'YES' for all denials or 'NO' to select a date range.","",2)
I $D(DUOUT)!$D(DTOUT) Q
I % S ACHDBDT=1,ACHDEDT=9999999 G B
BDT ; --- Input date range
S ACHDBDT=$$DATE^ACHS("B","DENIAL LIST BY PATIENT")
G:ACHDBDT<1 A2
S ACHDEDT=$$DATE^ACHS("E","DENIAL LIST BY PATIENT")
G:ACHDEDT<1 BDT
I $$EBB^ACHS(ACHDBDT,ACHDEDT) G A2
B ;
S ACHDHAT=""
DEV ; --- Select device for report.
S %ZIS="OPQ"
D ^%ZIS
I POP D HOME^%ZIS Q
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
;
;11/26/01 pmf replace next line to call ACHSDNA, not DNI ACHS*3.1*1
;S ZTRTN="START^ACHSDNI",ZTDESC="CHS Denial Documents "_(ACHDBDT+17000000)_" to "_(ACHDEDT+17000000) ; ACHS*3.1*1
S ZTRTN="START^ACHSDNA",ZTDESC="CHS Denial Documents "_(ACHDBDT+17000000)_" to "_(ACHDEDT+17000000) ; ACHS*3.1*1
;
F %="ACHDBDT","ACHDEDT" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ZTSK
Q
;
START ;EP - TaskMan.
K ^TMP($J,"ACHSDNA")
S ACHDISU=ACHDBDT-1
S (ACHDTOT("$"),ACHDTOT)=0
S ACHDT1=$$C^ACHS($S(ACHDBDT=1:"*** ALL DENIALS ***",1:"For the period "_$$FMTE^XLFDT(ACHDBDT)_" through "_$$FMTE^XLFDT(ACHDEDT)))
D BRPT^ACHS
D HDR
D EXTR
D PRINT
;IHS/SET/JVK ACHS*3.1*6 - ADD LINE BELOW TO CLOSE DEVICE
D ERPT^ACHS
K ACHDISU,ACHDNAME,ACHDTOT,DA,^TMP($J,"ACHSDNA")
Q
;
EXTR ;
F S ACHDISU=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHDISU)) Q:ACHDISU="" Q:(ACHDISU>ACHDEDT) D
. S DA=0 F S DA=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHDISU,DA)) Q:'DA D
.. S ACHD0=$G(^ACHSDEN(DUZ(2),"D",DA,0)) I ACHD0="" Q
.. ;if cancelled, stop
.. I $P(ACHD0,U,8)="Y" Q
.. I $E(ACHD0)="#" Q
.. D GETNAME
.. I ACHDNAME="" Q
.. S ^TMP($J,"ACHSDNA",ACHDNAME,DA)=""
.. Q
. Q
Q
;
PRINT ;
S ACHDNAME="" F S ACHDNAME=$O(^TMP($J,"ACHSDNA",ACHDNAME)) Q:ACHDNAME=""!$G(ACHSQUIT) D
. S DA=0 F S DA=$O(^TMP($J,"ACHSDNA",ACHDNAME,DA)) Q:DA=""!$G(ACHSQUIT) D
.. S ACHD0=^ACHSDEN(DUZ(2),"D",DA,0)
.. S ACHDISU=$P(ACHD0,U,2)
.. S ACHD("$")=""
.. I $D(^ACHSDEN(DUZ(2),"D",DA,100)) D DOLLARS
.. W ACHDNAME,?38,$$FMTE^XLFDT(ACHDISU),?51,$P(ACHD0,U),?65
.. S X=ACHD("$"),X2=2,X3=12
.. D FMT^ACHS
.. W !
.. I $Y>ACHSBM D I $G(ACHSQUIT) Q
... D RTRN^ACHS
... I $D(DUOUT)!$D(DTOUT)!$G(ACHSQUIT) D ERPT^ACHS S ACHSQUIT=1 Q
... D HDR
... Q
.. S ACHDTOT=ACHDTOT+1
.. S ACHDTOT("$")=ACHDTOT("$")+ACHD("$")
.. Q
. Q
;
I $G(ACHSQUIT) Q
;
S X=ACHDTOT("$"),X2="2$",X3=16
D COMMA^%DTC
W !,$$REPEAT^XLFSTR("=",79),!,"TOTALS FOR THIS REPORT: ",ACHDTOT," DENIAL",$S(ACHDTOT=1:"",1:"S"),?61,X
K ACHDHAT
I IO(0)=IO D RTRN^ACHS
W @IOF
Q
;
GETNAME ;
;get the name and format it. default is null
;
S ACHDNAME=""
;if patient is not registered, then get the name from denial
;formatting is simple, but will fail on complicated names
;the forms we look for are
; LAST,FIRST (MIDDLE OPTIONAL)
; FIRST LAST
; FIRST MIDDLE LAST
;
I $P(ACHD0,U,6)="N" D Q
. S ACHDNAME=$P($G(^ACHSDEN(DUZ(2),"D",DA,10)),U,1)
. I ACHDNAME["," Q
. S LEN=$L(ACHDNAME," ")
. S ACHDNAME=$P(ACHDNAME," ",LEN)_", "_$P(ACHDNAME," ",1,LEN-1)
. Q
;fetch name from DPT
S ACHDNAME=$P(ACHD0,U,7) I ACHDNAME="" Q
S ACHDNAME=$P($G(^DPT(ACHDNAME,0)),U,1)
Q
;
HDR ; --- Pagination for report.
S ACHSPG=$G(ACHSPG)+1
;{ABK, 4/2/10}W @IOF,!!,$$C^ACHS("*** CHS DENIAL/DEFERRED SERVICES ***",80),!!,ACHSLOC,!?19,"DENIAL DOCUMENTS ALPHABETICALLY BY PATIENT",?71,"Page",$J(ACHSPG,3),!
W @IOF,!!,$$C^ACHS("*** CHS DENIAL ***",80),!!,ACHSLOC,!?19,"DENIAL DOCUMENTS ALPHABETICALLY BY PATIENT",?71,"Page",$J(ACHSPG,3),!
W ACHSTIME,!!,ACHDT1,!!,"PATIENT",?38,"ISSUE DATE",?51,"DOCUMENT #",?70,"DOLLARS",!,$$REPEAT^XLFSTR("=",79),!
Q
;
DOLLARS ;EP - Get Dollar Amount for each Denial.
S ACHD("$")=$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)) D
.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 ACHD("$")=ACHD("$")+$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)) D
.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 ACHD("$")=ACHD("$")+$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)) D
.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 ACHD("$")=ACHD("$")-(+$P($G(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0)),U,2))
Q
;
AMT ;EP - Write amount of denial on denial letter(s).
S ACHD("$")=0
D DOLLARS
W:$X>9 !
W ?DIWL+3,"Total amount of services denied : "
S X=ACHD("$")
D FMT^ACHS
W !
Q
;
ACHSDNA ; IHS/ITSC/PMF - DENIAL LIST ALPHA BY PATIENT ;7/27/10 16:17
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**1,6,18**;JUNE 11, 2001
+2 ;;ACHS*3.1*1; make call to ACHSDNI into call to ACHSDNA
+3 ;;ACHS*3.1*6; Add close device
+4 ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
+5 ;
+6 KILL X2,X3
A2 ;
+1 SET %=$$DIR^ACHS("Y","ALL DENIALS","YES","Enter 'YES' for all denials or 'NO' to select a date range.","",2)
+2 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+3 IF %
SET ACHDBDT=1
SET ACHDEDT=9999999
GOTO B
BDT ; --- Input date range
+1 SET ACHDBDT=$$DATE^ACHS("B","DENIAL LIST BY PATIENT")
+2 IF ACHDBDT<1
GOTO A2
+3 SET ACHDEDT=$$DATE^ACHS("E","DENIAL LIST BY PATIENT")
+4 IF ACHDEDT<1
GOTO BDT
+5 IF $$EBB^ACHS(ACHDBDT,ACHDEDT)
GOTO A2
B ;
+1 SET ACHDHAT=""
DEV ; --- Select device for report.
+1 SET %ZIS="OPQ"
+2 DO ^%ZIS
+3 IF POP
DO HOME^%ZIS
QUIT
+4 IF '$DATA(IO("Q"))
GOTO START
+5 KILL IO("Q")
+6 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+7 ;
+8 ;11/26/01 pmf replace next line to call ACHSDNA, not DNI ACHS*3.1*1
+9 ;S ZTRTN="START^ACHSDNI",ZTDESC="CHS Denial Documents "_(ACHDBDT+17000000)_" to "_(ACHDEDT+17000000) ; ACHS*3.1*1
+10 ; ACHS*3.1*1
SET ZTRTN="START^ACHSDNA"
SET ZTDESC="CHS Denial Documents "_(ACHDBDT+17000000)_" to "_(ACHDEDT+17000000)
+11 ;
+12 FOR %="ACHDBDT","ACHDEDT"
SET ZTSAVE(%)=""
+13 DO ^%ZTLOAD
+14 IF '$DATA(ZTSK)
GOTO DEV
+15 KILL ZTSK
+16 QUIT
+17 ;
START ;EP - TaskMan.
+1 KILL ^TMP($JOB,"ACHSDNA")
+2 SET ACHDISU=ACHDBDT-1
+3 SET (ACHDTOT("$"),ACHDTOT)=0
+4 SET ACHDT1=$$C^ACHS($SELECT(ACHDBDT=1:"*** ALL DENIALS ***",1:"For the period "_$$FMTE^XLFDT(ACHDBDT)_" through "_$$FMTE^XLFDT(ACHDEDT)))
+5 DO BRPT^ACHS
+6 DO HDR
+7 DO EXTR
+8 DO PRINT
+9 ;IHS/SET/JVK ACHS*3.1*6 - ADD LINE BELOW TO CLOSE DEVICE
+10 DO ERPT^ACHS
+11 KILL ACHDISU,ACHDNAME,ACHDTOT,DA,^TMP($JOB,"ACHSDNA")
+12 QUIT
+13 ;
EXTR ;
+1 FOR
SET ACHDISU=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHDISU))
IF ACHDISU=""
QUIT
IF (ACHDISU>ACHDEDT)
QUIT
Begin DoDot:1
+2 SET DA=0
FOR
SET DA=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHDISU,DA))
IF 'DA
QUIT
Begin DoDot:2
+3 SET ACHD0=$GET(^ACHSDEN(DUZ(2),"D",DA,0))
IF ACHD0=""
QUIT
+4 ;if cancelled, stop
+5 IF $PIECE(ACHD0,U,8)="Y"
QUIT
+6 IF $EXTRACT(ACHD0)="#"
QUIT
+7 DO GETNAME
+8 IF ACHDNAME=""
QUIT
+9 SET ^TMP($JOB,"ACHSDNA",ACHDNAME,DA)=""
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
PRINT ;
+1 SET ACHDNAME=""
FOR
SET ACHDNAME=$ORDER(^TMP($JOB,"ACHSDNA",ACHDNAME))
IF ACHDNAME=""!$GET(ACHSQUIT)
QUIT
Begin DoDot:1
+2 SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,"ACHSDNA",ACHDNAME,DA))
IF DA=""!$GET(ACHSQUIT)
QUIT
Begin DoDot:2
+3 SET ACHD0=^ACHSDEN(DUZ(2),"D",DA,0)
+4 SET ACHDISU=$PIECE(ACHD0,U,2)
+5 SET ACHD("$")=""
+6 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,100))
DO DOLLARS
+7 WRITE ACHDNAME,?38,$$FMTE^XLFDT(ACHDISU),?51,$PIECE(ACHD0,U),?65
+8 SET X=ACHD("$")
SET X2=2
SET X3=12
+9 DO FMT^ACHS
+10 WRITE !
+11 IF $Y>ACHSBM
Begin DoDot:3
+12 DO RTRN^ACHS
+13 IF $DATA(DUOUT)!$DATA(DTOUT)!$GET(ACHSQUIT)
DO ERPT^ACHS
SET ACHSQUIT=1
QUIT
+14 DO HDR
+15 QUIT
End DoDot:3
IF $GET(ACHSQUIT)
QUIT
+16 SET ACHDTOT=ACHDTOT+1
+17 SET ACHDTOT("$")=ACHDTOT("$")+ACHD("$")
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 ;
+21 IF $GET(ACHSQUIT)
QUIT
+22 ;
+23 SET X=ACHDTOT("$")
SET X2="2$"
SET X3=16
+24 DO COMMA^%DTC
+25 WRITE !,$$REPEAT^XLFSTR("=",79),!,"TOTALS FOR THIS REPORT: ",ACHDTOT," DENIAL",$SELECT(ACHDTOT=1:"",1:"S"),?61,X
+26 KILL ACHDHAT
+27 IF IO(0)=IO
DO RTRN^ACHS
+28 WRITE @IOF
+29 QUIT
+30 ;
GETNAME ;
+1 ;get the name and format it. default is null
+2 ;
+3 SET ACHDNAME=""
+4 ;if patient is not registered, then get the name from denial
+5 ;formatting is simple, but will fail on complicated names
+6 ;the forms we look for are
+7 ; LAST,FIRST (MIDDLE OPTIONAL)
+8 ; FIRST LAST
+9 ; FIRST MIDDLE LAST
+10 ;
+11 IF $PIECE(ACHD0,U,6)="N"
Begin DoDot:1
+12 SET ACHDNAME=$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,10)),U,1)
+13 IF ACHDNAME[","
QUIT
+14 SET LEN=$LENGTH(ACHDNAME," ")
+15 SET ACHDNAME=$PIECE(ACHDNAME," ",LEN)_", "_$PIECE(ACHDNAME," ",1,LEN-1)
+16 QUIT
End DoDot:1
QUIT
+17 ;fetch name from DPT
+18 SET ACHDNAME=$PIECE(ACHD0,U,7)
IF ACHDNAME=""
QUIT
+19 SET ACHDNAME=$PIECE($GET(^DPT(ACHDNAME,0)),U,1)
+20 QUIT
+21 ;
HDR ; --- Pagination for report.
+1 SET ACHSPG=$GET(ACHSPG)+1
+2 ;{ABK, 4/2/10}W @IOF,!!,$$C^ACHS("*** CHS DENIAL/DEFERRED SERVICES ***",80),!!,ACHSLOC,!?19,"DENIAL DOCUMENTS ALPHABETICALLY BY PATIENT",?71,"Page",$J(ACHSPG,3),!
+3 WRITE @IOF,!!,$$C^ACHS("*** CHS DENIAL ***",80),!!,ACHSLOC,!?19,"DENIAL DOCUMENTS ALPHABETICALLY BY PATIENT",?71,"Page",$JUSTIFY(ACHSPG,3),!
+4 WRITE ACHSTIME,!!,ACHDT1,!!,"PATIENT",?38,"ISSUE DATE",?51,"DOCUMENT #",?70,"DOLLARS",!,$$REPEAT^XLFSTR("=",79),!
+5 QUIT
+6 ;
DOLLARS ;EP - Get Dollar Amount for each Denial.
+1 SET ACHD("$")=$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))
Begin DoDot:1
+4 FOR DA(1)=0:0
SET DA(1)=$ORDER(^ACHSDEN(DUZ(2),"D",DA,200,DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:2
+5 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0))
Begin DoDot:3
+6 SET ACHD("$")=ACHD("$")+$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:3
End DoDot:2
End DoDot:1
+7 ;
+8 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,210))
Begin DoDot:1
+9 FOR DA(1)=0:0
SET DA(1)=$ORDER(^ACHSDEN(DUZ(2),"D",DA,210,DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:2
+10 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0))
Begin DoDot:3
+11 SET ACHD("$")=ACHD("$")+$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:3
End DoDot:2
End DoDot:1
+12 ;
+13 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,800))
Begin DoDot:1
+14 FOR DA(1)=0:0
SET DA(1)=$ORDER(^ACHSDEN(DUZ(2),"D",DA,800,DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:2
+15 IF $DATA(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0))
SET ACHD("$")=ACHD("$")-(+$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0)),U,2))
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
AMT ;EP - Write amount of denial on denial letter(s).
+1 SET ACHD("$")=0
+2 DO DOLLARS
+3 IF $X>9
WRITE !
+4 WRITE ?DIWL+3,"Total amount of services denied : "
+5 SET X=ACHD("$")
+6 DO FMT^ACHS
+7 WRITE !
+8 QUIT
+9 ;
