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

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1IBAERR1 ;ALB/CPM - INTEGRATED BILLING ERROR PROCESSING ROUTINE (CON'T) ; 03-JAN-92
2 ;;2.0;INTEGRATED BILLING;**15,133,153**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine will be used to send mail messages when errors
6 ; have occurred during the processing of Means Test charges.
7 ; Input: IBJOB = 1 Nightly Compilation job
8 ; 2 Discharge job
9 ; 4 Add/Edit/Cancel Charges
10 ; 5 Appointment Event Driver
11 ; 7 Means Test Event Driver
12 ; 8 OPT Billing Update
13 ; 9 IVM Back-Billing job
14 ; DFN {opt}, IBDUZ, IBY, IBWHER
15 ;
16 N IBSTART K IBT
17 I $D(DFN)#2 S IBPT=$$PT^IBEFUNC(DFN)
18 I '$G(IBJOB) S IBJOB=5 ; if MT charge entered thru Appt Event Driver uses filer so IBJOB not set,see EN2^IBAMTS2
19 S XMSUB=$S($D(IBPT)#2:$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" -",1:"MEANS TEST BILLING")_" ERROR ENCOUNTERED"
20 S IBT(1)="An error has been encountered while processing Means Test charges"
21 S IBT(2)="during the "_$P($T(JOB+IBJOB),";;",2,99)_" for the following patient:"
22 S IBT(3)=" ",IBC=3
23 D PAT
24 S IBC=IBC+1,IBT(IBC)=" "
25 S IBC=IBC+1,IBT(IBC)="The Means Test billing history for this patient must be reviewed."
26 S IBC=IBC+1,IBT(IBC)="The following error was encountered:"
27 S IBC=IBC+1,IBT(IBC)=" "
28 S:IBJOB=4 IBSTART=IBC D ERR
29 S IBC=IBC+1,IBT(IBC)=" "
30 S IBM=$P($T(TEXT+IBWHER^IBAMTEL),";;",2,99),IBC=IBC+1
31 S:$L(IBM)<80 IBT(IBC)=IBM
32 I $L(IBM)>79 S IBB=$E(IBM,1,79),IBT(IBC)=$P(IBB," ",1,$L(IBB," ")-1),IBC=IBC+1,IBT(IBC)=$P(IBM," ",$L(IBB," "),999)
33 I IBJOB=4 F IBI=IBSTART:1:IBC W !,IBT(IBI)
34 D MAIL K IBT,IBM,IBB,IBC,IBPT,XMSUB,XMY,XMTEXT,XMDUZ
35 Q
36 ;
37PAT ; Set up patient demographic and user data for message.
38 S IBC=IBC+1,IBT(IBC)=" Patient: "_$S($D(IBPT)#2:$P(IBPT,"^")_" Pt. ID: "_$P(IBPT,"^",2),1:"Not Defined")
39 S IBC=IBC+1,IBT(IBC)=" User: "_$P($G(^VA(200,+IBDUZ,0)),"^")
40 Q
41 ;
42ERR ; Set up error message text.
43 S X2=$P(IBY,"^",2) F K=1:1 S X=$P(X2,";",K) Q:X="" D
44 . S X1=$O(^IBE(350.8,"AC",X,0)),IBC=IBC+1
45 . S IBT(IBC)=" "_$S($D(^IBE(350.8,+X1,0)):$P(^(0),"^",2),X]"":X,1:"Unknown Error")
46 I $P(IBY,"^",3)]"" S IBC=IBC+1,IBT(IBC)=" "_$P(IBY,"^",3)
47 K X,X1,X2 Q
48 ;
49MAIL ; Transmit.
50 N IBI,IBGRP S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
51 K XMY
52 ;S IBGRP=$P($G(^IBE(350.9,1,0)),"^",11)
53 ;F IBI=0:0 S IBI=$O(^XMB(3.8,+IBGRP,1,"B",IBI)) Q:'IBI S XMY(IBI)=""
54 S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),"^",11),0)),"^")
55 I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
56 D ^XMD
57 Q
58 ;
59JOB ; Job Descriptions
60 ;;Nightly Compilation job
61 ;;Discharge job
62 ;;<Undefined job #3>
63 ;;Cancel/Edit/Add Option
64 ;;Check Out job
65 ;;<Undefined job #6>
66 ;;Means Testing
67 ;;OPT Billing Update
68 ;;IVM Back-Billing job
Note: See TracBrowser for help on using the repository browser.