ACHSDNI.m

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