- IBECUS22 ;RLM/DVAMC - TRICARE PHARMACY BILLING UTILITIES ; 14-AUG-96
- ;;2.0;INTEGRATED BILLING;**52,89,240,274**;21-MAR-94
- ;
- ERROR ; File errors.
- ; Input: IBERR [opt] -- DHCP Error Code
- ; IBDRX("RX#") -- Prescription Number
- ; IBRESP(1) [opt] -- First record transmitted by the FI
- ; IBKEY -- 1 ; 2, where
- ; 1 = Pointer to the rx in file #52
- ; 2 = Pointer to the refill in file #52.1,
- ; or 0 for the original fill
- ; IBKEYD -- 1 ^ 2 ^ 3 ^ 4, where
- ; 1 = Rx label printing device
- ; 2 = Pointer to the Pharmacy in file #59
- ; 3 = Pointer to the Pharmacy user in
- ; file #200
- ; 4 = Pointer to the billing transaction
- ; in file #351.5 (cancellations only)
- ;
- I '$G(IBERR) S IBERC=$E(IBRESP(1),1,3)
- I $G(IBERR) K ^IBA(351.5,"APOST",IBKEY) S IBERC=IBERR
- S IBMACH=$S($D(IBERR):"DHCP",1:"MLINK")
- K IBERR,IBTXT
- ;
- ; - expand the code if necessary
- I $D(IBRESP(1)),$E(IBRESP(1),1,3)=" " S IBERC="001"
- I IBERC?1.N S IBERC=+IBERC F Q:$L(IBERC)>1 S IBERC="0"_IBERC
- S IBERRP=$$ERRIEN(IBMACH,IBERC)
- ;
- ; - send bulletin to the Reject Notice group
- S IBTXT(1)=IBMACH_" has detected error #"_IBERC_" while processing RX# "_$S($G(IBDRX("RX#"))]"":IBDRX("RX#"),1:"Unknown")
- S IBTXT(2)="Error text: "_$$ERRTXT(IBERRP)
- S XMDUN="TRICARE PHARMACY BILLING",XMDUZ=.5,XMSUB="Tricare/IPS Billing Error"
- S XMTEXT="IBTXT(",XMY("G.IB CHAMP RX REJ")="",XMY(+$P(IBKEYD,"^",3))=""
- N DIQUIET S DIQUIET=1 D DT^DICRW,^XMD
- ;
- ; - file the rejected transaction
- S IBCHREJ=$O(^IBA(351.52,"B",IBKEY,0))
- I 'IBCHREJ D ADDREJ^IBECUS21
- I IBCHREJ S $P(^IBA(351.52,IBCHREJ,0),"^",3)=DT,^(1)=IBERRP
- K IBERC,IBERRP,IBTXT,IBMACH,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- Q
- ;
- ;
- DUP ; Act on duplicates.
- S XQA("G.IB CHAMP RX REJ")=""
- S XQAMSG="Prescription #"_$S($G(IBDRX("RX#"))]"":IBDRX("RX#"),1:"Unknown")_" is a duplicate submission."
- D SETUP^XQALERT
- K ^IBA(351.5,"APOST",IBKEY)
- Q
- ;
- ;
- DISP ; Display Universal errors on alerts.
- N ERR,TXT,X,Y
- S Y=$G(^DPT(+$P(XQADATA,"^",3),0))
- W !!,"RX# ",$P(XQADATA,"^")," for ",$P(Y,"^")," (",$E($P(Y,"^",9),6,10),") rejected because:"
- S XQADATA=$P(XQADATA,"^",2)
- F X=1:1 S ERR=$P(XQADATA,",",X) Q:ERR="" D
- .S TXT=$$ERRTXT(ERR)
- .I TXT]"" W !?3,TXT
- W !!,"Press ENTER key to continue..." R X:DTIME
- Q
- ;
- ;
- ERRTXT(IEN) ; Return Error Text.
- ; Input: IEN -- Pointer to the Error Text in file #351.51
- Q $P($G(^IBE(351.51,+$G(IEN),0)),"^",3)
- ;
- ERRIEN(MACH,CODE) ; Return Error File Entry Number.
- ; Input: MACH -- System on which the error occurred
- ; CODE -- Error Code
- N X S X=""
- I $G(MACH)="" G ERRIENQ
- I $G(CODE)="" G ERRIENQ
- S X=$O(^IBE(351.51,"AD",MACH,CODE,0))
- ERRIENQ Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECUS22 3025 printed Mar 13, 2025@21:26:47 Page 2
- IBECUS22 ;RLM/DVAMC - TRICARE PHARMACY BILLING UTILITIES ; 14-AUG-96
- +1 ;;2.0;INTEGRATED BILLING;**52,89,240,274**;21-MAR-94
- +2 ;
- ERROR ; File errors.
- +1 ; Input: IBERR [opt] -- DHCP Error Code
- +2 ; IBDRX("RX#") -- Prescription Number
- +3 ; IBRESP(1) [opt] -- First record transmitted by the FI
- +4 ; IBKEY -- 1 ; 2, where
- +5 ; 1 = Pointer to the rx in file #52
- +6 ; 2 = Pointer to the refill in file #52.1,
- +7 ; or 0 for the original fill
- +8 ; IBKEYD -- 1 ^ 2 ^ 3 ^ 4, where
- +9 ; 1 = Rx label printing device
- +10 ; 2 = Pointer to the Pharmacy in file #59
- +11 ; 3 = Pointer to the Pharmacy user in
- +12 ; file #200
- +13 ; 4 = Pointer to the billing transaction
- +14 ; in file #351.5 (cancellations only)
- +15 ;
- +16 IF '$GET(IBERR)
- SET IBERC=$EXTRACT(IBRESP(1),1,3)
- +17 IF $GET(IBERR)
- KILL ^IBA(351.5,"APOST",IBKEY)
- SET IBERC=IBERR
- +18 SET IBMACH=$SELECT($DATA(IBERR):"DHCP",1:"MLINK")
- +19 KILL IBERR,IBTXT
- +20 ;
- +21 ; - expand the code if necessary
- +22 IF $DATA(IBRESP(1))
- IF $EXTRACT(IBRESP(1),1,3)=" "
- SET IBERC="001"
- +23 IF IBERC?1.N
- SET IBERC=+IBERC
- FOR
- if $LENGTH(IBERC)>1
- QUIT
- SET IBERC="0"_IBERC
- +24 SET IBERRP=$$ERRIEN(IBMACH,IBERC)
- +25 ;
- +26 ; - send bulletin to the Reject Notice group
- +27 SET IBTXT(1)=IBMACH_" has detected error #"_IBERC_" while processing RX# "_$SELECT($GET(IBDRX("RX#"))]"":IBDRX("RX#"),1:"Unknown")
- +28 SET IBTXT(2)="Error text: "_$$ERRTXT(IBERRP)
- +29 SET XMDUN="TRICARE PHARMACY BILLING"
- SET XMDUZ=.5
- SET XMSUB="Tricare/IPS Billing Error"
- +30 SET XMTEXT="IBTXT("
- SET XMY("G.IB CHAMP RX REJ")=""
- SET XMY(+$PIECE(IBKEYD,"^",3))=""
- +31 NEW DIQUIET
- SET DIQUIET=1
- DO DT^DICRW
- DO ^XMD
- +32 ;
- +33 ; - file the rejected transaction
- +34 SET IBCHREJ=$ORDER(^IBA(351.52,"B",IBKEY,0))
- +35 IF 'IBCHREJ
- DO ADDREJ^IBECUS21
- +36 IF IBCHREJ
- SET $PIECE(^IBA(351.52,IBCHREJ,0),"^",3)=DT
- SET ^(1)=IBERRP
- +37 KILL IBERC,IBERRP,IBTXT,IBMACH,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- +38 QUIT
- +39 ;
- +40 ;
- DUP ; Act on duplicates.
- +1 SET XQA("G.IB CHAMP RX REJ")=""
- +2 SET XQAMSG="Prescription #"_$SELECT($GET(IBDRX("RX#"))]"":IBDRX("RX#"),1:"Unknown")_" is a duplicate submission."
- +3 DO SETUP^XQALERT
- +4 KILL ^IBA(351.5,"APOST",IBKEY)
- +5 QUIT
- +6 ;
- +7 ;
- DISP ; Display Universal errors on alerts.
- +1 NEW ERR,TXT,X,Y
- +2 SET Y=$GET(^DPT(+$PIECE(XQADATA,"^",3),0))
- +3 WRITE !!,"RX# ",$PIECE(XQADATA,"^")," for ",$PIECE(Y,"^")," (",$EXTRACT($PIECE(Y,"^",9),6,10),") rejected because:"
- +4 SET XQADATA=$PIECE(XQADATA,"^",2)
- +5 FOR X=1:1
- SET ERR=$PIECE(XQADATA,",",X)
- if ERR=""
- QUIT
- Begin DoDot:1
- +6 SET TXT=$$ERRTXT(ERR)
- +7 IF TXT]""
- WRITE !?3,TXT
- End DoDot:1
- +8 WRITE !!,"Press ENTER key to continue..."
- READ X:DTIME
- +9 QUIT
- +10 ;
- +11 ;
- ERRTXT(IEN) ; Return Error Text.
- +1 ; Input: IEN -- Pointer to the Error Text in file #351.51
- +2 QUIT $PIECE($GET(^IBE(351.51,+$GET(IEN),0)),"^",3)
- +3 ;
- ERRIEN(MACH,CODE) ; Return Error File Entry Number.
- +1 ; Input: MACH -- System on which the error occurred
- +2 ; CODE -- Error Code
- +3 NEW X
- SET X=""
- +4 IF $GET(MACH)=""
- GOTO ERRIENQ
- +5 IF $GET(CODE)=""
- GOTO ERRIENQ
- +6 SET X=$ORDER(^IBE(351.51,"AD",MACH,CODE,0))
- ERRIENQ QUIT X
