Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBECUS22

IBECUS22.m

Go to the documentation of this file.
  1. IBECUS22 ;RLM/DVAMC - TRICARE PHARMACY BILLING UTILITIES ; 14-AUG-96
  1. ;;2.0;INTEGRATED BILLING;**52,89,240,274**;21-MAR-94
  1. ;
  1. ERROR ; File errors.
  1. ; Input: IBERR [opt] -- DHCP Error Code
  1. ; IBDRX("RX#") -- Prescription Number
  1. ; IBRESP(1) [opt] -- First record transmitted by the FI
  1. ; IBKEY -- 1 ; 2, where
  1. ; 1 = Pointer to the rx in file #52
  1. ; 2 = Pointer to the refill in file #52.1,
  1. ; or 0 for the original fill
  1. ; IBKEYD -- 1 ^ 2 ^ 3 ^ 4, where
  1. ; 1 = Rx label printing device
  1. ; 2 = Pointer to the Pharmacy in file #59
  1. ; 3 = Pointer to the Pharmacy user in
  1. ; file #200
  1. ; 4 = Pointer to the billing transaction
  1. ; in file #351.5 (cancellations only)
  1. ;
  1. I '$G(IBERR) S IBERC=$E(IBRESP(1),1,3)
  1. I $G(IBERR) K ^IBA(351.5,"APOST",IBKEY) S IBERC=IBERR
  1. S IBMACH=$S($D(IBERR):"DHCP",1:"MLINK")
  1. K IBERR,IBTXT
  1. ;
  1. ; - expand the code if necessary
  1. I $D(IBRESP(1)),$E(IBRESP(1),1,3)=" " S IBERC="001"
  1. I IBERC?1.N S IBERC=+IBERC F Q:$L(IBERC)>1 S IBERC="0"_IBERC
  1. S IBERRP=$$ERRIEN(IBMACH,IBERC)
  1. ;
  1. ; - send bulletin to the Reject Notice group
  1. S IBTXT(1)=IBMACH_" has detected error #"_IBERC_" while processing RX# "_$S($G(IBDRX("RX#"))]"":IBDRX("RX#"),1:"Unknown")
  1. S IBTXT(2)="Error text: "_$$ERRTXT(IBERRP)
  1. S XMDUN="TRICARE PHARMACY BILLING",XMDUZ=.5,XMSUB="Tricare/IPS Billing Error"
  1. S XMTEXT="IBTXT(",XMY("G.IB CHAMP RX REJ")="",XMY(+$P(IBKEYD,"^",3))=""
  1. N DIQUIET S DIQUIET=1 D DT^DICRW,^XMD
  1. ;
  1. ; - file the rejected transaction
  1. S IBCHREJ=$O(^IBA(351.52,"B",IBKEY,0))
  1. I 'IBCHREJ D ADDREJ^IBECUS21
  1. I IBCHREJ S $P(^IBA(351.52,IBCHREJ,0),"^",3)=DT,^(1)=IBERRP
  1. K IBERC,IBERRP,IBTXT,IBMACH,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
  1. Q
  1. ;
  1. ;
  1. DUP ; Act on duplicates.
  1. S XQA("G.IB CHAMP RX REJ")=""
  1. S XQAMSG="Prescription #"_$S($G(IBDRX("RX#"))]"":IBDRX("RX#"),1:"Unknown")_" is a duplicate submission."
  1. D SETUP^XQALERT
  1. K ^IBA(351.5,"APOST",IBKEY)
  1. Q
  1. ;
  1. ;
  1. DISP ; Display Universal errors on alerts.
  1. N ERR,TXT,X,Y
  1. S Y=$G(^DPT(+$P(XQADATA,"^",3),0))
  1. W !!,"RX# ",$P(XQADATA,"^")," for ",$P(Y,"^")," (",$E($P(Y,"^",9),6,10),") rejected because:"
  1. S XQADATA=$P(XQADATA,"^",2)
  1. F X=1:1 S ERR=$P(XQADATA,",",X) Q:ERR="" D
  1. .S TXT=$$ERRTXT(ERR)
  1. .I TXT]"" W !?3,TXT
  1. W !!,"Press ENTER key to continue..." R X:DTIME
  1. Q
  1. ;
  1. ;
  1. ERRTXT(IEN) ; Return Error Text.
  1. ; Input: IEN -- Pointer to the Error Text in file #351.51
  1. Q $P($G(^IBE(351.51,+$G(IEN),0)),"^",3)
  1. ;
  1. ERRIEN(MACH,CODE) ; Return Error File Entry Number.
  1. ; Input: MACH -- System on which the error occurred
  1. ; CODE -- Error Code
  1. N X S X=""
  1. I $G(MACH)="" G ERRIENQ
  1. I $G(CODE)="" G ERRIENQ
  1. S X=$O(^IBE(351.51,"AD",MACH,CODE,0))
  1. ERRIENQ Q X