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

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1IBCERP5 ;ALB/TMP - BATCH LIST ;02-OCT-96
2 ;;2.0;INTEGRATED BILLING;**137,296**;21-MAR-94
3 Q
4LIST ; List batch detail
5 N DIR,IBS1,Y,IBINCL
6 S DIR("A")="DO YOU WANT TO INCLUDE A LIST OF BILLS WITH EACH BATCH?: ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR
7 I $D(DTOUT)!($D(DUOUT)) Q
8 S IBINCL=+Y
9 S DIR("A")="SORT BY",DIR(0)="SBM^B:BATCH;D:LAST DATE TRANSMITTED;S:LATEST BATCH RECEIPT STATUS",DIR("B")="B" D ^DIR K DIR
10 I $D(DTOUT)!($D(DUOUT)) Q
11 S IBS1=Y,(IBS1(1),IBS1(2))=""
12 ;
13 I IBS1="B" D Q:IBS1(1)=""!(IBS1(2)="") G LISTQ
14 .F S DIR("?")="Enter the first 10-digit batch number you want included on the report",DIR("A")="Start with BATCH #: ",DIR("B")="FIRST",DIR(0)="FA" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) D Q:IBS1(1)'=""
15 ..I Y'="FIRST",Y'?10N W !,*7,"Must enter a 10-digit batch #" Q
16 ..S IBS1(1)=$S(Y:Y-1,1:0)
17 .Q:IBS1(1)=""
18 .F S DIR("?")="Enter the last 10-digit batch number you want included on the report",DIR("A")="Go to BATCH #: ",DIR("B")="LAST",DIR(0)="FA" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) D Q:IBS1(2)'=""
19 ..I Y'="LAST",Y'?10N W !,*7,"Must enter a 10-digit batch #" Q
20 ..S IBS1(2)=$S(Y="LAST":9999999999,1:+Y)
21 ;
22 I IBS1="D" D Q:IBS1(1)=""!(IBS1(2)="") G LISTQ
23 .F S DIR("?")="Enter the first date you want to include on the report",DIR("A")="Start with LAST TRANSMIT DATE: ",DIR("B")="FIRST",DIR(0)="FA" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) D Q:IBS1(1)'=""
24 ..I Y'="FIRST" S X=Y,%DT="P" D ^%DT I Y<0 W !,*7,"Must enter a valid date" Q
25 ..S IBS1(1)=$S(Y:Y-.0000001,1:0)
26 .Q:IBS1(1)=""
27 .F S DIR("?")="Enter the last date you want to include on the report",DIR("A")="Go to LAST TRANSMIT DATE: ",DIR("B")="LAST",DIR(0)="FA" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) D Q:IBS1(2)'=""
28 ..I Y'="LAST" S X=Y,%DT="P" D ^%DT I Y<0 W !,*7,"Must enter a valid date" Q
29 ..S IBS1(2)=$S(Y="LAST":9999999,1:Y+.9999)
30 ;
31 I IBS1="S" D Q:IBS1(1)="" G LISTQ
32 . N DA
33 .S DIR("A")="Select BATCH STATUS: ",DIR(0)="364.1,.02A" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) S (IBS1(1),IBS1(2))=$P(Y,U)
34 ;
35 Q
36 ;
37LISTQ S %ZIS="QM" D ^%ZIS Q:POP
38 I $D(IO("Q")) K IO("Q") S ZTRTN="EN^IBCERP5",ZTSAVE("IB*")="",ZTDESC="EDI 837 BATCH DETAIL LIST" D ^%ZTLOAD K ZTSK D HOME^%ZIS Q
39 U IO
40EN ; Queued job entrypoint
41 N IBPAGE,IBLINE,IBHDRDT,IB0,IB1,IBB,IBB0,IBBL,IB399,IBFIRST,IBSTOP,DIR,Y,IBXR,IBX,IBB3614,IBRIN,IBLTDT,IBTRSTAT
42 W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
43 S (IBPAGE,IBSTOP)=0 D HDR1
44 S IBXR=$S(IBS1="B":"B",IBS1="D":"ALT",1:"ASTAT")
45 ;
46 S IBV=IBS1(1)
47 F S IBV=$S(IBS1'="S":$O(^IBA(364.1,IBXR,IBV)),1:IBV) Q:IBV=""!(IBV]]IBS1(2)) S IB=0 F S IB=$O(^IBA(364.1,IBXR,IBV,IB)) S:'IB&(IBS1="S") IBV="" Q:'IB S IB0=$G(^IBA(364.1,IB,0)),IB1=$G(^(1)) D G:IBSTOP Q
48 .D:IBLINE>(IOSL-15) HDR1 Q:IBSTOP
49 .I 'IBFIRST W ! S IBLINE=IBLINE+1
50 .S:IBFIRST IBFIRST=0 S IBRESUB=$P(IB0,U,13)
51 . K IBX S IBX=1
52 . D:$P(IB0,U,10) CKRES^IBCESRV2(IB,0,.IBX)
53 .W !,"Batch #: ",$P(IB0,U),?40,"Rejected?: ",$P("NO^YES",U,+$P(IB0,U,5)+1),?60,$S(IBRESUB:"Resubmit: "_$S($P(IB0,U,10):"IN",1:"")_"COMPLETE",1:"")
54 .W !," Batch Type : ",$$EXPAND^IBTRE(364.1,.07,$P(IB0,U,7)),?42,"# Bills: ",$P(IB0,U,3),?60,"Mail Msg: ",$P(IB0,U,4)
55 .S IBLINE=IBLINE+1
56 .I IBLINE>(IOSL-5) D HDR1 Q:IBSTOP
57 .W !," Received in Austin?: "_$S($P(IB0,U,2)="A0":"Yes",1:"No")
58 .W !," Status Date: ",$$FMTE^XLFDT($P(IB1,U,5),2),?36,"Date Recorded: ",$$FMTE^XLFDT($P(IB1,U,6),2)
59 .S IBLINE=IBLINE+1
60 .I IBLINE>(IOSL-5) D HDR1 Q:IBSTOP
61 .W !," First Sent : ",$$FMTE^XLFDT($P(IB1,U),2),?47,"By: ",$E($$EXPAND^IBTRE(364.1,1.02,$P(IB1,U,2)),1,29)
62 .S IBLINE=IBLINE+1
63 .I IBLINE>(IOSL-5) D HDR1 Q:IBSTOP
64 .I $P(IB1,U)'=$P(IB1,U,3) W !," Last Sent : ",$$FMTE^XLFDT($P(IB1,U,3),2),?47,"By: ",$E($$EXPAND^IBTRE(364.1,1.02,$P(IB1,U,4)),1,29) S IBLINE=IBLINE+1
65 .I IBLINE>(IOSL-5) D HDR1 Q:IBSTOP
66 .I $P(IB0,U,8)'="" W !," ",$E($P(IB0,U,8),1,79) S IBLINE=IBLINE+1
67 .;EJK 4/5/5 Claim detail can come from 2 source files now.
68 .Q:'IBINCL ;List of bills not wanted
69 .I IBLINE>(IOSL-5) D HDR1 Q:IBSTOP
70 .W !," **BILLS**",?25,"Number Transmit Status Resubmit Batch #"
71 .I IBLINE>(IOSL-6) D HDR1 Q:IBSTOP
72 .K ^TMP($J,"IBSORT")
73 .W !,?2,$S($P(IB0,U,10):"* = NOT RESUBMITTED",1:""),?25,"-------- ------------------------- ----------------" S IBLINE=IBLINE+2
74 .;EJK 4/5/5 Get E-Claims test data from new file 361.4
75 .I $O(^IBM(361.4,"C",IB,"")) D
76 ..S (IBB,IBBL)=0
77 ..F S IBB=$O(^IBM(361.4,"C",IB,IBB)) Q:'IBB D
78 ...S IBB0=$G(^IBM(361.4,IBB,0))
79 ...S IB399=$G(^DGCR(399,+IBB0,0))
80 ...S IBB3614=$P(IBB0,U,1)
81 ...S IBLTDT=$P(IBB0,U,2)
82 ...S IBRIN="",IBRIN=$O(^IBM(361.4,IBB,1,"ALTD",IBLTDT,IBRIN),-1)
83 ...S $P(IBB3614,U,7)=$P($G(^IBM(361.4,IBB,1,IBRIN,0)),U,4)
84 ...S ^TMP($J,"IBSORT",$P(IB399,U),IBB)=IBB3614
85 ...Q
86 ..Q
87 .I $O(^IBA(364,"C",IB,"")) D
88 ..S (IBB,IBBL)=0 F S IBB=$O(^IBA(364,"C",IB,IBB)) Q:'IBB S IBB0=$G(^IBA(364,IBB,0)),IB399=$G(^DGCR(399,+IBB0,0)) S ^TMP($J,"IBSORT",$P(IB399,U),IBB)=IBB0 S:$D(IBX(IBB)) ^(IBB,1)=1
89 .S IBB1="" F S IBB1=$O(^TMP($J,"IBSORT",IBB1)) Q:IBB1=""!(IBSTOP) S IBB=0 F S IBB=$O(^TMP($J,"IBSORT",IBB1,IBB)) Q:'IBB S IBB0=$G(^(IBB)) D Q:IBSTOP
90 ..I IBLINE>(IOSL-5) D HDR1 Q:IBSTOP D
91 ...W !,"Batch #: ",$$EXPAND^IBTRE(364,.02,$P(IBB0,U,2)),?25,"Number Transmit Status" W:IBRESUB " Resubmit Batch #"
92 ...W !,?9,"(continued)",?25,"-------- ------------------------- ----------------"
93 ...S IBLINE=IBLINE+2,IBFIRST=0
94 ..S IBTRSTAT=$$EXPAND^IBTRE(364,.03,$P(IBB0,U,3))
95 ..W !,?24,$S($G(^TMP($J,"IBSORT",IBB1,IBB,1)):"*",1:" "),IBB1
96 ..W ?35,$S($G(IBTRSTAT)'="":IBTRSTAT,1:"N/A")
97 ..W ?65,$$EXPAND^IBTRE(364,.06,$P(IBB0,U,6))
98 ..S IBLINE=IBLINE+1
99 G:IBSTOP Q
100 I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR
101Q I '$D(ZTQUEUED) D ^%ZISC
102 I $D(ZTQUEUED) S ZTREQ="@"
103 K ^TMP($J,"IBSORT")
104 Q
105 ;
106HDR1 ; Header code
107 N Z,DIR,Y
108 I 'IBPAGE S IBHDRDT=$$HTE^XLFDT($H,"2")
109 I IBPAGE D Q:IBSTOP
110 .I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBSTOP=('Y) Q:IBSTOP
111 .W @IOF
112 S IBPAGE=IBPAGE+1
113 W !,?32,"BATCH DETAIL LIST",?70,"PAGE: ",IBPAGE,!,?27,"RUN DATE: ",IBHDRDT
114 S Z="",$P(Z,"-",81)="" W !,Z
115 S IBLINE=3,IBFIRST=1
116 Q
117 ;
Note: See TracBrowser for help on using the repository browser.