- 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
