IBCEMSR7 ;ALB/VAD - IB PRINTED CLAIMS REPORT - Print ;09-SEP-2015
;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
REPORT ; - Entry point to print report
N EORMSG,IBPAG,IBDTRG,LOCCNT,TOTCNT,TOTLN,IBX,IBQUIT,IBOF,IBDIVN
S IBDIVN=$S($D(IBDIVS("ALL")):"ALL",1:"")
I IBDIVN="" S IBX="" F S IBX=$O(IBDIVS(IBX)) Q:IBX=""!(IBX="ALL") S IBDIVN=$S(IBDIVN="":$G(IBDIVS(IBX)),1:IBDIVN_", "_$G(IBDIVS(IBX)))
S IBDTRG=$$DAT3^IBOUTL($E(IBBDT,1,10))_" - "_$$DAT3^IBOUTL($E(IBEDT,1,10))
S LOCCNT=+$P($G(^TMP($J,"IBCEMSRP-DATA")),U,1),TOTCNT=+$P($G(^TMP($J,"IBCEMSRP-DATA")),U,2)
S IBPAG=0
D PRINT
S TOTLN="Total Claims: "_TOTCNT
S TOTLN=TOTLN_" Number of Transmittable Claims Printed: "_LOCCNT
S TOTLN=TOTLN_" % Of Total Claims Printed: "_$S(TOTCNT=0:0,1:$J(((LOCCNT/TOTCNT)*100),6,2)_"%")
W !!!!,?10,TOTLN
K ^TMP($J,"IBCEMSRP-DATA")
S EORMSG="*** END OF REPORT ***"
W !!!,EORMSG
D PAUSE
;
I $D(ZTQUEUED) S ZTREQ="@" Q
D END
Q
;
END ; Close Device
K IBSORT,VARRAY,IBCOT,IBBDT,IBDIVS,IBEDT,INSADD,ZTREQ,ZTQUEUED
D ^%ZISC
Q
;
PRINT ; Print report
N SRTFLD,BILLNO,IBDATA,IBRVCDS,IBHDT
; ^TMP($J,"IBCEMSRP-DATA",SRTFLD,BILLNO)=IBTYPE_U_IBRTYP_U_IBPTYP_U_IBDVN_U_IBBLLR_U_INSCO_U_INSADD
; ^TMP($J,"IBCEMSRP-DATA",SRTFLD,BILLNO,"RVCDS")=IBRVCDS
S IBHDT=$$FMTE^XLFDT($$NOW^XLFDT,"M")
D HEADER
S SRTFLD=""
F S SRTFLD=$O(^TMP($J,"IBCEMSRP-DATA",SRTFLD)) Q:SRTFLD="" D Q:$G(IBQUIT)=1
. I $Y>(IOSL-5) D PAUSE Q:$G(IBQUIT)=1 D HEADER
. ; if sorted by insurance company, add address to subheader
. I $P(IBSORT,U)="I" S INSADD=$G(^TMP($J,"IBCEMSRP-DATA",SRTFLD))
. D SUBHD
. S BILLNO=""
. F S BILLNO=$O(^TMP($J,"IBCEMSRP-DATA",SRTFLD,BILLNO)) Q:BILLNO="" D Q:$G(IBQUIT)=1
. . S IBDATA=$G(^TMP($J,"IBCEMSRP-DATA",SRTFLD,BILLNO))
. . S IBRVCDS=$G(^TMP($J,"IBCEMSRP-DATA",SRTFLD,BILLNO,"RVCDS"))
. . ;
. . I $Y>(IOSL-5) D PAUSE Q:$G(IBQUIT)=1 D HEADER,SUBHD
. . ;
. . W !,BILLNO,?16,$P(IBDATA,U),?22,$E($P(IBDATA,U,2),1,20),?45,$E($P(IBDATA,U,3),1,25),?73,$E($P(IBDATA,U,4),1,15),?91,$E($P(IBDATA,U,5),1,15),?109,IBRVCDS ; <=== IBRVCDS NEEDS ONLY PRINT 6 PER LINE.
. . W:$P(IBSORT,U)'="I" !?6,$P(IBDATA,U,6)," ",$P(IBDATA,U,7)
. . ;
Q
;
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"Printed Claim Report"
W ?IOM-85,IBDTRG,?IOM-12,"Page: ",IBPAG
W !,"Run for: "_$S(IBCOT="C":"CPAC",1:"TRICARE/CHAMPVA")_", Divisions: "_IBDIVN,?IOM-12,$E(IBHDT,1,12)
W !,"Sorted by: "_$P(IBSORT,U,2)
Q
;
SUBHD ; Print sub-header
W !!,SRTFLD W:$P(IBSORT,U)="I" " "_$G(INSADD)
W !," Claim #",?16,"Type",?22,"RateType",?45,"PlanType",?73,"Division",?91,"Biller",?109,"RevCode"
W:$P(IBSORT,U)'="I" !?6,"InsuranceCo"
W !,$TR($J("",131)," ","-")
Q
;
PAUSE ; Pause for screen output.
Q:$E(IOST,1,2)'["C-"
N IBJJ,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
F IBJJ=$Y:1:(IOSL-7) W !
S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQUIT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMSR7 3037 printed Nov 22, 2024@17:21:16 Page 2
IBCEMSR7 ;ALB/VAD - IB PRINTED CLAIMS REPORT - Print ;09-SEP-2015
+1 ;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
REPORT ; - Entry point to print report
+1 NEW EORMSG,IBPAG,IBDTRG,LOCCNT,TOTCNT,TOTLN,IBX,IBQUIT,IBOF,IBDIVN
+2 SET IBDIVN=$SELECT($DATA(IBDIVS("ALL")):"ALL",1:"")
+3 IF IBDIVN=""
SET IBX=""
FOR
SET IBX=$ORDER(IBDIVS(IBX))
if IBX=""!(IBX="ALL")
QUIT
SET IBDIVN=$SELECT(IBDIVN="":$GET(IBDIVS(IBX)),1:IBDIVN_", "_$GET(IBDIVS(IBX)))
+4 SET IBDTRG=$$DAT3^IBOUTL($EXTRACT(IBBDT,1,10))_" - "_$$DAT3^IBOUTL($EXTRACT(IBEDT,1,10))
+5 SET LOCCNT=+$PIECE($GET(^TMP($JOB,"IBCEMSRP-DATA")),U,1)
SET TOTCNT=+$PIECE($GET(^TMP($JOB,"IBCEMSRP-DATA")),U,2)
+6 SET IBPAG=0
+7 DO PRINT
+8 SET TOTLN="Total Claims: "_TOTCNT
+9 SET TOTLN=TOTLN_" Number of Transmittable Claims Printed: "_LOCCNT
+10 SET TOTLN=TOTLN_" % Of Total Claims Printed: "_$SELECT(TOTCNT=0:0,1:$JUSTIFY(((LOCCNT/TOTCNT)*100),6,2)_"%")
+11 WRITE !!!!,?10,TOTLN
+12 KILL ^TMP($JOB,"IBCEMSRP-DATA")
+13 SET EORMSG="*** END OF REPORT ***"
+14 WRITE !!!,EORMSG
+15 DO PAUSE
+16 ;
+17 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+18 DO END
+19 QUIT
+20 ;
END ; Close Device
+1 KILL IBSORT,VARRAY,IBCOT,IBBDT,IBDIVS,IBEDT,INSADD,ZTREQ,ZTQUEUED
+2 DO ^%ZISC
+3 QUIT
+4 ;
PRINT ; Print report
+1 NEW SRTFLD,BILLNO,IBDATA,IBRVCDS,IBHDT
+2 ; ^TMP($J,"IBCEMSRP-DATA",SRTFLD,BILLNO)=IBTYPE_U_IBRTYP_U_IBPTYP_U_IBDVN_U_IBBLLR_U_INSCO_U_INSADD
+3 ; ^TMP($J,"IBCEMSRP-DATA",SRTFLD,BILLNO,"RVCDS")=IBRVCDS
+4 SET IBHDT=$$FMTE^XLFDT($$NOW^XLFDT,"M")
+5 DO HEADER
+6 SET SRTFLD=""
+7 FOR
SET SRTFLD=$ORDER(^TMP($JOB,"IBCEMSRP-DATA",SRTFLD))
if SRTFLD=""
QUIT
Begin DoDot:1
+8 IF $Y>(IOSL-5)
DO PAUSE
if $GET(IBQUIT)=1
QUIT
DO HEADER
+9 ; if sorted by insurance company, add address to subheader
+10 IF $PIECE(IBSORT,U)="I"
SET INSADD=$GET(^TMP($JOB,"IBCEMSRP-DATA",SRTFLD))
+11 DO SUBHD
+12 SET BILLNO=""
+13 FOR
SET BILLNO=$ORDER(^TMP($JOB,"IBCEMSRP-DATA",SRTFLD,BILLNO))
if BILLNO=""
QUIT
Begin DoDot:2
+14 SET IBDATA=$GET(^TMP($JOB,"IBCEMSRP-DATA",SRTFLD,BILLNO))
+15 SET IBRVCDS=$GET(^TMP($JOB,"IBCEMSRP-DATA",SRTFLD,BILLNO,"RVCDS"))
+16 ;
+17 IF $Y>(IOSL-5)
DO PAUSE
if $GET(IBQUIT)=1
QUIT
DO HEADER
DO SUBHD
+18 ;
+19 ; <=== IBRVCDS NEEDS ONLY PRINT 6 PER LINE.
WRITE !,BILLNO,?16,$PIECE(IBDATA,U),?22,$EXTRACT($PIECE(IBDATA,U,2),1,20),?45,$EXTRACT($PIECE(IBDATA,U,3),1,25),?73,$EXTRACT($PIECE(IBDATA,U,4),1,15),?91,$EXTRACT($PIECE(IBDATA,U,5),1,15),?109,IBRVCDS
+20 if $PIECE(IBSORT,U)'="I"
WRITE !?6,$PIECE(IBDATA,U,6)," ",$PIECE(IBDATA,U,7)
+21 ;
End DoDot:2
if $GET(IBQUIT)=1
QUIT
End DoDot:1
if $GET(IBQUIT)=1
QUIT
+22 QUIT
+23 ;
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+2 SET IBPAG=IBPAG+1
+3 WRITE !,"Printed Claim Report"
+4 WRITE ?IOM-85,IBDTRG,?IOM-12,"Page: ",IBPAG
+5 WRITE !,"Run for: "_$SELECT(IBCOT="C":"CPAC",1:"TRICARE/CHAMPVA")_", Divisions: "_IBDIVN,?IOM-12,$EXTRACT(IBHDT,1,12)
+6 WRITE !,"Sorted by: "_$PIECE(IBSORT,U,2)
+7 QUIT
+8 ;
SUBHD ; Print sub-header
+1 WRITE !!,SRTFLD
if $PIECE(IBSORT,U)="I"
WRITE " "_$GET(INSADD)
+2 WRITE !," Claim #",?16,"Type",?22,"RateType",?45,"PlanType",?73,"Division",?91,"Biller",?109,"RevCode"
+3 if $PIECE(IBSORT,U)'="I"
WRITE !?6,"InsuranceCo"
+4 WRITE !,$TRANSLATE($JUSTIFY("",131)," ","-")
+5 QUIT
+6 ;
PAUSE ; Pause for screen output.
+1 if $EXTRACT(IOST,1,2)'["C-"
QUIT
+2 NEW IBJJ,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 FOR IBJJ=$Y:1:(IOSL-7)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)!($DATA(DUOUT))
SET IBQUIT=1
+5 QUIT
