[628] | 1 | IBCERP3 ;ALB/TMP - EDI BATCHES WAITING MORE THAN 1 DAY REPORT ;30-SEP-96
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**137,296,377**;21-MAR-94;Build 23
|
---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | Q
|
---|
| 6 | ;
|
---|
| 7 | PENDING ; Report of batches not sent after the day the bills in it were extracted - report entry point
|
---|
| 8 | ;
|
---|
| 9 | NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBCLM
|
---|
| 10 | 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
|
---|
| 11 | ;
|
---|
| 12 | ; Ask user if they want to include claim level detail
|
---|
| 13 | S DIR(0)="Y",DIR("A")="Include Claims in each Batch",DIR("B")="Yes"
|
---|
| 14 | W ! D ^DIR K DIR
|
---|
| 15 | I $D(DIRUT) G EX
|
---|
| 16 | S IBCLM=+Y
|
---|
| 17 | ;
|
---|
| 18 | D DEVICE
|
---|
| 19 | EX ;
|
---|
| 20 | Q
|
---|
| 21 | ;
|
---|
| 22 | DEVICE ; selection of device on which to print report
|
---|
| 23 | NEW ZTRTN,ZTDESC,ZTSAVE,POP
|
---|
| 24 | W !!,"This report is 80 characters wide."
|
---|
| 25 | S ZTRTN="COMPILE^IBCERP3"
|
---|
| 26 | S ZTDESC="REPORT OF BILL BATCHES WAITING AUSTIN RECEIPT AFTER 1 DAY"
|
---|
| 27 | S ZTSAVE("IBCLM")=""
|
---|
| 28 | D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
|
---|
| 29 | DEVICEX ;
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | COMPILE ; Queued job entrypoint
|
---|
| 33 | N IBBA,IB0,IB1,IEN,IBZ,IBIFN,IB399,CLM,BALDUE,IBSTAT,ARSTAT,IB
|
---|
| 34 | ;
|
---|
| 35 | K ^TMP($J,"IBSORT")
|
---|
| 36 | S IBBA=0
|
---|
| 37 | F S IBBA=$O(^IBA(364.1,"ASTAT","P",IBBA)) Q:'IBBA D
|
---|
| 38 | . I $$BCHCHK^IBCEBUL(IBBA) Q ; Batch check function
|
---|
| 39 | . S IB0=$G(^IBA(364.1,IBBA,0)),IB1=$G(^(1))
|
---|
| 40 | . S:$P(IB0,U,7)="" $P(IB0,U,7)="~"
|
---|
| 41 | . S ^TMP($J,"IBSORT",$P(IB0,U,7),$P(IB0,U,1),IBBA)=$P(IB1,U,6)_U_$P(IB0,U,4)
|
---|
| 42 | . ;
|
---|
| 43 | . I 'IBCLM Q ; include claim data flag
|
---|
| 44 | . ;
|
---|
| 45 | . ; gather the EDI claim data for this batch
|
---|
| 46 | . S IEN=0 F S IEN=$O(^IBA(364,"C",IBBA,IEN)) Q:'IEN D
|
---|
| 47 | .. S IBZ=$G(^IBA(364,IEN,0)),IBIFN=+IBZ,IB399=$G(^DGCR(399,IBIFN,0))
|
---|
| 48 | .. S CLM=$P(IB399,U,1) S:CLM="" CLM="~"
|
---|
| 49 | .. S BALDUE=$G(^DGCR(399,IBIFN,"U1")),BALDUE=$P(BALDUE,U,1)-$P(BALDUE,U,2)
|
---|
| 50 | .. S IBSTAT=$$EXTERNAL^DILFD(399,.13,,$P(IB399,U,13))
|
---|
| 51 | .. S ARSTAT=$$EXTERNAL^DILFD(430,8,,+$P($$BILL^RCJIBFN2(IBIFN),U,2))
|
---|
| 52 | .. S IB=$P(IBZ,U,8)_U_BALDUE_U_$P(IBZ,U,3)_U_IBSTAT_U_ARSTAT
|
---|
| 53 | .. S ^TMP($J,"IBSORT",$P(IB0,U,7),$P(IB0,U,1),IBBA,CLM,IEN)=IB
|
---|
| 54 | .. Q
|
---|
| 55 | . Q
|
---|
| 56 | ;
|
---|
| 57 | D PRINT ; print report
|
---|
| 58 | D ^%ZISC ; close the device
|
---|
| 59 | K ^TMP($J,"IBSORT") ; clean up scratch global
|
---|
| 60 | I $D(ZTQUEUED) S ZTREQ="@" ; purge the task record
|
---|
| 61 | ;
|
---|
| 62 | COMPX ;
|
---|
| 63 | Q
|
---|
| 64 | ;
|
---|
| 65 | PRINT ; print the report to the specified device
|
---|
| 66 | ;
|
---|
| 67 | NEW CRT,IBPAGE,IBSTOP,IBCT,IBTYP,IBBAT,IBBA,IBV,CLM,IEN,DIR,X,Y,Z
|
---|
| 68 | I IOST["C-" S CRT=1
|
---|
| 69 | E S CRT=0
|
---|
| 70 | ;
|
---|
| 71 | S IBPAGE=0
|
---|
| 72 | I '$D(^TMP($J,"IBSORT")) D HDR1 W !,?3,"No batches found Pending Austin Receipt for >1 day."
|
---|
| 73 | S (IBSTOP,IBCT)=0
|
---|
| 74 | ;
|
---|
| 75 | S IBTYP=""
|
---|
| 76 | F S IBTYP=$O(^TMP($J,"IBSORT",IBTYP)) Q:IBTYP="" D Q:IBSTOP
|
---|
| 77 | . D HDR1
|
---|
| 78 | . S IBBAT=""
|
---|
| 79 | . 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
|
---|
| 80 | .. D:$Y>(IOSL-4) HDR1 Q:IBSTOP
|
---|
| 81 | .. W !,?2,IBBAT,?16,$$FMTE^XLFDT($P(IBV,U,1),"5Z"),?42,$P(IBV,U,2)
|
---|
| 82 | .. S IBCT=IBCT+1
|
---|
| 83 | .. I 'IBCLM Q ; no claim level detail
|
---|
| 84 | .. I $O(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,""))="" Q ; no claim data
|
---|
| 85 | .. ;
|
---|
| 86 | .. D:$Y>(IOSL-4) HDR1 Q:IBSTOP
|
---|
| 87 | .. W !!?5,"Claim",?14,"Seq",?22,"Bal Due",?32,"EDI Stat",?43,"IB Status",?57,"AR Status"
|
---|
| 88 | .. 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
|
---|
| 89 | ... S IBV=$G(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,CLM,IEN))
|
---|
| 90 | ... D:$Y>(IOSL-4) HDR1 Q:IBSTOP
|
---|
| 91 | ... 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)
|
---|
| 92 | ... Q
|
---|
| 93 | .. ;
|
---|
| 94 | .. Q:IBSTOP
|
---|
| 95 | .. D:$Y>(IOSL-4) HDR1 Q:IBSTOP
|
---|
| 96 | .. W !
|
---|
| 97 | .. Q
|
---|
| 98 | . Q
|
---|
| 99 | ;
|
---|
| 100 | I IBSTOP G PRINTX
|
---|
| 101 | D:$Y>(IOSL-4) HDR1 G:IBSTOP PRINTX
|
---|
| 102 | W !!,"Total Number of Batches: ",IBCT
|
---|
| 103 | D:$Y>(IOSL-4) HDR1 G:IBSTOP PRINTX
|
---|
| 104 | W !!?5,"*** End of Report ***"
|
---|
| 105 | I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
|
---|
| 106 | PRINTX ;
|
---|
| 107 | Q
|
---|
| 108 | ;
|
---|
| 109 | HDR1 ; Report header
|
---|
| 110 | ;
|
---|
| 111 | ; if screen output and page# already exists, do a page break
|
---|
| 112 | I IBPAGE,CRT D I IBSTOP G HDR1X
|
---|
| 113 | . S DIR(0)="E" D ^DIR K DIR
|
---|
| 114 | . I 'Y S IBSTOP=1
|
---|
| 115 | . Q
|
---|
| 116 | ;
|
---|
| 117 | ; if screen output OR page# already exists, do a form feed
|
---|
| 118 | I IBPAGE!CRT W @IOF
|
---|
| 119 | ;
|
---|
| 120 | S IBPAGE=IBPAGE+1
|
---|
| 121 | ;
|
---|
| 122 | W !,"EDI Batches Pending Austin Receipt After 1 Day",?70,"Page: ",IBPAGE
|
---|
| 123 | W !,"Run Date: ",$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
|
---|
| 124 | W !!?2,"Batch #",?16,"Transmission Date",?42,"Mail Message #"
|
---|
| 125 | S Z="",$P(Z,"-",79)="" W !?1,Z
|
---|
| 126 | ;
|
---|
| 127 | ; check for a TaskManager stop request
|
---|
| 128 | I $D(ZTQUEUED),$$S^%ZTLOAD() D G HDR1X
|
---|
| 129 | . S (ZTSTOP,IBSTOP)=1
|
---|
| 130 | . W !!!?5,"*** Report Halted by TaskManager Request ***"
|
---|
| 131 | . Q
|
---|
| 132 | HDR1X ;
|
---|
| 133 | Q
|
---|
| 134 | ;
|
---|