IBAERR1 ;ALB/CPM - INTEGRATED BILLING ERROR PROCESSING ROUTINE (CON'T) ; 03-JAN-92
;;2.0;INTEGRATED BILLING;**15,133,153**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine will be used to send mail messages when errors
; have occurred during the processing of Means Test charges.
; Input: IBJOB = 1 Nightly Compilation job
; 2 Discharge job
; 4 Add/Edit/Cancel Charges
; 5 Appointment Event Driver
; 7 Means Test Event Driver
; 8 OPT Billing Update
; 9 IVM Back-Billing job
; DFN {opt}, IBDUZ, IBY, IBWHER
;
N IBSTART K IBT
I $D(DFN)#2 S IBPT=$$PT^IBEFUNC(DFN)
I '$G(IBJOB) S IBJOB=5 ; if MT charge entered thru Appt Event Driver uses filer so IBJOB not set,see EN2^IBAMTS2
S XMSUB=$S($D(IBPT)#2:$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" -",1:"MEANS TEST BILLING")_" ERROR ENCOUNTERED"
S IBT(1)="An error has been encountered while processing Means Test charges"
S IBT(2)="during the "_$P($T(JOB+IBJOB),";;",2,99)_" for the following patient:"
S IBT(3)=" ",IBC=3
D PAT
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="The Means Test billing history for this patient must be reviewed."
S IBC=IBC+1,IBT(IBC)="The following error was encountered:"
S IBC=IBC+1,IBT(IBC)=" "
S:IBJOB=4 IBSTART=IBC D ERR
S IBC=IBC+1,IBT(IBC)=" "
S IBM=$P($T(TEXT+IBWHER^IBAMTEL),";;",2,99),IBC=IBC+1
S:$L(IBM)<80 IBT(IBC)=IBM
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)
I IBJOB=4 F IBI=IBSTART:1:IBC W !,IBT(IBI)
D MAIL K IBT,IBM,IBB,IBC,IBPT,XMSUB,XMY,XMTEXT,XMDUZ
Q
;
PAT ; Set up patient demographic and user data for message.
S IBC=IBC+1,IBT(IBC)=" Patient: "_$S($D(IBPT)#2:$P(IBPT,"^")_" Pt. ID: "_$P(IBPT,"^",2),1:"Not Defined")
S IBC=IBC+1,IBT(IBC)=" User: "_$P($G(^VA(200,+IBDUZ,0)),"^")
Q
;
ERR ; Set up error message text.
S X2=$P(IBY,"^",2) F K=1:1 S X=$P(X2,";",K) Q:X="" D
. S X1=$O(^IBE(350.8,"AC",X,0)),IBC=IBC+1
. S IBT(IBC)=" "_$S($D(^IBE(350.8,+X1,0)):$P(^(0),"^",2),X]"":X,1:"Unknown Error")
I $P(IBY,"^",3)]"" S IBC=IBC+1,IBT(IBC)=" "_$P(IBY,"^",3)
K X,X1,X2 Q
;
MAIL ; Transmit.
N IBI,IBGRP S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
K XMY
;S IBGRP=$P($G(^IBE(350.9,1,0)),"^",11)
;F IBI=0:0 S IBI=$O(^XMB(3.8,+IBGRP,1,"B",IBI)) Q:'IBI S XMY(IBI)=""
S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),"^",11),0)),"^")
I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
D ^XMD
Q
;
JOB ; Job Descriptions
;;Nightly Compilation job
;;Discharge job
;;<Undefined job #3>
;;Cancel/Edit/Add Option
;;Check Out job
;;<Undefined job #6>
;;Means Testing
;;OPT Billing Update
;;IVM Back-Billing job
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAERR1 2875 printed Apr 09, 2024@21:29:30 Page 2
IBAERR1 ;ALB/CPM - INTEGRATED BILLING ERROR PROCESSING ROUTINE (CON'T) ; 03-JAN-92
+1 ;;2.0;INTEGRATED BILLING;**15,133,153**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine will be used to send mail messages when errors
+5 ; have occurred during the processing of Means Test charges.
+6 ; Input: IBJOB = 1 Nightly Compilation job
+7 ; 2 Discharge job
+8 ; 4 Add/Edit/Cancel Charges
+9 ; 5 Appointment Event Driver
+10 ; 7 Means Test Event Driver
+11 ; 8 OPT Billing Update
+12 ; 9 IVM Back-Billing job
+13 ; DFN {opt}, IBDUZ, IBY, IBWHER
+14 ;
+15 NEW IBSTART
KILL IBT
+16 IF $DATA(DFN)#2
SET IBPT=$$PT^IBEFUNC(DFN)
+17 ; if MT charge entered thru Appt Event Driver uses filer so IBJOB not set,see EN2^IBAMTS2
IF '$GET(IBJOB)
SET IBJOB=5
+18 SET XMSUB=$SELECT($DATA(IBPT)#2:$EXTRACT($PIECE(IBPT,"^"),1,14)_" "_$PIECE(IBPT,"^",3)_" -",1:"MEANS TEST BILLING")_" ERROR ENCOUNTERED"
+19 SET IBT(1)="An error has been encountered while processing Means Test charges"
+20 SET IBT(2)="during the "_$PIECE($TEXT(JOB+IBJOB),";;",2,99)_" for the following patient:"
+21 SET IBT(3)=" "
SET IBC=3
+22 DO PAT
+23 SET IBC=IBC+1
SET IBT(IBC)=" "
+24 SET IBC=IBC+1
SET IBT(IBC)="The Means Test billing history for this patient must be reviewed."
+25 SET IBC=IBC+1
SET IBT(IBC)="The following error was encountered:"
+26 SET IBC=IBC+1
SET IBT(IBC)=" "
+27 if IBJOB=4
SET IBSTART=IBC
DO ERR
+28 SET IBC=IBC+1
SET IBT(IBC)=" "
+29 SET IBM=$PIECE($TEXT(TEXT+IBWHER^IBAMTEL),";;",2,99)
SET IBC=IBC+1
+30 if $LENGTH(IBM)<80
SET IBT(IBC)=IBM
+31 IF $LENGTH(IBM)>79
SET IBB=$EXTRACT(IBM,1,79)
SET IBT(IBC)=$PIECE(IBB," ",1,$LENGTH(IBB," ")-1)
SET IBC=IBC+1
SET IBT(IBC)=$PIECE(IBM," ",$LENGTH(IBB," "),999)
+32 IF IBJOB=4
FOR IBI=IBSTART:1:IBC
WRITE !,IBT(IBI)
+33 DO MAIL
KILL IBT,IBM,IBB,IBC,IBPT,XMSUB,XMY,XMTEXT,XMDUZ
+34 QUIT
+35 ;
PAT ; Set up patient demographic and user data for message.
+1 SET IBC=IBC+1
SET IBT(IBC)=" Patient: "_$SELECT($DATA(IBPT)#2:$PIECE(IBPT,"^")_" Pt. ID: "_$PIECE(IBPT,"^",2),1:"Not Defined")
+2 SET IBC=IBC+1
SET IBT(IBC)=" User: "_$PIECE($GET(^VA(200,+IBDUZ,0)),"^")
+3 QUIT
+4 ;
ERR ; Set up error message text.
+1 SET X2=$PIECE(IBY,"^",2)
FOR K=1:1
SET X=$PIECE(X2,";",K)
if X=""
QUIT
Begin DoDot:1
+2 SET X1=$ORDER(^IBE(350.8,"AC",X,0))
SET IBC=IBC+1
+3 SET IBT(IBC)=" "_$SELECT($DATA(^IBE(350.8,+X1,0)):$PIECE(^(0),"^",2),X]"":X,1:"Unknown Error")
End DoDot:1
+4 IF $PIECE(IBY,"^",3)]""
SET IBC=IBC+1
SET IBT(IBC)=" "_$PIECE(IBY,"^",3)
+5 KILL X,X1,X2
QUIT
+6 ;
MAIL ; Transmit.
+1 NEW IBI,IBGRP
SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="IBT("
+2 KILL XMY
+3 ;S IBGRP=$P($G(^IBE(350.9,1,0)),"^",11)
+4 ;F IBI=0:0 S IBI=$O(^XMB(3.8,+IBGRP,1,"B",IBI)) Q:'IBI S XMY(IBI)=""
+5 SET IBGRP=$PIECE($GET(^XMB(3.8,+$PIECE($GET(^IBE(350.9,1,0)),"^",11),0)),"^")
+6 IF IBGRP]""
SET XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
+7 DO ^XMD
+8 QUIT
+9 ;
JOB ; Job Descriptions
+1 ;;Nightly Compilation job
+2 ;;Discharge job
+3 ;;<Undefined job #3>
+4 ;;Cancel/Edit/Add Option
+5 ;;Check Out job
+6 ;;<Undefined job #6>
+7 ;;Means Testing
+8 ;;OPT Billing Update
+9 ;;IVM Back-Billing job
