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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1IBCERP2 ;ALB/CXW - ELECTRONIC ERROR REPORT ; 3/13/07 1:14pm
2 ;;2.0;INTEGRATED BILLING;**137,367**;21-MAR-94;Build 11
3 Q
4BEG ; Report of electronic error
5 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,DIC,%DT,IBZ
6 N IB0,IBBDD,IBEDT,IBST1,IBST2,IBST3,IBST4,IBERR,IBTYE,Y
7 S IB0="No ERROR CODE as sort level when error messages are not displayed"
8 S DIR("A")="DO YOU WANT TO INCLUDE THE ERROR MESSAGES? ",DIR(0)="YA",DIR("B")="YES"
9 S DIR("?")="YES indicates to display the error record with messages, or NO indicates to display the error record without messages."
10 D ^DIR K DIR
11 I $D(DTOUT)!($D(DUOUT)) Q
12 S IBERR=+Y
13BDT S %DT="AEPX",%DT("A")="Begin TRANSMIT DATE: "
14 D ^%DT K %DT G BEGQ:Y<0
15 I $D(DTOUT)!($D(DUOUT)) Q
16 S IBBDD=Y
17EDT S %DT="EX" R !,"End TRANSMIT DATE: ",X:DTIME
18 S:X=" " X=IBBDD G BEGQ:(X="")!(X["^") D ^%DT K %DT G EDT:Y<0
19 I $D(DTOUT)!($D(DUOUT)) Q
20 S IBEDT=Y
21 I Y<IBBDD W *7," ??",!,"END DATE must follow BEGIN DATE." G BDT
22 S DIR(0)="SBM^E:EDI;M:MRA;B:EDI/MRA",DIR("A")="BILL TRANSMISSION TYPE"
23 S DIR("?")="Select the code to indicate the transmission type: EDI, MRA or both of EDI/MAR."
24 D ^DIR K DIR
25 I $D(DTOUT)!($D(DUOUT)) Q
26 S IBTYE=Y
27 S DIC="^VA(200,",DIC(0)="AMEQ",DIC("A")="Select AUTHORIZING BILLER: ALL// " D ^DIC
28 I $D(DTOUT)!($D(DUOUT)) Q
29 I Y<0 W "ALL" G EN0
30 S ^TMP($J,"IBBIL",+Y)=""
31 S DIC("A")="Select Another AUTHORIZING BILLER: "
32 F D Q:Y<0
33 . D ^DIC
34 . I $D(DTOUT)!($D(DUOUT)) Q
35 . Q:Y<0
36 . S ^TMP($J,"IBBIL",+Y)=""
37 I $D(DTOUT)!($D(DUOUT)) G BEGQ
38EN0 K DIC
39 S (IBZ,DIR(0))="SBM^A:AUTHORIZING BILLER;B:BILLED AMOUNT;E:EPISODE OF CARE;P:PATIENT NAME;S:PATIENT SSN;Y:PAYER NAME;C:ERROR CODE",DIR("A")="PRIMARY SORT BY"
40 S DIR("?")="Enter a code to indicate how the messages should be organized within the first sort level"
41 D ^DIR K DIR
42 I $D(DTOUT)!($D(DUOUT)) G BEGQ
43 I 'IBERR,Y="C" W !,IB0 G EN0
44 S IBST1=Y,IBST3=Y(0)
45ST2 S DIR(0)=IBZ,DIR("A")="SECONDARY SORT BY"
46 S DIR("?")="Enter a code to indicate how the messages should be organized within the second sort level"
47 D ^DIR K DIR
48 I $D(DTOUT)!($D(DUOUT)) G BEGQ
49 I 'IBERR,Y="C" W !,IB0 G ST2
50 S IBST2=Y,IBST4=Y(0)
51 I IBST1=IBST2 W !,"SECONDARY SORT must be different from PRIMARY SORT." G ST2
52 ;
53 N %ZIS,ZTSAVE,ZTRTN,ZTDESC
54 S %ZIS="QM" D ^%ZIS Q:POP
55 I $D(IO("Q")) K IO("Q") D G BEGQ
56 . S ZTRTN="EN^IBCERP2"
57 . S ZTSAVE("IBST*")="",ZTSAVE("IBERR")="",ZTSAVE("IBTYE")=""
58 . S ZTSAVE("IBBDD")="",ZTSAVE("IBEDT")=""
59 . S ZTSAVE("^TMP($J,""IBSORT"",")=""
60 . S ZTDESC="IB - Electronic Error Report"
61 . D ^%ZTLOAD K ZTSK D HOME^%ZIS
62 U IO
63EN ; Queued job entrypoint
64 N IBSTOP,IBIFN,IBPAGE,IBLINE,IB,IB1,IBMRA,IBNAM,IBTOL,IBPAY,IBSSN,IBUER,IBDPT,IBCOD,IBDDT,IBSO1,IBSO2,IBEPO,IB399
65 W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
66 S IBDDT=IBBDD-1 F S IBDDT=$O(^DGCR(399,"ALEX",IBDDT)) Q:'IBDDT!(IBDDT<IBBDD)!(IBDDT>IBEDT) S IBIFN=0 F S IBIFN=$O(^DGCR(399,"ALEX",IBDDT,IBIFN)) Q:'IBIFN D
67 . ;episode of care by event dt for op, adm dt for in
68 . S IB399=$G(^DGCR(399,IBIFN,0))
69 . S IBEPO=$P(IB399,U,5)
70 . S IBEPO=$S(IBEPO<3:"I",1:"O")
71 . I IBEPO="I" D ;inpatient with adm date
72 .. S IBEPO=$P(IB399,U,2),IBEPO=$S($D(^DPT(IBEPO,.105)):$P(^DGPM(^DPT(IBEPO,.105),0),U),1:$P(IB399,U,3))
73 . I IBEPO="O" S IBEPO=$P(IB399,U,3)
74 . S IBUER=$P($G(^DGCR(399,IBIFN,"S")),U,11)
75 . I $O(^TMP($J,"IBBIL",""))'="",'$D(^TMP($J,"IBBIL",+IBUER)) Q
76 . S IBDPT=$G(^DPT(+$P($G(^DGCR(399,IBIFN,0)),U,2),0))
77 . S IBUER=$S(IBUER="":"UNKNOWN",1:$P($G(^VA(200,IBUER,0)),U))
78 . S IBTOL=-$P($G(^DGCR(399,IBIFN,"U1")),U)
79 . S IBNAM=$E($P(IBDPT,U),1,26)
80 . S IBSSN=$E($P(IBDPT,U,9),1,9)
81 . S IBPAY=$G(^DGCR(399,IBIFN,"MP"))
82 . S IBPAY=$S(+IBPAY:$P($G(^DIC(36,+IBPAY,0)),U,1),$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)):"MEDICARE (WNR)",1:"PAYER NAME NOT FOUND")
83 . S IB=0 F S IB=$O(^IBM(361,"B",IBIFN,IB)) Q:'IB D
84 .. S IB1=$G(^IBM(361,IB,0))
85 .. Q:$P(IB1,U,3)'="R" ;only display record with error message
86 .. S IBMRA=$$MCRWNR^IBEFUNC(+$$POLICY^IBCEF(IBIFN,1,$P(IB1,U,7)))
87 .. I IBTYE="M",'IBMRA Q
88 .. I IBTYE="E",IBMRA Q
89 .. S IBCOD=0
90 .. S IBSO1=0 F S IBSO1=$O(^IBM(361,IB,1,IBSO1)) Q:'IBSO1 S IBSO2=$G(^IBM(361,IB,1,IBSO1,0)) I IBSO2["Error" S IBCOD=IBSO2 Q
91 .. S IBSO1=$S(IBST1="B":IBTOL,IBST1="A":IBUER,IBST1="E":IBEPO,IBST1="P":IBNAM,IBST1="S":IBSSN,IBST1="Y":IBPAY,1:IBCOD)
92 .. S IBSO2=$S(IBST2="B":IBTOL,IBST2="A":IBUER,IBST2="E":IBEPO,IBST2="P":IBNAM,IBST2="S":IBSSN,IBST2="Y":IBPAY,1:IBCOD)
93 .. S ^TMP($J,"IBSORT",IBSO1,IBSO2,IB)=IBIFN_U_IBTOL_U_IBUER_U_IBSSN_U_IBNAM_U_$S(IBPAY=0:"",1:IBPAY)_U_IBCOD_U_$S($P(IB1,U,4):"PAYER",1:"NONE PAYER")_U_IBDDT_U_$P(IB1,U,2)_U_IBEPO
94 ;
95LIST ;display
96 N IBFLG,IBPAT,IBFST,IBSEC,IBWNR,IBUER,IBWR
97 S (IBFLG,IBSO2,IBSTOP,IBPAGE,IBWNR,IBWR)=0
98 I '$D(^TMP($J,"IBSORT")) D G BEGQ
99 . D HDR1
100 . W !,"No entries found for this report"
101 S IBFST="" F S IBFST=$O(^TMP($J,"IBSORT",IBFST)) Q:IBFST=""!IBSTOP D
102 . I 'IBFLG D HDR1 Q:IBSTOP S IBFLG=1
103 . I (IBST1="A")!(IBST1="P") S IBSO1=0,IBFLG=0
104 . S IBSEC="" F S IBSEC=$O(^TMP($J,"IBSORT",IBFST,IBSEC)) Q:IBSEC=""!IBSTOP S IB1=0 F S IB1=$O(^TMP($J,"IBSORT",IBFST,IBSEC,IB1)) Q:'IB1!IBSTOP S IB=^TMP($J,"IBSORT",IBFST,IBSEC,IB1) D
105 .. I (IBST1="A")!(IBST1="P") S IBSO1=IBSO1+1
106 .. I $P(IB,U,6)["WNR" S IBWNR=IBWNR+1
107 .. E S IBWR=IBWR+1
108 .. S IBSO2=IBSO2+1
109 .. I IBST1="E"!(IBST2="E") W "EPISODE OF CARE: "_$$DAT1^IBOUTL($P(IB,U,11)),!
110 .. W:IBST2="A" "AUTHORIZING BILLER: "_$P(IB,U,3),!
111 .. W $$BN1^PRCAFN(+IB),?13,$P(IB,U,4),?25,$E($P(IB,U,6),1,20),?50,$$DAT1^IBOUTL($P(IB,U,10)),?61,$$DAT1^IBOUTL($P(IB,U,9)),?71,$J(-$P(IB,U,2),0,2),!
112 .. I IBST1'="P",'IBERR W "PATIENT: "_$P(IB,U,5),!!
113 .. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
114 .. Q:'IBERR ;no display error msg
115 .. S IB0=0 F S IB0=$O(^IBM(361,IB1,1,IB0)) Q:'IB0!IBSTOP D
116 ... N IBX,IBY S IBX=$G(^IBM(361,IB1,1,IB0,0))
117 ... F IBY=1:80:$L(IBX) D Q:IBSTOP
118 .... I ($Y+5)>IOSL D HDR1 Q:IBSTOP
119 .... W $E(IBX,IBY,IBY+79),!
120 .. Q:IBSTOP
121 .. W !
122 .. S IBCOD=0
123 .. S IBX=0 F S IBX=$O(^IBM(361.1,"B",+IB,IBX)) Q:'IBX!IBCOD D
124 ... S IBY=$P($G(^IBM(361.1,IBX,0)),U,15)
125 ... S IBY=$S(IBY=1:"P",IBY=2:"S",1:"T")
126 ... I $P($G(^IBM(361,IB1,0)),7)=IBY S IBCOD=IBX
127 .. I IBCOD,$P($G(^IBM(361.1,IBCOD,0)),U,13)=2 D Q:IBSTOP ;denied msg
128 ... S IB0=0
129 ... F S IB0=$O(^IBM(361.1,IBCOD,"ERR",IB0)) Q:'IB0!IBSTOP D
130 .... W ?11,$G(^IBM(361.1,1,IBCOD,"ERR",IB0,0)),!
131 .... I ($Y+5)>IOSL D HDR1 Q:IBSTOP
132 . Q:IBSTOP
133 . I (IBST1="A")!(IBST1="P") D Q:IBSTOP
134 .. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
135 .. W:'IBERR ! W "SUBTOTAL # OF BILLS FOR "_IBFST_"= ",IBSO1,!!
136 G:IBSTOP BEGQ
137 I IBTYE="M"!(IBTYE="B") D G:IBSTOP BEGQ
138 . I ($Y+5)>IOSL D HDR1 Q:IBSTOP
139 . W !,"TOTAL # OF MEDICARE (WNR) BILLS = ",IBWNR
140 I IBTYE="E"!(IBTYE="B") D G:IBSTOP BEGQ
141 . I ($Y+5)>IOSL D HDR1 Q:IBSTOP
142 . W !,"TOTAL # OF EDI BILLS = ",IBWR
143 I ($Y+5)>IOSL D HDR1 G:IBSTOP BEGQ
144 W !,"GRAND TOTAL # OF BILLS = ",IBSO2
145 I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR
146BEGQ K ^TMP($J,"IBSORT"),^TMP($J,"IBBIL")
147 I $D(ZTQUEUED) S ZTREQ="@"
148 I '$D(ZTQUEUED) W ! D ^%ZISC
149 Q
150HDR1 ;
151 N DIR,Y
152 I IBPAGE D Q:IBSTOP
153 . I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBSTOP=('Y) Q:IBSTOP
154 . W @IOF
155 S IBPAGE=IBPAGE+1
156 W !,?25,"ELECTRONIC ERROR REPORT",?72,"PAGE: ",IBPAGE,!,?25,"RUN DATE: ",$$HTE^XLFDT($H,"2")
157 W !,?25,"DATE TRANSMITTED: ",$$DAT1^IBOUTL(IBBDD)_" - "_$$DAT1^IBOUTL(IBEDT)
158 W !,?25,"BILL TRANSMISSION TYPE: ",$S(IBTYE="E":"EDI",IBTYE="M":"MRA",1:"EDI/MRA")
159 W !,?25,"SORT BY: "_IBST3_", "_IBST4
160 I (IBST1="A")!(IBST1="P") W !,$S(IBST1="A":"AUTHORIZING BILLER: ",1:"PATIENT NAME: "),$G(IBFST)
161 W !,?61,"DATE OF"
162 W !,?51,"DATE OF",?62,"LAST",?71,"BILLED"
163 W !,"BILL NUMBER",?13,"SSN",?25,"PAYER NAME",?50,"REJECTION",?61,"TRANSMIT",?71,"AMOUNT"
164 W !,$TR($J("",80)," ","-"),!
165 Q
166 ;
Note: See TracBrowser for help on using the repository browser.