ACHSDNI ; IHS/ITSC/PMF - DENIAL LIST BY ISSUE DATE ; [ 10/31/2003 11:43 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6**;JUNE 11, 2001
;;ACHS*3.1*6 3/31/2003 - ADD Date of Service to Report
K X2,X3
;
A2 W !!,"Enter the BEGINNING DATE for this report: ALL DENIALS// " D READ^ACHSFU G K:$D(DUOUT)!$D(DTOUT) S:Y?1"?".E Y="?" I $E(Y)="A"!(Y="") S ACHSBDT=1,ACHSEDT=9999999 G B
S X=Y,%DT="XEP" D ^%DT G A2:Y<1 S ACHSBDT=Y I Y>DT D FUDT^ACHS G A2
;
A3 W !!,"Enter the ENDING DATE for this report: " D READ^ACHSFU G K:$D(DTOUT)!(Y="") G A2:$D(DUOUT) S:Y?1"?".E Y="?" S X=Y,%DT="XEP" D ^%DT G A3:Y<1 S ACHSEDT=Y I Y>DT D FUDT^ACHS G A3
I ACHSEDT<ACHSBDT W !!,*7,"The END is before the BEGINNING." G A2
;
B S ACHSIO=IO
;
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
X ^%ZOSF("UCI") S ZTRTN="START^ACHSDNI",ZTUCI=Y,ZTDESC="CHS Denial Documents"_$E(ACHSBDT,2,7)_" to "_$E(ACHSEDT,2,7) F ACHS="ACHSBDT","ACHSEDT","DUZ(2)" S ZTSAVE(ACHS)=""
D ^%ZTLOAD G:'$D(ZTSK) DEV
K ZTSK
G K
;
START ; EP - TaskMan.
S ACHSISU=ACHSBDT-1,Y=ACHSBDT X ^DD("DD") S ACHS("BDT")=Y,Y=ACHSEDT X ^DD("DD") S ACHS("EDT")=Y,(ACHSTOT("$"),ACHSTOT)=0
S ACHST1=$$C^XBFUNC($S(ACHSBDT=1:"*** ALL DENIALS ***",1:"For the period "_ACHS("BDT")_" through "_ACHS("EDT")),80)
D BRPT^ACHSFU
D HDR
;
LOOP ;
K DUOUT,DTOUT
F S ACHSISU=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISU)) Q:+ACHSISU=0!(ACHSISU>ACHSEDT) D Q:$D(DUOUT)!$D(DTOUT)
.S DA="" F S DA=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISU,DA)) Q:DA="" D Q:$D(DUOUT)!$D(DTOUT)
..S ACHS(0)=$G(^ACHSDEN(DUZ(2),"D",DA,0))
..Q:ACHS(0)=""
..I $P(ACHS(0),U,6)="N" Q:$P($G(^ACHSDEN(DUZ(2),"D",DA,10)),U)="" S ACHSNAME=$P(^ACHSDEN(DUZ(2),"D",DA,10),U)
..I $P(ACHS(0),U,6)="Y" Q:$P(ACHS(0),U,7)="" S ACHSNAME=$P($G(^DPT($P(ACHS(0),U,7),0)),U) Q:ACHSNAME=""
..S ACHS("$")="" I $D(^ACHSDEN(DUZ(2),"D",DA,100)) D DOLLARS^ACHSDNU1(DUZ(2))
..;IHS/SET/JVK ACHS*3.1*6 ADDED 2 LINES BELOW FOR DATE OF SERVICE
..S ACHSDOS=$P(^ACHSDEN(DUZ(2),"D",DA,0),U,4)
..S Y=ACHSDOS X ^DD("DD") S ACHSDOS=Y
L1 ..;
..;S ACHSISU=$O(^ACHSDEN(ACHSFAC,"D","AISSUE",ACHSISU)) G END:+ACHSISU=0!(ACHSISU>ACHSEDT) S DA=0
L2 ..;
..;S DA=$O(^ACHSDEN(ACHSFAC,"D","AISSUE",ACHSISU,DA)) G L1:+DA=0,L2:'$D(^ACHSDEN(ACHSFAC,0)),L2:$P(^(0),U)'=ACHSFAC
..;S ACHS(0)=$G(^ACHSDEN(ACHSFAC,"D",DA,0))
..;I $P(ACHS(0),U,6)="N" G L1:'$D(^ACHSDEN(ACHSFAC,"D",DA,10)),L1:$P(^(10),U)']"" S ACHSNAME=$P(^(10),U) G L3
..;G L1:+$P(^ACHSDEN(ACHSFAC,"D",DA,0),U,7)<1,L1:'$D(^DPT($P(^ACHSDEN(ACHSFAC,"D",DA,0),U,7),0)) S ACHSNAME=$P(^(0),U)
L3 ..;S ACHS("$")="" I $D(^ACHSDEN(ACHSFAC,"D",DA,100)) D DOLLARS^ACHSDNU1(ACHSFAC)
..;IHS/SET/JVK ACHS*3.1*6 COMMENT BELOW
..;S Y=ACHSISU X ^DD("DD") W Y,?14,$P(ACHS(0),U),?27,ACHSNAME,?65 S X=ACHS("$"),X2=2,X3=12 D FMT^ACHS W !
..;IHS/SET/JVK ACHS*3.1*6 ADD LN BELOW FOR DOS TO PRINT ON REPORT
..S Y=ACHSISU X ^DD("DD") W Y,?14,$P(ACHS(0),U),?27,ACHSNAME,?52,ACHSDOS,?65 S X=ACHS("$"),X2=2,X3=12 D FMT^ACHS W !
..I $Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR
..S ACHSTOT=ACHSTOT+1,ACHSTOT("$")=ACHSTOT("$")+ACHS("$")
..;G L2
END S X=ACHSTOT("$"),X2="2$",X3=16 D COMMA^%DTC W !,ACHS("="),!,"TOTALS FOR THIS REPORT: ",ACHSTOT," DENIAL",$S(ACHSTOT=1:"",1:"S"),?61,X D RTRN^ACHS W @IOF
;
K K ACHSISU,ACHSNAME,ACHSTOT,DA
D ERPT^ACHS
Q
;
HDR ; Print header.
S ACHSPG=ACHSPG+1
;IHS/SET/JVK ACHS*3.1*6 COMMENT OUT LINE BELOW
;W @IOF,!!,$$C^XBFUNC("*** CONTRACT HEALTH CARE SYSTEM REPORT ***",80),!!,ACHSLOC,!?25,"DENIAL DOCUMENTS BY ISSUE DATE",?71,"Page",$J(ACHSPG,3),!,ACHSTIME,!!,ACHST1,!!,"ISSUE DATE",?14,"DENIAL #",?27,"PATIENT",?70,"DOLLARS",!,ACHS("="),!
;IHS/SET/JVK ACHS*3.1*6 ADD TWO LINES BELOW
W @IOF,!!,$$C^XBFUNC("*** CONTRACT HEALTH CARE SYSTEM REPORT ***",80),!!
W ACHSLOC,!?25,"DENIAL DOCUMENTS BY ISSUE DATE",?71,"Page",$J(ACHSPG,3),!,ACHSTIME,!!,ACHST1,!!,"ISSUE DATE",?14,"DENIAL #",?27,"PATIENT",?50,"DATE OF SERVICE",?70,"DOLLARS",!,ACHS("="),!
Q
ACHSDNI ; IHS/ITSC/PMF - DENIAL LIST BY ISSUE DATE ; [ 10/31/2003 11:43 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6**;JUNE 11, 2001
+2 ;;ACHS*3.1*6 3/31/2003 - ADD Date of Service to Report
+3 KILL X2,X3
+4 ;
A2 WRITE !!,"Enter the BEGINNING DATE for this report: ALL DENIALS// "
DO READ^ACHSFU
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO K
IF Y?1"?".E
SET Y="?"
IF $EXTRACT(Y)="A"!(Y="")
SET ACHSBDT=1
SET ACHSEDT=9999999
GOTO B
+1 SET X=Y
SET %DT="XEP"
DO ^%DT
IF Y<1
GOTO A2
SET ACHSBDT=Y
IF Y>DT
DO FUDT^ACHS
GOTO A2
+2 ;
A3 WRITE !!,"Enter the ENDING DATE for this report: "
DO READ^ACHSFU
IF $DATA(DTOUT)!(Y="")
GOTO K
IF $DATA(DUOUT)
GOTO A2
IF Y?1"?".E
SET Y="?"
SET X=Y
SET %DT="XEP"
DO ^%DT
IF Y<1
GOTO A3
SET ACHSEDT=Y
IF Y>DT
DO FUDT^ACHS
GOTO A3
+1 IF ACHSEDT<ACHSBDT
WRITE !!,*7,"The END is before the BEGINNING."
GOTO A2
+2 ;
B SET ACHSIO=IO
+1 ;
DEV SET %ZIS="OPQ"
DO ^%ZIS
IF POP
DO HOME^%ZIS
GOTO K
+1 IF '$DATA(IO("Q"))
GOTO START
KILL IO("Q")
IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+2 XECUTE ^%ZOSF("UCI")
SET ZTRTN="START^ACHSDNI"
SET ZTUCI=Y
SET ZTDESC="CHS Denial Documents"_$EXTRACT(ACHSBDT,2,7)_" to "_$EXTRACT(ACHSEDT,2,7)
FOR ACHS="ACHSBDT","ACHSEDT","DUZ(2)"
SET ZTSAVE(ACHS)=""
+3 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO DEV
+4 KILL ZTSK
+5 GOTO K
+6 ;
START ; EP - TaskMan.
+1 SET ACHSISU=ACHSBDT-1
SET Y=ACHSBDT
XECUTE ^DD("DD")
SET ACHS("BDT")=Y
SET Y=ACHSEDT
XECUTE ^DD("DD")
SET ACHS("EDT")=Y
SET (ACHSTOT("$"),ACHSTOT)=0
+2 SET ACHST1=$$C^XBFUNC($SELECT(ACHSBDT=1:"*** ALL DENIALS ***",1:"For the period "_ACHS("BDT")_" through "_ACHS("EDT")),80)
+3 DO BRPT^ACHSFU
+4 DO HDR
+5 ;
LOOP ;
+1 KILL DUOUT,DTOUT
+2 FOR
SET ACHSISU=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISU))
IF +ACHSISU=0!(ACHSISU>ACHSEDT)
QUIT
Begin DoDot:1
+3 SET DA=""
FOR
SET DA=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISU,DA))
IF DA=""
QUIT
Begin DoDot:2
+4 SET ACHS(0)=$GET(^ACHSDEN(DUZ(2),"D",DA,0))
+5 IF ACHS(0)=""
QUIT
+6 IF $PIECE(ACHS(0),U,6)="N"
IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,10)),U)=""
QUIT
SET ACHSNAME=$PIECE(^ACHSDEN(DUZ(2),"D",DA,10),U)
+7 IF $PIECE(ACHS(0),U,6)="Y"
IF $PIECE(ACHS(0),U,7)=""
QUIT
SET ACHSNAME=$PIECE($GET(^DPT($PIECE(ACHS(0),U,7),0)),U)
IF ACHSNAME=""
QUIT
+8 SET ACHS("$")=""
IF $DATA(^ACHSDEN(DUZ(2),"D",DA,100))
DO DOLLARS^ACHSDNU1(DUZ(2))
+9 ;IHS/SET/JVK ACHS*3.1*6 ADDED 2 LINES BELOW FOR DATE OF SERVICE
+10 SET ACHSDOS=$PIECE(^ACHSDEN(DUZ(2),"D",DA,0),U,4)
+11 SET Y=ACHSDOS
XECUTE ^DD("DD")
SET ACHSDOS=Y
L1 ;
+1 ;S ACHSISU=$O(^ACHSDEN(ACHSFAC,"D","AISSUE",ACHSISU)) G END:+ACHSISU=0!(ACHSISU>ACHSEDT) S DA=0
L2 ;
+1 ;S DA=$O(^ACHSDEN(ACHSFAC,"D","AISSUE",ACHSISU,DA)) G L1:+DA=0,L2:'$D(^ACHSDEN(ACHSFAC,0)),L2:$P(^(0),U)'=ACHSFAC
+2 ;S ACHS(0)=$G(^ACHSDEN(ACHSFAC,"D",DA,0))
+3 ;I $P(ACHS(0),U,6)="N" G L1:'$D(^ACHSDEN(ACHSFAC,"D",DA,10)),L1:$P(^(10),U)']"" S ACHSNAME=$P(^(10),U) G L3
+4 ;G L1:+$P(^ACHSDEN(ACHSFAC,"D",DA,0),U,7)<1,L1:'$D(^DPT($P(^ACHSDEN(ACHSFAC,"D",DA,0),U,7),0)) S ACHSNAME=$P(^(0),U)
L3 ;S ACHS("$")="" I $D(^ACHSDEN(ACHSFAC,"D",DA,100)) D DOLLARS^ACHSDNU1(ACHSFAC)
+1 ;IHS/SET/JVK ACHS*3.1*6 COMMENT BELOW
+2 ;S Y=ACHSISU X ^DD("DD") W Y,?14,$P(ACHS(0),U),?27,ACHSNAME,?65 S X=ACHS("$"),X2=2,X3=12 D FMT^ACHS W !
+3 ;IHS/SET/JVK ACHS*3.1*6 ADD LN BELOW FOR DOS TO PRINT ON REPORT
+4 SET Y=ACHSISU
XECUTE ^DD("DD")
WRITE Y,?14,$PIECE(ACHS(0),U),?27,ACHSNAME,?52,ACHSDOS,?65
SET X=ACHS("$")
SET X2=2
SET X3=12
DO FMT^ACHS
WRITE !
+5 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR
+6 SET ACHSTOT=ACHSTOT+1
SET ACHSTOT("$")=ACHSTOT("$")+ACHS("$")
+7 ;G L2
End DoDot:2
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
END SET X=ACHSTOT("$")
SET X2="2$"
SET X3=16
DO COMMA^%DTC
WRITE !,ACHS("="),!,"TOTALS FOR THIS REPORT: ",ACHSTOT," DENIAL",$SELECT(ACHSTOT=1:"",1:"S"),?61,X
DO RTRN^ACHS
WRITE @IOF
+1 ;
K KILL ACHSISU,ACHSNAME,ACHSTOT,DA
+1 DO ERPT^ACHS
+2 QUIT
+3 ;
HDR ; Print header.
+1 SET ACHSPG=ACHSPG+1
+2 ;IHS/SET/JVK ACHS*3.1*6 COMMENT OUT LINE BELOW
+3 ;W @IOF,!!,$$C^XBFUNC("*** CONTRACT HEALTH CARE SYSTEM REPORT ***",80),!!,ACHSLOC,!?25,"DENIAL DOCUMENTS BY ISSUE DATE",?71,"Page",$J(ACHSPG,3),!,ACHSTIME,!!,ACHST1,!!,"ISSUE DATE",?14,"DENIAL #",?27,"PATIENT",?70,"DOLLARS",!,ACHS("="),!
+4 ;IHS/SET/JVK ACHS*3.1*6 ADD TWO LINES BELOW
+5 WRITE @IOF,!!,$$C^XBFUNC("*** CONTRACT HEALTH CARE SYSTEM REPORT ***",80),!!
+6 WRITE ACHSLOC,!?25,"DENIAL DOCUMENTS BY ISSUE DATE",?71,"Page",$JUSTIFY(ACHSPG,3),!,ACHSTIME,!!,ACHST1,!!,"ISSUE DATE",?14,"DENIAL #",?27,"PATIENT",?50,"DATE OF SERVICE",?70,"DOLLARS",!,ACHS("="),!
+7 QUIT
