ACHSDHQ ; IHS/ITSC/PMF - DENIAL REPORT HQ1 ; [ 10/31/2003 11:40 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3,5,6,18**;JUNE 11,2001
;ACHS*3.1*3 allow denials to be reversed
;ACHS*3.1*5 12/06/2002 report is wrong if there are reasons with the same text
;ACHS*3.1*6 3/20/2003 request to list cancels and reversal in total count
;
S ACHSBDT=$$DATE^ACHS("B","HQ1")
I ACHSBDT<1 D END Q
;
S ACHSEDT=$$DATE^ACHS("E","HQ1")
;
; --- Select print device
;S OK=0 D I 'OK D END Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002
S ACHSOK=0 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
D I 'ACHSOK D END Q ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
. S %ZIS="PQ"
. D ^%ZIS
. I POP D HOME^%ZIS Q
. ;I '$D(IO("Q")) S OK=1 Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002
. I '$D(IO("Q")) S ACHSOK=1 Q ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
. S ZTRTN="START^ACHSDHQ",ZTIO="",ZTDESC="Print CHS DENIAL HQ1 Report",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
. F %="ACHSBDT","ACHSEDT","ACHSQIO" S ZTSAVE(%)=""
. D ^%ZTLOAD
. I '$D(ZTSK) Q
. ;S OK=1 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
. S ACHSOK=1 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
. Q
I $D(IO("Q")),$D(ZTSK) D END Q ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
;
;
START ;EP - From TaskMan.
N ACHSISDT,ACHSA,ACHSNR,ACHSTCN
;S ACHSISDT=ACHSBDT-1,ACHSTCN=0
;IHS/SET/JVK ADDED BELOW 3/20/2003 ACHS*3.1*6
S ACHSISDT=ACHSBDT-1,ACHSTCN=0,ACHSYCN=0,ACHSRCN=0
;
F S ACHSISDT=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT)) Q:ACHSISDT="" Q:ACHSISDT>ACHSEDT Q:ACHSISDT<ACHSBDT D
. S ACHSA=0 F S ACHSA=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT,ACHSA)) Q:ACHSA="" D
..; I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,0)),U,8)="Y" Q
..; IHS/SET/JVK 3/20/2003 ADDED BELOW ACHS*3.1*6
.. I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,0)),U,8)="Y" S ACHSYCN=ACHSYCN+1 Q
.. ;
.. ;010202 pmf add next line
.. ;Y means cancelled. R means reversed
.. ; IHS/SET/JVK 3/20/2003 COMMENT OUT BELOW ACHS*3.1*6
.. ;I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,0)),U,8)="R" Q ; ACHS*3.1*3
.. ;
.. ; IHS/SET/JVK 3/20/2003 ADDED BELOW ACHS*3.1*6
.. I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,0)),U,8)="R" S ACHSRCN=ACHSRCN+1 Q ; ACHS*3.1*6
.. ;I $E($G(^ACHSDEN(DUZ(2),"D",ACHSA,0)))="#";IHS/SET/GTH ACHS*3.1*5 12/06/2002
.. I $E($G(^ACHSDEN(DUZ(2),"D",ACHSA,0)))="#" Q ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
.. ;
.. S ACHSNR=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,250)),U)
.. I 'ACHSNR S ACHSNR=0
.. S ACHS(ACHSNR)=$G(ACHS(ACHSNR))+1,ACHSTCN=ACHSTCN+1
.. Q
. Q
;
D BRPT^ACHS,HDR
;
;ACHS*3.1*5 12/06/2002 pmf the report was using the reason as a
; subscript. however, if more than one reason had the same
; text on it, one would overwrite the other.
; now we use the reason AND it's subscript when we place it
; into the array for display.
;S ACHSNR=0 F S ACHSNR=$O(ACHS(ACHSNR)) Q:+ACHSNR=0 S ACHSX($P($G(^ACHSDENS(ACHSNR,0)),U))=ACHS(ACHSNR);ACHS*3.1*5 12/06/2002
S ACHSNR=0 F S ACHSNR=$O(ACHS(ACHSNR)) Q:+ACHSNR=0 S ACHSREA=$P($G(^ACHSDENS(ACHSNR,0)),U),ACHSX(ACHSREA_U_ACHSNR)=ACHS(ACHSNR) ;ACHS*3.1*5 12/06/2002
;Begin New Code;IHS/SET/GTH ACHS*3.1*5 12/06/2002
I $D(ACHS(0)) S ACHSX("<Missing>^0")=ACHS(0)
;End New Code;IHS/SET/GTH ACHS*3.1*5 12/06/2002
;
;S ACHSNR=0 F S ACHSNR=$O(ACHSX(ACHSNR)) Q:ACHSNR="" W ?5,ACHSNR,?65,$J($FN(ACHSX(ACHSNR),","),8),!! I $Y>ACHSBM D RTRN^ACHS Q:$G(ACHSQUIT) D HDR;ACHS*3.1*5 12/06/2002
S ACHSNR="" F S ACHSNR=$O(ACHSX(ACHSNR)) Q:ACHSNR="" W ?5,$P(ACHSNR,U),?65,$J($FN(ACHSX(ACHSNR),","),8),!! I $Y>ACHSBM D RTRN^ACHS Q:$G(ACHSQUIT) D HDR ;ACHS*3.1*5 12/06/2002
;
;
I $D(ACHSD(0)) W ?5,"<Primary Denial Reason MISSING>",?65,$J($FN(ACHS(0),","),8),!! I $Y>ACHSBM D RTRN^ACHS Q:$G(ACHSQUIT) D HDR
W !!,$$REPEAT^XLFSTR("-",79),!!?25,"TOTAL DOCUMENTS",?65,$J($FN(ACHSTCN,","),8)
;Begin New Code;IHS/SET/JVK ACHS*3.1*6 3/20/2003
W !,?25,"TOTAL CANCELED: ",?65,$J($FN(ACHSYCN,","),8)
W !,?25,"TOTAL REVERSED: ",?65,$J($FN(ACHSRCN,","),8)
W !,?25,"GRAND TOTAL: ",?65,$J($FN((ACHSTCN+ACHSYCN+ACHSRCN),","),8)
;End New Code;IHS/SET/JVK ACHS*3.1*6 3/20/2003
D ERPT^ACHS
K ACHSYCN,ACHSRCN
Q
;
HDR ; --- Paginate, write header
W @IOF,!!,ACHSLOC,!,$$C^ACHS("CONTRACT HEALTH SERVICE DENIALS (HQ TABLE 1)",80),!,$$C^ACHS("From "_$$FMTE^XLFDT(ACHSBDT)_" To "_$$FMTE^XLFDT(ACHSEDT),80),!!,ACHSTIME,!,$$REPEAT^XLFSTR("=",79),!!!
Q
;
END ;
D ^%ZISC
K ACHSBDT,ACHSEDT,ACHSQIO
Q
ACHSDHQ ; IHS/ITSC/PMF - DENIAL REPORT HQ1 ; [ 10/31/2003 11:40 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3,5,6,18**;JUNE 11,2001
+2 ;ACHS*3.1*3 allow denials to be reversed
+3 ;ACHS*3.1*5 12/06/2002 report is wrong if there are reasons with the same text
+4 ;ACHS*3.1*6 3/20/2003 request to list cancels and reversal in total count
+5 ;
+6 SET ACHSBDT=$$DATE^ACHS("B","HQ1")
+7 IF ACHSBDT<1
DO END
QUIT
+8 ;
+9 SET ACHSEDT=$$DATE^ACHS("E","HQ1")
+10 ;
+11 ; --- Select print device
+12 ;S OK=0 D I 'OK D END Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002
+13 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
SET ACHSOK=0
+14 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
Begin DoDot:1
+15 SET %ZIS="PQ"
+16 DO ^%ZIS
+17 IF POP
DO HOME^%ZIS
QUIT
+18 ;I '$D(IO("Q")) S OK=1 Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002
+19 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
IF '$DATA(IO("Q"))
SET ACHSOK=1
QUIT
+20 SET ZTRTN="START^ACHSDHQ"
SET ZTIO=""
SET ZTDESC="Print CHS DENIAL HQ1 Report"
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+21 FOR %="ACHSBDT","ACHSEDT","ACHSQIO"
SET ZTSAVE(%)=""
+22 DO ^%ZTLOAD
+23 IF '$DATA(ZTSK)
QUIT
+24 ;S OK=1 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
+25 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
SET ACHSOK=1
+26 QUIT
End DoDot:1
IF 'ACHSOK
DO END
QUIT
+27 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
IF $DATA(IO("Q"))
IF $DATA(ZTSK)
DO END
QUIT
+28 ;
+29 ;
START ;EP - From TaskMan.
+1 NEW ACHSISDT,ACHSA,ACHSNR,ACHSTCN
+2 ;S ACHSISDT=ACHSBDT-1,ACHSTCN=0
+3 ;IHS/SET/JVK ADDED BELOW 3/20/2003 ACHS*3.1*6
+4 SET ACHSISDT=ACHSBDT-1
SET ACHSTCN=0
SET ACHSYCN=0
SET ACHSRCN=0
+5 ;
+6 FOR
SET ACHSISDT=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT))
IF ACHSISDT=""
QUIT
IF ACHSISDT>ACHSEDT
QUIT
IF ACHSISDT<ACHSBDT
QUIT
Begin DoDot:1
+7 SET ACHSA=0
FOR
SET ACHSA=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT,ACHSA))
IF ACHSA=""
QUIT
Begin DoDot:2
+8 ; I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,0)),U,8)="Y" Q
+9 ; IHS/SET/JVK 3/20/2003 ADDED BELOW ACHS*3.1*6
+10 IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,0)),U,8)="Y"
SET ACHSYCN=ACHSYCN+1
QUIT
+11 ;
+12 ;010202 pmf add next line
+13 ;Y means cancelled. R means reversed
+14 ; IHS/SET/JVK 3/20/2003 COMMENT OUT BELOW ACHS*3.1*6
+15 ;I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,0)),U,8)="R" Q ; ACHS*3.1*3
+16 ;
+17 ; IHS/SET/JVK 3/20/2003 ADDED BELOW ACHS*3.1*6
+18 ; ACHS*3.1*6
IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,0)),U,8)="R"
SET ACHSRCN=ACHSRCN+1
QUIT
+19 ;I $E($G(^ACHSDEN(DUZ(2),"D",ACHSA,0)))="#";IHS/SET/GTH ACHS*3.1*5 12/06/2002
+20 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
IF $EXTRACT($GET(^ACHSDEN(DUZ(2),"D",ACHSA,0)))="#"
QUIT
+21 ;
+22 SET ACHSNR=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,250)),U)
+23 IF 'ACHSNR
SET ACHSNR=0
+24 SET ACHS(ACHSNR)=$GET(ACHS(ACHSNR))+1
SET ACHSTCN=ACHSTCN+1
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 ;
+28 DO BRPT^ACHS
DO HDR
+29 ;
+30 ;ACHS*3.1*5 12/06/2002 pmf the report was using the reason as a
+31 ; subscript. however, if more than one reason had the same
+32 ; text on it, one would overwrite the other.
+33 ; now we use the reason AND it's subscript when we place it
+34 ; into the array for display.
+35 ;S ACHSNR=0 F S ACHSNR=$O(ACHS(ACHSNR)) Q:+ACHSNR=0 S ACHSX($P($G(^ACHSDENS(ACHSNR,0)),U))=ACHS(ACHSNR);ACHS*3.1*5 12/06/2002
+36 ;ACHS*3.1*5 12/06/2002
SET ACHSNR=0
FOR
SET ACHSNR=$ORDER(ACHS(ACHSNR))
IF +ACHSNR=0
QUIT
SET ACHSREA=$PIECE($GET(^ACHSDENS(ACHSNR,0)),U)
SET ACHSX(ACHSREA_U_ACHSNR)=ACHS(ACHSNR)
+37 ;Begin New Code;IHS/SET/GTH ACHS*3.1*5 12/06/2002
+38 IF $DATA(ACHS(0))
SET ACHSX("<Missing>^0")=ACHS(0)
+39 ;End New Code;IHS/SET/GTH ACHS*3.1*5 12/06/2002
+40 ;
+41 ;S ACHSNR=0 F S ACHSNR=$O(ACHSX(ACHSNR)) Q:ACHSNR="" W ?5,ACHSNR,?65,$J($FN(ACHSX(ACHSNR),","),8),!! I $Y>ACHSBM D RTRN^ACHS Q:$G(ACHSQUIT) D HDR;ACHS*3.1*5 12/06/2002
+42 ;ACHS*3.1*5 12/06/2002
SET ACHSNR=""
FOR
SET ACHSNR=$ORDER(ACHSX(ACHSNR))
IF ACHSNR=""
QUIT
WRITE ?5,$PIECE(ACHSNR,U),?65,$JUSTIFY($FNUMBER(ACHSX(ACHSNR),","),8),!!
IF $Y>ACHSBM
DO RTRN^ACHS
IF $GET(ACHSQUIT)
QUIT
DO HDR
+43 ;
+44 ;
+45 IF $DATA(ACHSD(0))
WRITE ?5,"<Primary Denial Reason MISSING>",?65,$JUSTIFY($FNUMBER(ACHS(0),","),8),!!
IF $Y>ACHSBM
DO RTRN^ACHS
IF $GET(ACHSQUIT)
QUIT
DO HDR
+46 WRITE !!,$$REPEAT^XLFSTR("-",79),!!?25,"TOTAL DOCUMENTS",?65,$JUSTIFY($FNUMBER(ACHSTCN,","),8)
+47 ;Begin New Code;IHS/SET/JVK ACHS*3.1*6 3/20/2003
+48 WRITE !,?25,"TOTAL CANCELED: ",?65,$JUSTIFY($FNUMBER(ACHSYCN,","),8)
+49 WRITE !,?25,"TOTAL REVERSED: ",?65,$JUSTIFY($FNUMBER(ACHSRCN,","),8)
+50 WRITE !,?25,"GRAND TOTAL: ",?65,$JUSTIFY($FNUMBER((ACHSTCN+ACHSYCN+ACHSRCN),","),8)
+51 ;End New Code;IHS/SET/JVK ACHS*3.1*6 3/20/2003
+52 DO ERPT^ACHS
+53 KILL ACHSYCN,ACHSRCN
+54 QUIT
+55 ;
HDR ; --- Paginate, write header
+1 WRITE @IOF,!!,ACHSLOC,!,$$C^ACHS("CONTRACT HEALTH SERVICE DENIALS (HQ TABLE 1)",80),!,$$C^ACHS("From "_$$FMTE^XLFDT(ACHSBDT)_" To "_$$FMTE^XLFDT(ACHSEDT),80),!!,ACHSTIME,!,$$REPEAT^XLFSTR("=",79),!!!
+2 QUIT
+3 ;
END ;
+1 DO ^%ZISC
+2 KILL ACHSBDT,ACHSEDT,ACHSQIO
+3 QUIT
