ACHSDNU1.m

ACHSDNU1 ; IHS/ITSC/PMF - DENIAL UNMET NEED LIST (2/3) ; [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;G:$D(ZTQUEUED) ST

 ;S (ACHSZTDT,ZTDTH)=$H,ZTRTN="^ACHSDNU1",ZTDESC="CHS UNMET Need List, "_$E(ACHSBDT,2,7)_" to "_$E(ACHSEDT,2,7) F ACHS="ACHSBDT","ACHSEDT","DUZ(2)" S ZTSAVE(ACHS)=""

 ;K ION D ^%ZTLOAD S X="^%ZTSCH("""_ACHSZTDT_""","_ZTSK_")" K @X,ACHSZTDT

 ;

ST S ACHSISDT=ACHSBDT-1 K ^TMP("ACHSDNU",$J),^TMP("ACHSUN",$J)

 ;

AA S ACHSISDT=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT)) G END:+ACHSISDT=0!(+ACHSISDT>ACHSEDT) S DA=0

 ;

BB ;

 S DA=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT,DA)) G AA:+DA=0,BB:'$D(^ACHSDEN(DUZ(2),0)),BB:'$D(^ACHSDEN(DUZ(2),"D",DA,400)) S ACHSNEED=$P(^(400),U),ACHSCAT=$P(^(400),U,2)

 G BB:ACHSNEED']""!(ACHSNEED="N"),BB:ACHSCAT']""

 G C1:$P($G(^ACHSDEN(DUZ(2),"D",DA,0)),U,6)="N" S ACHSNAME=$P($G(^ACHSDEN(DUZ(2),"D",DA,0)),U,7) G BB:ACHSNAME']"",BB:'$D(^DPT(ACHSNAME,0)) S ACHSNAME=$P(^(0),U) G BB:ACHSNAME']"",DD

 ;

C1 G BB:'$D(^ACHSDEN(DUZ(2),"D",DA,10)) S ACHSNAME=$P(^ACHSDEN(DUZ(2),"D",DA,10),U) G BB:ACHSNAME']""

 ;

DD D DOLLARS(DUZ(2)) S ^TMP("ACHSUN",$J,ACHSCAT,ACHSNEED,ACHSISDT,ACHSNAME,DA)=ACHS("$")

 G BB

 ;

END K A

 G ^ACHSDNU2

 ;

DOLLARS(FACILITY) ;EP - Get Dollar Amount for each Denial.

 S ACHS("$")=$S(+$P(^ACHSDEN(FACILITY,"D",DA,100),U,9):+$P(^(100),U,9),1:+$P(^(100),U,8))

 I $D(^ACHSDEN(FACILITY,"D",DA,200)) F DA(1)=0:0 S DA(1)=$O(^ACHSDEN(FACILITY,"D",DA,200,DA(1))) Q:'DA(1)  I $D(^(DA(1),0)) S ACHS("$")=ACHS("$")+$S(+$P(^(0),U,3):$P(^(0),U,3),1:+$P(^(0),U,2))

 I $D(^ACHSDEN(FACILITY,"D",DA,210)) F DA(1)=0:0 S DA(1)=$O(^ACHSDEN(FACILITY,"D",DA,210,DA(1))) Q:'DA(1)  I $D(^(DA(1),0)) S ACHS("$")=ACHS("$")+$S(+$P(^(0),U,7):+$P(^(0),U,7),1:+$P(^(0),U,6))

 I $D(^ACHSDEN(FACILITY,"D",DA,800)) F DA(1)=0:0 S DA(1)=$O(^ACHSDEN(FACILITY,"D",DA,800,DA(1))) Q:'DA(1)  I $D(^(DA(1),0)) S ACHS("$")=ACHS("$")-(+$P(^(0),U,2))

 Q

AMT ;EP - Write amount of denial on denial letter(s).

 S ACHS("$")=0 D DOLLARS(DUZ(2)) W:$X>9 ! W ?9,"Total amount of services denied : " S X=ACHS("$") D FMT^ACHS W !

 Q

ACHSDNU1  ; IHS/ITSC/PMF - DENIAL UNMET NEED LIST (2/3) ; [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;G:$D(ZTQUEUED) ST

 +3       ;S (ACHSZTDT,ZTDTH)=$H,ZTRTN="^ACHSDNU1",ZTDESC="CHS UNMET Need List, "_$E(ACHSBDT,2,7)_" to "_$E(ACHSEDT,2,7) F ACHS="ACHSBDT","ACHSEDT","DUZ(2)" S ZTSAVE(ACHS)=""

 +4       ;K ION D ^%ZTLOAD S X="^%ZTSCH("""_ACHSZTDT_""","_ZTSK_")" K @X,ACHSZTDT

 +5       ;

ST         SET ACHSISDT=ACHSBDT-1

           KILL ^TMP("ACHSDNU",$JOB),^TMP("ACHSUN",$JOB)

 +1       ;

AA         SET ACHSISDT=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT))

           IF +ACHSISDT=0!(+ACHSISDT>ACHSEDT)

               GOTO END

           SET DA=0

 +1       ;

BB        ;

 +1        SET DA=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT,DA))

           IF +DA=0

               GOTO AA

           IF '$DATA(^ACHSDEN(DUZ(2),0))

               GOTO BB

           IF '$DATA(^ACHSDEN(DUZ(2),"D",DA,400))

               GOTO BB

           SET ACHSNEED=$PIECE(^(400),U)

           SET ACHSCAT=$PIECE(^(400),U,2)

 +2        IF ACHSNEED']""!(ACHSNEED="N")

               GOTO BB

           IF ACHSCAT']""

               GOTO BB

 +3        IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,0)),U,6)="N"

               GOTO C1

           SET ACHSNAME=$PIECE($GET(^ACHSDEN(DUZ(2),"D",DA,0)),U,7)

           IF ACHSNAME']""

               GOTO BB

           IF '$DATA(^DPT(ACHSNAME,0))

               GOTO BB

           SET ACHSNAME=$PIECE(^(0),U)

           IF ACHSNAME']""

               GOTO BB

           GOTO DD

 +4       ;

C1         IF '$DATA(^ACHSDEN(DUZ(2),"D",DA,10))

               GOTO BB

           SET ACHSNAME=$PIECE(^ACHSDEN(DUZ(2),"D",DA,10),U)

           IF ACHSNAME']""

               GOTO BB

 +1       ;

DD         DO DOLLARS(DUZ(2))

           SET ^TMP("ACHSUN",$JOB,ACHSCAT,ACHSNEED,ACHSISDT,ACHSNAME,DA)=ACHS("$")

 +1        GOTO BB

 +2       ;

END        KILL A

 +1        GOTO ^ACHSDNU2

 +2       ;

DOLLARS(FACILITY) ;EP - Get Dollar Amount for each Denial.

 +1        SET ACHS("$")=$SELECT(+$PIECE(^ACHSDEN(FACILITY,"D",DA,100),U,9):+$PIECE(^(100),U,9),1:+$PIECE(^(100),U,8))

 +2        IF $DATA(^ACHSDEN(FACILITY,"D",DA,200))

               FOR DA(1)=0:0

                   SET DA(1)=$ORDER(^ACHSDEN(FACILITY,"D",DA,200,DA(1)))

                   IF 'DA(1)

                       QUIT 

                   IF $DATA(^(DA(1),0))

                       SET ACHS("$")=ACHS("$")+$SELECT(+$PIECE(^(0),U,3):$PIECE(^(0),U,3),1:+$PIECE(^(0),U,2))

 +3        IF $DATA(^ACHSDEN(FACILITY,"D",DA,210))

               FOR DA(1)=0:0

                   SET DA(1)=$ORDER(^ACHSDEN(FACILITY,"D",DA,210,DA(1)))

                   IF 'DA(1)

                       QUIT 

                   IF $DATA(^(DA(1),0))

                       SET ACHS("$")=ACHS("$")+$SELECT(+$PIECE(^(0),U,7):+$PIECE(^(0),U,7),1:+$PIECE(^(0),U,6))

 +4        IF $DATA(^ACHSDEN(FACILITY,"D",DA,800))

               FOR DA(1)=0:0

                   SET DA(1)=$ORDER(^ACHSDEN(FACILITY,"D",DA,800,DA(1)))

                   IF 'DA(1)

                       QUIT 

                   IF $DATA(^(DA(1),0))

                       SET ACHS("$")=ACHS("$")-(+$PIECE(^(0),U,2))

 +5        QUIT 

AMT       ;EP - Write amount of denial on denial letter(s).

 +1        SET ACHS("$")=0

           DO DOLLARS(DUZ(2))

           IF $X>9

               WRITE !

           WRITE ?9,"Total amount of services denied : "

           SET X=ACHS("$")

           DO FMT^ACHS

           WRITE !

 +2        QUIT