source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCERP3.m@ 1240

Last change on this file since 1240 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1IBCERP3 ;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 ;
7PENDING ; 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
19EX ;
20 Q
21 ;
22DEVICE ; 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")
29DEVICEX ;
30 Q
31 ;
32COMPILE ; 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 ;
62COMPX ;
63 Q
64 ;
65PRINT ; 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
106PRINTX ;
107 Q
108 ;
109HDR1 ; 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
132HDR1X ;
133 Q
134 ;
Note: See TracBrowser for help on using the repository browser.