| [613] | 1 | IBECUS22 ;RLM/DVAMC - TRICARE PHARMACY BILLING UTILITIES ; 14-AUG-96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,89,240,274**;21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | ERROR ; File errors.
|
|---|
| 5 | ; Input: IBERR [opt] -- DHCP Error Code
|
|---|
| 6 | ; IBDRX("RX#") -- Prescription Number
|
|---|
| 7 | ; IBRESP(1) [opt] -- First record transmitted by the FI
|
|---|
| 8 | ; IBKEY -- 1 ; 2, where
|
|---|
| 9 | ; 1 = Pointer to the rx in file #52
|
|---|
| 10 | ; 2 = Pointer to the refill in file #52.1,
|
|---|
| 11 | ; or 0 for the original fill
|
|---|
| 12 | ; IBKEYD -- 1 ^ 2 ^ 3 ^ 4, where
|
|---|
| 13 | ; 1 = Rx label printing device
|
|---|
| 14 | ; 2 = Pointer to the Pharmacy in file #59
|
|---|
| 15 | ; 3 = Pointer to the Pharmacy user in
|
|---|
| 16 | ; file #200
|
|---|
| 17 | ; 4 = Pointer to the billing transaction
|
|---|
| 18 | ; in file #351.5 (cancellations only)
|
|---|
| 19 | ;
|
|---|
| 20 | I '$G(IBERR) S IBERC=$E(IBRESP(1),1,3)
|
|---|
| 21 | I $G(IBERR) K ^IBA(351.5,"APOST",IBKEY) S IBERC=IBERR
|
|---|
| 22 | S IBMACH=$S($D(IBERR):"DHCP",1:"MLINK")
|
|---|
| 23 | K IBERR,IBTXT
|
|---|
| 24 | ;
|
|---|
| 25 | ; - expand the code if necessary
|
|---|
| 26 | I $D(IBRESP(1)),$E(IBRESP(1),1,3)=" " S IBERC="001"
|
|---|
| 27 | I IBERC?1.N S IBERC=+IBERC F Q:$L(IBERC)>1 S IBERC="0"_IBERC
|
|---|
| 28 | S IBERRP=$$ERRIEN(IBMACH,IBERC)
|
|---|
| 29 | ;
|
|---|
| 30 | ; - send bulletin to the Reject Notice group
|
|---|
| 31 | S IBTXT(1)=IBMACH_" has detected error #"_IBERC_" while processing RX# "_$S($G(IBDRX("RX#"))]"":IBDRX("RX#"),1:"Unknown")
|
|---|
| 32 | S IBTXT(2)="Error text: "_$$ERRTXT(IBERRP)
|
|---|
| 33 | S XMDUN="TRICARE PHARMACY BILLING",XMDUZ=.5,XMSUB="Tricare/IPS Billing Error"
|
|---|
| 34 | S XMTEXT="IBTXT(",XMY("G.IB CHAMP RX REJ")="",XMY(+$P(IBKEYD,"^",3))=""
|
|---|
| 35 | N DIQUIET S DIQUIET=1 D DT^DICRW,^XMD
|
|---|
| 36 | ;
|
|---|
| 37 | ; - file the rejected transaction
|
|---|
| 38 | S IBCHREJ=$O(^IBA(351.52,"B",IBKEY,0))
|
|---|
| 39 | I 'IBCHREJ D ADDREJ^IBECUS21
|
|---|
| 40 | I IBCHREJ S $P(^IBA(351.52,IBCHREJ,0),"^",3)=DT,^(1)=IBERRP
|
|---|
| 41 | K IBERC,IBERRP,IBTXT,IBMACH,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ;
|
|---|
| 45 | DUP ; Act on duplicates.
|
|---|
| 46 | S XQA("G.IB CHAMP RX REJ")=""
|
|---|
| 47 | S XQAMSG="Prescription #"_$S($G(IBDRX("RX#"))]"":IBDRX("RX#"),1:"Unknown")_" is a duplicate submission."
|
|---|
| 48 | D SETUP^XQALERT
|
|---|
| 49 | K ^IBA(351.5,"APOST",IBKEY)
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | ;
|
|---|
| 53 | DISP ; Display Universal errors on alerts.
|
|---|
| 54 | N ERR,TXT,X,Y
|
|---|
| 55 | S Y=$G(^DPT(+$P(XQADATA,"^",3),0))
|
|---|
| 56 | W !!,"RX# ",$P(XQADATA,"^")," for ",$P(Y,"^")," (",$E($P(Y,"^",9),6,10),") rejected because:"
|
|---|
| 57 | S XQADATA=$P(XQADATA,"^",2)
|
|---|
| 58 | F X=1:1 S ERR=$P(XQADATA,",",X) Q:ERR="" D
|
|---|
| 59 | .S TXT=$$ERRTXT(ERR)
|
|---|
| 60 | .I TXT]"" W !?3,TXT
|
|---|
| 61 | W !!,"Press ENTER key to continue..." R X:DTIME
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | ;
|
|---|
| 65 | ERRTXT(IEN) ; Return Error Text.
|
|---|
| 66 | ; Input: IEN -- Pointer to the Error Text in file #351.51
|
|---|
| 67 | Q $P($G(^IBE(351.51,+$G(IEN),0)),"^",3)
|
|---|
| 68 | ;
|
|---|
| 69 | ERRIEN(MACH,CODE) ; Return Error File Entry Number.
|
|---|
| 70 | ; Input: MACH -- System on which the error occurred
|
|---|
| 71 | ; CODE -- Error Code
|
|---|
| 72 | N X S X=""
|
|---|
| 73 | I $G(MACH)="" G ERRIENQ
|
|---|
| 74 | I $G(CODE)="" G ERRIENQ
|
|---|
| 75 | S X=$O(^IBE(351.51,"AD",MACH,CODE,0))
|
|---|
| 76 | ERRIENQ Q X
|
|---|
