IBCERP3 ;ALB/TMP - EDI BATCHES WAITING MORE THAN 1 DAY REPORT ;30-SEP-96
;;2.0;INTEGRATED BILLING;**137,296,377**;21-MAR-94;Build 23
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
PENDING ; Report of batches not sent after the day the bills in it were extracted - report entry point
;
NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBCLM
I '$O(^IBA(364.1,"ASTAT","P",0)) W !!,"There are no batches that are Pending Austin Receipt.",! S DIR(0)="E" D ^DIR K DIR G EX
;
; Ask user if they want to include claim level detail
S DIR(0)="Y",DIR("A")="Include Claims in each Batch",DIR("B")="Yes"
W ! D ^DIR K DIR
I $D(DIRUT) G EX
S IBCLM=+Y
;
D DEVICE
EX ;
Q
;
DEVICE ; selection of device on which to print report
NEW ZTRTN,ZTDESC,ZTSAVE,POP
W !!,"This report is 80 characters wide."
S ZTRTN="COMPILE^IBCERP3"
S ZTDESC="REPORT OF BILL BATCHES WAITING AUSTIN RECEIPT AFTER 1 DAY"
S ZTSAVE("IBCLM")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
DEVICEX ;
Q
;
COMPILE ; Queued job entrypoint
N IBBA,IB0,IB1,IEN,IBZ,IBIFN,IB399,CLM,BALDUE,IBSTAT,ARSTAT,IB
;
K ^TMP($J,"IBSORT")
S IBBA=0
F S IBBA=$O(^IBA(364.1,"ASTAT","P",IBBA)) Q:'IBBA D
. I $$BCHCHK^IBCEBUL(IBBA) Q ; Batch check function
. S IB0=$G(^IBA(364.1,IBBA,0)),IB1=$G(^(1))
. S:$P(IB0,U,7)="" $P(IB0,U,7)="~"
. S ^TMP($J,"IBSORT",$P(IB0,U,7),$P(IB0,U,1),IBBA)=$P(IB1,U,6)_U_$P(IB0,U,4)
. ;
. I 'IBCLM Q ; include claim data flag
. ;
. ; gather the EDI claim data for this batch
. S IEN=0 F S IEN=$O(^IBA(364,"C",IBBA,IEN)) Q:'IEN D
.. S IBZ=$G(^IBA(364,IEN,0)),IBIFN=+IBZ,IB399=$G(^DGCR(399,IBIFN,0))
.. S CLM=$P(IB399,U,1) S:CLM="" CLM="~"
.. S BALDUE=$G(^DGCR(399,IBIFN,"U1")),BALDUE=$P(BALDUE,U,1)-$P(BALDUE,U,2)
.. S IBSTAT=$$EXTERNAL^DILFD(399,.13,,$P(IB399,U,13))
.. S ARSTAT=$$EXTERNAL^DILFD(430,8,,+$P($$BILL^RCJIBFN2(IBIFN),U,2))
.. S IB=$P(IBZ,U,8)_U_BALDUE_U_$P(IBZ,U,3)_U_IBSTAT_U_ARSTAT
.. S ^TMP($J,"IBSORT",$P(IB0,U,7),$P(IB0,U,1),IBBA,CLM,IEN)=IB
.. Q
. Q
;
D PRINT ; print report
D ^%ZISC ; close the device
K ^TMP($J,"IBSORT") ; clean up scratch global
I $D(ZTQUEUED) S ZTREQ="@" ; purge the task record
;
COMPX ;
Q
;
PRINT ; print the report to the specified device
;
NEW CRT,IBPAGE,IBSTOP,IBCT,IBTYP,IBBAT,IBBA,IBV,CLM,IEN,DIR,X,Y,Z
I IOST["C-" S CRT=1
E S CRT=0
;
S IBPAGE=0
I '$D(^TMP($J,"IBSORT")) D HDR1 W !,?3,"No batches found Pending Austin Receipt for >1 day."
S (IBSTOP,IBCT)=0
;
S IBTYP=""
F S IBTYP=$O(^TMP($J,"IBSORT",IBTYP)) Q:IBTYP="" D Q:IBSTOP
. D HDR1
. S IBBAT=""
. F S IBBAT=$O(^TMP($J,"IBSORT",IBTYP,IBBAT)) Q:'IBBAT!(IBSTOP) S IBBA=0 F S IBBA=$O(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA)) Q:'IBBA!IBSTOP S IBV=$G(^(IBBA)) D Q:IBSTOP
.. D:$Y>(IOSL-4) HDR1 Q:IBSTOP
.. W !,?2,IBBAT,?16,$$FMTE^XLFDT($P(IBV,U,1),"5Z"),?42,$P(IBV,U,2)
.. S IBCT=IBCT+1
.. I 'IBCLM Q ; no claim level detail
.. I $O(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,""))="" Q ; no claim data
.. ;
.. D:$Y>(IOSL-4) HDR1 Q:IBSTOP
.. W !!?5,"Claim",?14,"Seq",?22,"Bal Due",?32,"EDI Stat",?43,"IB Status",?57,"AR Status"
.. S CLM="" F S CLM=$O(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,CLM)) Q:CLM=""!IBSTOP S IEN=0 F S IEN=$O(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,CLM,IEN)) Q:'IEN!IBSTOP D Q:IBSTOP
... S IBV=$G(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,CLM,IEN))
... D:$Y>(IOSL-4) HDR1 Q:IBSTOP
... W !,?5,CLM,?15,$P(IBV,U,1),?19,$J($FN($P(IBV,U,2),"",2),10),?35,$P(IBV,U,3),?43,$E($P(IBV,U,4),1,11),?57,$E($P(IBV,U,5),1,16)
... Q
.. ;
.. Q:IBSTOP
.. D:$Y>(IOSL-4) HDR1 Q:IBSTOP
.. W !
.. Q
. Q
;
I IBSTOP G PRINTX
D:$Y>(IOSL-4) HDR1 G:IBSTOP PRINTX
W !!,"Total Number of Batches: ",IBCT
D:$Y>(IOSL-4) HDR1 G:IBSTOP PRINTX
W !!?5,"*** End of Report ***"
I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
PRINTX ;
Q
;
HDR1 ; Report header
;
; if screen output and page# already exists, do a page break
I IBPAGE,CRT D I IBSTOP G HDR1X
. S DIR(0)="E" D ^DIR K DIR
. I 'Y S IBSTOP=1
. Q
;
; if screen output OR page# already exists, do a form feed
I IBPAGE!CRT W @IOF
;
S IBPAGE=IBPAGE+1
;
W !,"EDI Batches Pending Austin Receipt After 1 Day",?70,"Page: ",IBPAGE
W !,"Run Date: ",$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
W !!?2,"Batch #",?16,"Transmission Date",?42,"Mail Message #"
S Z="",$P(Z,"-",79)="" W !?1,Z
;
; check for a TaskManager stop request
I $D(ZTQUEUED),$$S^%ZTLOAD() D G HDR1X
. S (ZTSTOP,IBSTOP)=1
. W !!!?5,"*** Report Halted by TaskManager Request ***"
. Q
HDR1X ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCERP3 4661 printed Nov 22, 2024@17:22:21 Page 2
IBCERP3 ;ALB/TMP - EDI BATCHES WAITING MORE THAN 1 DAY REPORT ;30-SEP-96
+1 ;;2.0;INTEGRATED BILLING;**137,296,377**;21-MAR-94;Build 23
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
PENDING ; Report of batches not sent after the day the bills in it were extracted - report entry point
+1 ;
+2 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBCLM
+3 IF '$ORDER(^IBA(364.1,"ASTAT","P",0))
WRITE !!,"There are no batches that are Pending Austin Receipt.",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
GOTO EX
+4 ;
+5 ; Ask user if they want to include claim level detail
+6 SET DIR(0)="Y"
SET DIR("A")="Include Claims in each Batch"
SET DIR("B")="Yes"
+7 WRITE !
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
GOTO EX
+9 SET IBCLM=+Y
+10 ;
+11 DO DEVICE
EX ;
+1 QUIT
+2 ;
DEVICE ; selection of device on which to print report
+1 NEW ZTRTN,ZTDESC,ZTSAVE,POP
+2 WRITE !!,"This report is 80 characters wide."
+3 SET ZTRTN="COMPILE^IBCERP3"
+4 SET ZTDESC="REPORT OF BILL BATCHES WAITING AUSTIN RECEIPT AFTER 1 DAY"
+5 SET ZTSAVE("IBCLM")=""
+6 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
DEVICEX ;
+1 QUIT
+2 ;
COMPILE ; Queued job entrypoint
+1 NEW IBBA,IB0,IB1,IEN,IBZ,IBIFN,IB399,CLM,BALDUE,IBSTAT,ARSTAT,IB
+2 ;
+3 KILL ^TMP($JOB,"IBSORT")
+4 SET IBBA=0
+5 FOR
SET IBBA=$ORDER(^IBA(364.1,"ASTAT","P",IBBA))
if 'IBBA
QUIT
Begin DoDot:1
+6 ; Batch check function
IF $$BCHCHK^IBCEBUL(IBBA)
QUIT
+7 SET IB0=$GET(^IBA(364.1,IBBA,0))
SET IB1=$GET(^(1))
+8 if $PIECE(IB0,U,7)=""
SET $PIECE(IB0,U,7)="~"
+9 SET ^TMP($JOB,"IBSORT",$PIECE(IB0,U,7),$PIECE(IB0,U,1),IBBA)=$PIECE(IB1,U,6)_U_$PIECE(IB0,U,4)
+10 ;
+11 ; include claim data flag
IF 'IBCLM
QUIT
+12 ;
+13 ; gather the EDI claim data for this batch
+14 SET IEN=0
FOR
SET IEN=$ORDER(^IBA(364,"C",IBBA,IEN))
if 'IEN
QUIT
Begin DoDot:2
+15 SET IBZ=$GET(^IBA(364,IEN,0))
SET IBIFN=+IBZ
SET IB399=$GET(^DGCR(399,IBIFN,0))
+16 SET CLM=$PIECE(IB399,U,1)
if CLM=""
SET CLM="~"
+17 SET BALDUE=$GET(^DGCR(399,IBIFN,"U1"))
SET BALDUE=$PIECE(BALDUE,U,1)-$PIECE(BALDUE,U,2)
+18 SET IBSTAT=$$EXTERNAL^DILFD(399,.13,,$PIECE(IB399,U,13))
+19 SET ARSTAT=$$EXTERNAL^DILFD(430,8,,+$PIECE($$BILL^RCJIBFN2(IBIFN),U,2))
+20 SET IB=$PIECE(IBZ,U,8)_U_BALDUE_U_$PIECE(IBZ,U,3)_U_IBSTAT_U_ARSTAT
+21 SET ^TMP($JOB,"IBSORT",$PIECE(IB0,U,7),$PIECE(IB0,U,1),IBBA,CLM,IEN)=IB
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 ;
+25 ; print report
DO PRINT
+26 ; close the device
DO ^%ZISC
+27 ; clean up scratch global
KILL ^TMP($JOB,"IBSORT")
+28 ; purge the task record
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+29 ;
COMPX ;
+1 QUIT
+2 ;
PRINT ; print the report to the specified device
+1 ;
+2 NEW CRT,IBPAGE,IBSTOP,IBCT,IBTYP,IBBAT,IBBA,IBV,CLM,IEN,DIR,X,Y,Z
+3 IF IOST["C-"
SET CRT=1
+4 IF '$TEST
SET CRT=0
+5 ;
+6 SET IBPAGE=0
+7 IF '$DATA(^TMP($JOB,"IBSORT"))
DO HDR1
WRITE !,?3,"No batches found Pending Austin Receipt for >1 day."
+8 SET (IBSTOP,IBCT)=0
+9 ;
+10 SET IBTYP=""
+11 FOR
SET IBTYP=$ORDER(^TMP($JOB,"IBSORT",IBTYP))
if IBTYP=""
QUIT
Begin DoDot:1
+12 DO HDR1
+13 SET IBBAT=""
+14 FOR
SET IBBAT=$ORDER(^TMP($JOB,"IBSORT",IBTYP,IBBAT))
if 'IBBAT!(IBSTOP)
QUIT
SET IBBA=0
FOR
SET IBBA=$ORDER(^TMP($JOB,"IBSORT",IBTYP,IBBAT,IBBA))
if 'IBBA!IBSTOP
QUIT
SET IBV=$GET(^(IBBA))
Begin DoDot:2
+15 if $Y>(IOSL-4)
DO HDR1
if IBSTOP
QUIT
+16 WRITE !,?2,IBBAT,?16,$$FMTE^XLFDT($PIECE(IBV,U,1),"5Z"),?42,$PIECE(IBV,U,2)
+17 SET IBCT=IBCT+1
+18 ; no claim level detail
IF 'IBCLM
QUIT
+19 ; no claim data
IF $ORDER(^TMP($JOB,"IBSORT",IBTYP,IBBAT,IBBA,""))=""
QUIT
+20 ;
+21 if $Y>(IOSL-4)
DO HDR1
if IBSTOP
QUIT
+22 WRITE !!?5,"Claim",?14,"Seq",?22,"Bal Due",?32,"EDI Stat",?43,"IB Status",?57,"AR Status"
+23 SET CLM=""
FOR
SET CLM=$ORDER(^TMP($JOB,"IBSORT",IBTYP,IBBAT,IBBA,CLM))
if CLM=""!IBSTOP
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"IBSORT",IBTYP,IBBAT,IBBA,CLM,IEN))
if 'IEN!IBSTOP
QUIT
Begin DoDot:3
+24 SET IBV=$GET(^TMP($JOB,"IBSORT",IBTYP,IBBAT,IBBA,CLM,IEN))
+25 if $Y>(IOSL-4)
DO HDR1
if IBSTOP
QUIT
+26 WRITE !,?5,CLM,?15,$PIECE(IBV,U,1),?19,$JUSTIFY($FNUMBER($PIECE(IBV,U,2),"",2),10),?35,$PIECE(IBV,U,3),?43,$EXTRACT($PIECE(IBV,U,4),1,11),?57,$EXTRACT($PIECE(IBV,U,5),1,16)
+27 QUIT
End DoDot:3
if IBSTOP
QUIT
+28 ;
+29 if IBSTOP
QUIT
+30 if $Y>(IOSL-4)
DO HDR1
if IBSTOP
QUIT
+31 WRITE !
+32 QUIT
End DoDot:2
if IBSTOP
QUIT
+33 QUIT
End DoDot:1
if IBSTOP
QUIT
+34 ;
+35 IF IBSTOP
GOTO PRINTX
+36 if $Y>(IOSL-4)
DO HDR1
if IBSTOP
GOTO PRINTX
+37 WRITE !!,"Total Number of Batches: ",IBCT
+38 if $Y>(IOSL-4)
DO HDR1
if IBSTOP
GOTO PRINTX
+39 WRITE !!?5,"*** End of Report ***"
+40 IF CRT
IF '$DATA(ZTQUEUED)
SET DIR(0)="E"
DO ^DIR
KILL DIR
PRINTX ;
+1 QUIT
+2 ;
HDR1 ; Report header
+1 ;
+2 ; if screen output and page# already exists, do a page break
+3 IF IBPAGE
IF CRT
Begin DoDot:1
+4 SET DIR(0)="E"
DO ^DIR
KILL DIR
+5 IF 'Y
SET IBSTOP=1
+6 QUIT
End DoDot:1
IF IBSTOP
GOTO HDR1X
+7 ;
+8 ; if screen output OR page# already exists, do a form feed
+9 IF IBPAGE!CRT
WRITE @IOF
+10 ;
+11 SET IBPAGE=IBPAGE+1
+12 ;
+13 WRITE !,"EDI Batches Pending Austin Receipt After 1 Day",?70,"Page: ",IBPAGE
+14 WRITE !,"Run Date: ",$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+15 WRITE !!?2,"Batch #",?16,"Transmission Date",?42,"Mail Message #"
+16 SET Z=""
SET $PIECE(Z,"-",79)=""
WRITE !?1,Z
+17 ;
+18 ; check for a TaskManager stop request
+19 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
Begin DoDot:1
+20 SET (ZTSTOP,IBSTOP)=1
+21 WRITE !!!?5,"*** Report Halted by TaskManager Request ***"
+22 QUIT
End DoDot:1
GOTO HDR1X
HDR1X ;
+1 QUIT
+2 ;
