source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAERR.m@ 1000

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1IBAERR ;ALB/AAS - INTEGRATED BILLING ERROR PROCESSING ROUTINE ; 14-FEB-91
2 ;;2.0; INTEGRATED BILLING ;**7,70,347**; 21-MAR-94;Build 24
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4% ; -error processor
5 ;
6 ; Quit if the Means Test Nightly Compilation or Discharge job called
7 ; routine IBR directly.
8 Q:$G(IBJOB)=1!($G(IBJOB)=2)
9 ;
10 ; If Means Test charge, divert control to routine IBAERR1.
11 I $D(IBNOS),$P($G(^IB(+IBNOS,0)),"^",16) S IBY=Y G ^IBAERR1
12 ;
13 ; -- If copay exemption divert control to routine IBAERR2
14 I $D(IBEXERR) G ^IBAERR2
15 ;
16 I $D(ZTQUEUED) D BULL G END
17 G:+Y>0 END
18 S X2=$P(Y,"^",2) F K=1:1 S X=$P(X2,";",K) Q:X="" S X1=$O(^IBE(350.8,"AC",X,0)) I $D(^IBE(350.8,+X1,0)) S X3="E"_$P(^(0),"^",5) D @X3
19 I $P(Y,"^",3)]"" W !,$P(Y,"^",3)
20END K VA,VADM,VAERR
21 Q
22 ;
23E1 W !,$P(^IBE(350.8,+X1,0),"^",2)
24 Q
25 ;
26E2 ;
27 Q
28E3 ; -- Send no service bulletin
29 K XMY,IBTXT
30 S XMSUB="INTEGRATED BILLING BACKGROUND ERROR",XMDUZ="INTEGRATED BILLING PACKAGE"
31 S IBTXT(1)="Processing of Pharmacy co-pay entries in Integrated Billing has"
32 S IBTXT(2)="Stopped.",IBTXT(3)=" "
33 S IBTXT(4)="The Pharmacy Service Pointer does not match any entries in the "
34 S IBTXT(5)="IB ACTION TYPE file."
35 S IBTXT(6)=" "
36 S IBTXT(7)="Immediate action required."
37 S IBTXT(8)="Check the IB SERVICE/SECTION in File #59."
38 S IBTXT(9)="It must match the SERVICE field for pharmacy action types in the "
39 S IBTXT(10)="IB ACTION TYPE file. (internal entry number 1 is checked)"
40 D SEND
41 Q
42 ;
43E4 ; -- send missing number of days charges held bulletin
44 K XMY,IBTXT
45 S XMSUB="INTEGRATED BILLING BACKGROUND ERROR",XMDUZ="INTEGRATED BILLING PACKAGE"
46 S IBTXT(1)="The nightly job to auto-release patient charges on hold did not run."
47 S IBTXT(2)="The NUMBER OF DAYS PT CHARGES HELD field of the IB SITE PARAMETERS"
48 S IBTXT(3)="file is blank."
49 S IBTXT(4)=" "
50 S IBTXT(5)="Immediate action required. Select the option 'MCCR Site Parameter"
51 S IBTXT(6)="Display/Edit' to enter the required information."
52 D SEND
53 Q
54 ;
55BULL ; -send error bulletin to group when error occurs in background
56 ;
57 K XMY,IBTXT
58 S XMSUB="INTEGRATED BILLING BACKGROUND ERROR",XMDUZ="INTEGRATED BILLING PACKAGE"
59 S IBTXT(1)="Processing of entries in Integrated Billing has"
60 S IBTXT(2)="been suspended "_$S('$D(IBTAG):"while passing to AR the following",IBTAG=2:"while processing new/renew Rxs: ",IBTAG=3:"while canceling: ",1:"while updating:"),IBTXT(3)=" ",IBC=3
61 I $D(IBSAVX)!($D(IBSAVXU)),'$D(IBNOS) D SAVX
62 I $D(IBNOS) F IBI=1:1 S IBNOS1=$P(IBNOS,"^",IBI) Q:'IBNOS1 I $D(^IB(IBNOS1,0)) S IBNOD=^(0) D BD
63 S IBC=IBC+1,IBTXT(IBC)=""
64 S IBC=IBC+1,IBTXT(IBC)="You should determine if these co-payments have been passed to"
65 S IBC=IBC+1,IBTXT(IBC)="Accounts Receivable."
66 S IBC=IBC+1,IBTXT(IBC)="The following error(s) was encountered:",IBC=IBC+1,IBTXT(IBC)=""
67 D ERRTXT
68 S IBC=IBC+1,IBTXT(IBC)=""
69 I $D(IBWHER) S IBC=IBC+1,IBTXT(IBC)=$P($T(IBWHER+IBWHER),";;",2,99)
70 ;
71SEND S XMTEXT="IBTXT(",XMY(DUZ)=""
72 ;
73 S IBGRP=$S($D(^IBE(350.9,1,0)):$P(^(0),"^",9),1:"") F IBI=0:0 S IBI=$O(^XMB(3.8,+IBGRP,1,"B",IBI)) Q:'IBI S XMY(IBI)=""
74 D ^XMD K XMSUB,XMY,XMDUZ,XMTEXT,IBTXT,IBC,IBNOD,IBNOS1,IBI
75 Q
76 ;
77ERRTXT S X2=$P(Y,"^",2) F K=1:1 S X=$P(X2,";",K) Q:X="" S X1=$O(^IBE(350.8,"AC",X,0)),IBC=IBC+1,IBTXT(IBC)=" "_$S($D(^IBE(350.8,+X1,0)):$P(^(0),"^",2),1:"Unknown Error")
78 I $P(Y,"^",3)]"" S IBC=IBC+1,IBTXT(IBC)=" "_$P(Y,"^",3)
79 Q
80 ;
81BD I IBI=1 S DFN=$P(IBNOD,"^",2),IBATYPN=$S($D(^IBE(350.1,$P(IBNOD,"^",3),0)):$P(^(0),"^"),1:"") D DEM
82 S IBC=IBC+1,IBTXT(IBC)=" "_$E($P(IBNOD,"^")_" ",1,14)_$E($P(IBNOD,"^",8)_" ",1,24)_$E($P(IBNOD,"^",11)_" ",1,12)_" $"_$P(IBNOD,"^",7)
83 Q
84DEM N X,Y D DEM^VADPT
85 S IBC=IBC+1,IBTXT(IBC)=" Patient: "_VADM(1)_" Pt. Id: "_VA("PID")_" Type: "_IBATYPN
86 Q
87 ;
88SAVX S IBAX=$S($D(IBSAVXU):IBSAVXU,$D(IBSAVX):IBSAVX,1:"") Q:IBAX=""
89 S IBATYPN=$S('$P(IBAX,"^",3):"",$D(^IBE(350.1,$P(IBAX,"^",3),0)):$P(^(0),"^",1),1:""),DFN=$P(IBAX,"^",2) D DEM
90 S IBC=IBC+1,IBTXT(IBC)=" Service: "_$S($D(^DIC(49,+IBAX,0)):$P(^(0),"^"),1:"")
91 S IBC=IBC+1,IBTXT(IBC)=" User: "_$S($D(^VA(200,+$P(IBAX,"^",4),0)):$P(^(0),"^"),$D(^VA(200,+DUZ,0)):$P(^(0),"^"),1:"")
92 S IB="" F S IB=$O(IBSAVX(IB)) Q:IB="" D
93 .K IBARXN I +$P(IBSAVX(IB),"^",1)=52 S IBARXN="Rx# "_$$FILE^IBRXUTL(+$P($P(IBSAVX(IB),"^"),":",2),.01) I $P($P(IBSAVX(IB),"^"),";",2)'="" S IBARXN=IBARXN_"/Refill# "_$P($P($P(IBSAVX(IB),"^"),";",2),":",2)
94 .S IBC=IBC+1,IBTXT(IBC)=" Entry: "_$S($D(IBARXN):IBARXN,1:$P(IBSAVX(IB),"^",1)) K IBARXN
95 S IB="" F S IB=$O(IBSAVXU(IB)) Q:IB="" S IBC=IBC+1,IBTXT(IBC)=" Ref No: "_$S($D(^IB(+IB,0)):$P(^(0),"^"),1:"")
96 Q
97 ;
981 S Y="-1^IB001" Q ;patient eligibility data not calculated
99 Q
100IBWHER ;
101 ;;Error occurred before Integrated Billing entry created, Reprint labels or recancel after correcting error.
102 ;;Error occurred after Integrated Billing entry created but Accounts Receivable not updated.
103 ;;Error occurred during posting to Accounts Receivable. Check to see if amount passed!
104 ;;Error occurred after successful passing of charges to AR, IB entry may not be properly updated.
105 ;;Error occurred during eligibility determination for Co-pay.
Note: See TracBrowser for help on using the repository browser.