Routine: ACHSDNA

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

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")

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

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

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)

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),!

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))

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 !

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       ;

ACHSDNA.m