- 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
