ACHSDNRC ; IHS/OIT/FCJ - DENIAL REPORT FOR CARE NOT W/IN MED PRIORITY ; [ 10/31/2003 11:43 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**25**;JUNE 11, 2001;Build 43
;;ACHS*3.1*25 NEW ROUTINE
;
A2 ;
W !!,"Enter the BEGINNING DATE for this report: " D READ^ACHSFU G EXT:$D(DUOUT)!$D(DTOUT) S:Y?1"?".E Y="?" I $E(Y)="A"!(Y="")
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 EXT:$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
;
;
DEV ;
S ACHSIO=IO
S %ZIS="OPQ" D ^%ZIS I POP D HOME^%ZIS G END
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 END
;
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("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 ND="" F S ND=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISU,ND)) Q:ND="" D Q:$D(DUOUT)!$D(DTOUT)
..S ACHS(0)=$G(^ACHSDEN(DUZ(2),"D",ND,0)),FLG=0,ACHSREA=""
..Q:ACHS(0)=""
..Q:'$D(^ACHSDEN(DUZ(2),"D",ND,250))
..I $P(ACHS(0),U,6)="N" Q:$P($G(^ACHSDEN(DUZ(2),"D",ND,10)),U)="" S ACHSNAME=$P(^ACHSDEN(DUZ(2),"D",ND,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=""
..;TEST FOR REASON AND REASON OPTION...
..S ACHSREA=DUZ(2)_","_ND
..I $$VAL^XBDIQ1(9002071.01,ACHSREA,250)["Care" S FLG=1
..I FLG=0,$$VAL^XBDIQ1(9002071.01,ACHSREA,250)["Medical",$$VAL^XBDIQ1(9002071.01,ACHSREA,252)["Not" S FLG=1
..Q:'FLG
..K ACHSICD S ACHSICD=0,INDX=0,ACHSICD(1)=""
..I $D(^ACHSDEN(DUZ(2),"D",ND,500)) F S ACHSICD=$O(^ACHSDEN(DUZ(2),"D",ND,500,ACHSICD)) Q:ACHSICD'?1N.N D
...S INDX=INDX+1,ACHSIDX=DUZ(2)_","_ND_","_ACHSICD
...S ACHSICD(INDX)=$$VAL^XBDIQ1(9002071.05,ACHSIDX,.01) ;ICD CODE
..S ACHS("$")=+$P(^ACHSDEN(DUZ(2),"D",ND,100),U,9) ;ACTUAL CHARGES
..S Y=ACHSISU X ^DD("DD") W Y,?14,$P(ACHS(0),U),?30,ACHSICD(1),?50 S X=ACHS("$"),X2=2,X3=12 D FMT^ACHS W !
..I INDX>1 F L=2:1:INDX W ?30,ACHSICD(L),! I $Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR
..I $Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR
..S ACHSTOT=ACHSTOT+1,ACHSTOT("$")=ACHSTOT("$")+ACHS("$")
;
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
;
EXT ;
K ACHSISU,ACHSNAME,ACHSTOT,ND,L,ACHSICD,ACHSIDX,ACHSREA
D ERPT^ACHS
Q
;
HDR ; Print header.
S ACHSPG=ACHSPG+1
W @IOF,!!,$$C^XBFUNC("*** CONTRACT HEALTH CARE SYSTEM REPORT ***",80),!!
W ACHSLOC,!,$$C^XBFUNC("DENIAL REASON FOR CARE NOT",80),?71,"Page",$J(ACHSPG,3),!,$$C^XBFUNC("WITHIN MEDICAL PRIORITY",80)
W !,ACHSTIME,!!,ACHST1,!!,"ISSUE DATE",?14,"DENIAL #",?27,"ICD-DIAGNOSIS",?50,"ACTUAL CHARGES",!,ACHS("="),!
Q
ACHSDNRC ; IHS/OIT/FCJ - DENIAL REPORT FOR CARE NOT W/IN MED PRIORITY ; [ 10/31/2003 11:43 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**25**;JUNE 11, 2001;Build 43
+2 ;;ACHS*3.1*25 NEW ROUTINE
+3 ;
A2 ;
+1 WRITE !!,"Enter the BEGINNING DATE for this report: "
DO READ^ACHSFU
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXT
IF Y?1"?".E
SET Y="?"
IF $EXTRACT(Y)="A"!(Y="")
+2 SET X=Y
SET %DT="XEP"
DO ^%DT
IF Y<1
GOTO A2
SET ACHSBDT=Y
IF Y>DT
DO FUDT^ACHS
GOTO A2
+3 ;
A3 ;
+1 WRITE !!,"Enter the ENDING DATE for this report: "
DO READ^ACHSFU
IF $DATA(DTOUT)!(Y="")
GOTO EXT
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
+2 IF ACHSEDT<ACHSBDT
WRITE !!,*7,"The END is before the BEGINNING."
GOTO A2
+3 ;
+4 ;
DEV ;
+1 SET ACHSIO=IO
+2 SET %ZIS="OPQ"
DO ^%ZIS
IF POP
DO HOME^%ZIS
GOTO END
+3 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
+4 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)=""
+5 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO DEV
+6 KILL ZTSK
+7 GOTO END
+8 ;
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("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 ND=""
FOR
SET ND=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISU,ND))
IF ND=""
QUIT
Begin DoDot:2
+4 SET ACHS(0)=$GET(^ACHSDEN(DUZ(2),"D",ND,0))
SET FLG=0
SET ACHSREA=""
+5 IF ACHS(0)=""
QUIT
+6 IF '$DATA(^ACHSDEN(DUZ(2),"D",ND,250))
QUIT
+7 IF $PIECE(ACHS(0),U,6)="N"
IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ND,10)),U)=""
QUIT
SET ACHSNAME=$PIECE(^ACHSDEN(DUZ(2),"D",ND,10),U)
+8 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
+9 ;TEST FOR REASON AND REASON OPTION...
+10 SET ACHSREA=DUZ(2)_","_ND
+11 IF $$VAL^XBDIQ1(9002071.01,ACHSREA,250)["Care"
SET FLG=1
+12 IF FLG=0
IF $$VAL^XBDIQ1(9002071.01,ACHSREA,250)["Medical"
IF $$VAL^XBDIQ1(9002071.01,ACHSREA,252)["Not"
SET FLG=1
+13 IF 'FLG
QUIT
+14 KILL ACHSICD
SET ACHSICD=0
SET INDX=0
SET ACHSICD(1)=""
+15 IF $DATA(^ACHSDEN(DUZ(2),"D",ND,500))
FOR
SET ACHSICD=$ORDER(^ACHSDEN(DUZ(2),"D",ND,500,ACHSICD))
IF ACHSICD'?1N.N
QUIT
Begin DoDot:3
+16 SET INDX=INDX+1
SET ACHSIDX=DUZ(2)_","_ND_","_ACHSICD
+17 ;ICD CODE
SET ACHSICD(INDX)=$$VAL^XBDIQ1(9002071.05,ACHSIDX,.01)
End DoDot:3
+18 ;ACTUAL CHARGES
SET ACHS("$")=+$PIECE(^ACHSDEN(DUZ(2),"D",ND,100),U,9)
+19 SET Y=ACHSISU
XECUTE ^DD("DD")
WRITE Y,?14,$PIECE(ACHS(0),U),?30,ACHSICD(1),?50
SET X=ACHS("$")
SET X2=2
SET X3=12
DO FMT^ACHS
WRITE !
+20 IF INDX>1
FOR L=2:1:INDX
WRITE ?30,ACHSICD(L),!
IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR
+21 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR
+22 SET ACHSTOT=ACHSTOT+1
SET ACHSTOT("$")=ACHSTOT("$")+ACHS("$")
End DoDot:2
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+23 ;
END ;
+1 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
+2 ;
EXT ;
+1 KILL ACHSISU,ACHSNAME,ACHSTOT,ND,L,ACHSICD,ACHSIDX,ACHSREA
+2 DO ERPT^ACHS
+3 QUIT
+4 ;
HDR ; Print header.
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!!,$$C^XBFUNC("*** CONTRACT HEALTH CARE SYSTEM REPORT ***",80),!!
+3 WRITE ACHSLOC,!,$$C^XBFUNC("DENIAL REASON FOR CARE NOT",80),?71,"Page",$JUSTIFY(ACHSPG,3),!,$$C^XBFUNC("WITHIN MEDICAL PRIORITY",80)
+4 WRITE !,ACHSTIME,!!,ACHST1,!!,"ISSUE DATE",?14,"DENIAL #",?27,"ICD-DIAGNOSIS",?50,"ACTUAL CHARGES",!,ACHS("="),!
+5 QUIT
