- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCERP3.m
r613 r623 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 ; 1 IBCERP3 ;ALB/TMP - EDI BATCHES WAITING MORE THAN 1 DAY REPORT ;30-SEP-96 2 ;;2.0;INTEGRATED BILLING;**137,296**;21-MAR-94 3 Q 4 ; 5 PENDING ;Report of batches not sent after the day the bills in it were extracted 6 W ! 7 S %ZIS="QM" D ^%ZIS Q:POP 8 I $D(IO("Q")) K IO("Q") S ZTRTN="EN^IBCERP3",ZTDESC="REPORT OF BILL BATCHES WAITING AUSTIN RECEIPT AFTER 1 DAY" D ^%ZTLOAD K ZTSK D HOME^%ZIS Q 9 U IO 10 EN ; Queued job entrypoint 11 N IBPAGE,IBHDRDT,IBLINE,IBSTOP,IBBA,IBBAT,IBCT,IBTYP,IBTYPN,IBV,DIR,Y,IB0,IB1 12 ; 13 K ^TMP($J,"IBSORT") 14 S (IBPAGE,IBBA)=0 15 ; 16 ; esg - 5/12/05 - IB*2*296 - Additional check to make sure there are 17 ; bills in the batch in file 364 before including it. Similar to 18 ; existing functionality in routine ^IBCEBUL. 19 ; 20 F S IBBA=$O(^IBA(364.1,"ASTAT","P",IBBA)) Q:'IBBA S IB0=$G(^IBA(364.1,IBBA,0)),IB1=$G(^(1)) I DT-($P(IB1,U,6)\1)'<1,$P(IB0,U,7)'="",$O(^IBA(364,"C",IBBA,0)) S ^TMP($J,"IBSORT",$P(IB0,U,7),$P(IB0,U),IBBA)=$P(IB1,U,6)_U_$P(IB0,U,4) 21 ; 22 W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen 23 I '$D(^TMP($J,"IBSORT")) D HDR1("") W !,?3,"No data found for this report" 24 S (IBSTOP,IBCT)=0 25 ; 26 S IBTYP="" 27 F S IBTYP=$O(^TMP($J,"IBSORT",IBTYP)) Q:IBTYP="" D G:IBSTOP STOP 28 . S IBTYPN=$$EXPAND^IBTRE(364.1,.07,IBTYP) 29 . D HDR1(IBTYPN) 30 . S IBBAT="" 31 . 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 S IBV=$G(^(IBBA)) D Q:IBSTOP 32 .. D:IBLINE>(IOSL-5) HDR1(IBTYPN) Q:IBSTOP 33 .. W !,?6,IBBAT,?20,$$FMTE^XLFDT($P(IBV,U),1),?46,$P(IBV,U,2) 34 .. S IBCT=IBCT+1,IBLINE=IBLINE+1 35 ; 36 W !!,"TOTAL # OF BATCHES: ",IBCT 37 ; 38 I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR 39 STOP I '$D(ZTQUEUED) D ^%ZISC 40 I $D(ZTQUEUED) S ZTREQ="@" 41 K ^TMP($J,"IBSORT") 42 Q 43 ; 44 HDR1(IB) ; Report header 45 ; IB = the text for the type of batch 46 N Z,DIR,Y 47 I 'IBPAGE S IBHDRDT=$$HTE^XLFDT($H,2) 48 I IBPAGE D Q:IBSTOP 49 . I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBSTOP=('Y) Q:IBSTOP 50 . W @IOF 51 S IBPAGE=IBPAGE+1 52 W !,?14,"REPORT OF BATCHES STILL WAITING AUSTIN RECEIPT AFTER 1 DAY",?70,"PAGE: ",IBPAGE,!,?((68-$L(IB))\2),"BATCH TYPE: "_IB 53 W !,?26,"RUN DATE: ",IBHDRDT,! 54 W !,?6,"BATCH #",?20,"WAITING SINCE",?46,"MAIL MESSAGE #",! 55 S Z="",$P(Z,"-",76)="" W ?2,Z,! 56 S IBLINE=6 57 Q 58 ;
Note:
See TracChangeset
for help on using the changeset viewer.
