IBACVA2 ;ALB/CPM - BULLETINS FOR CHAMPVA BILLING ; 29-JUL-93
;;2.0;INTEGRATED BILLING;**27,52,240**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
ERRMSG(IBIND,IBMSG) ; Process CHAMPVA/TRICARE Error Messages.
; Input: IBIND -- 1=>billing 0=>canceling
; IBMSG -- 1=>CHAMPVA msg 2=> TRICARE msg
K IBT S IBPT=$$PT^IBEFUNC(DFN)
S IBMSGT=$S($G(IBMSG)=1:"CHAMPVA inpatient subsistence",1:"TRICARE Pharmacy copayment")
S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - ERROR ENCOUNTERED"
S IBT(1)="An error occurred while "_$S($G(IBIND):"billing",1:"cancelling")_" the "_IBMSGT_" charge"
S IBT(2)=$S($G(IBIND):"to",1:"for")_" the following patient:"
S IBT(3)=" " S IBC=3
S IBDUZ=DUZ D PAT^IBAERR1
;S Y=+DGPMA D DD^%DT
;S IBC=IBC+1,IBT(IBC)="Disc Date: "_Y
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="The following error was encountered:"
S IBC=IBC+1,IBT(IBC)=" "
D ERR^IBAERR1
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="Please review the circumstances surrounding this error and use the"
S IBC=IBC+1,IBT(IBC)="Cancel/Edit/Add Patient Charges' option to bill or cancel any necessary"
S IBC=IBC+1,IBT(IBC)="charges."
D SEND
Q
;
ADM ; Send a bulletin when CHAMPVA patients are admitted.
K IBT S IBPT=$$PT^IBEFUNC(DFN)
S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - CHAMPVA PATIENT"
S IBT(1)="The following CHAMPVA patient has been admitted:"
S IBT(2)=" ",IBC=2
S IBDUZ=DUZ D PAT^IBAERR1
S Y=+DGPMA D DD^%DT
S IBC=IBC+1,IBT(IBC)=" Adm Date: "_Y
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="This patient will be automatically billed the CHAMPVA inpatient"
S IBC=IBC+1,IBT(IBC)="subsistence charge when discharged."
D SEND
Q
;
WARN(IBB,IBE) ; Send bulletins when discharges are edited or deleted.
; Input: IBB -- Discharge date before edit
; IBE -- Discharge date after edit
K IBT S IBPT=$$PT^IBEFUNC(DFN)
S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - DISCHARGE CHANGED"
S IBT(1)="A discharge was "_$S($G(IBE):"edited",1:"deleted")_" for the following CHAMPVA patient:"
S IBT(2)=" " S IBC=2
S IBDUZ=DUZ D PAT^IBAERR1
S IBC=IBC+1,IBT(IBC)=" "
I $G(IBE) D
.S Y=IBB D DD^%DT S IBC=IBC+1,IBT(IBC)="Prev Discharge Date: "_Y
.S Y=IBE D DD^%DT S IBC=IBC+1,IBT(IBC)=" New Discharge Date: "_Y
.S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="Please review the circumstances surrounding these movement changes,"
S IBC=IBC+1,IBT(IBC)="and use the 'Cancel/Edit/Add Patient Charges' option to bill or cancel"
S IBC=IBC+1,IBT(IBC)="any necessary charges."
D SEND
Q
;
DEL(DFN,IBN,IBADM) ; Send bulletins when billed admissions are deleted.
; Input: DFN -- Pointer to the patient in file #2
; IBN -- Pointer to the cancelled charge in file #350
; IBADM -- Admission date/time
K IBT S IBPT=$$PT^IBEFUNC(DFN)
S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - ADMISSION DELETED"
S IBT(1)="A billed admission for the following CHAMPVA patient was deleted:"
S IBT(2)=" " S IBC=2
S IBDUZ=DUZ D PAT^IBAERR1
S IBC=IBC+1,IBT(IBC)=" "
S Y=+IBADM D DD^%DT
S IBC=IBC+1,IBT(IBC)=" Adm Date: "_Y
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="The inpatient subsistence charge for this admission has been cancelled"
S IBC=IBC+1,IBT(IBC)="in Billing only. You MUST decrease the receivable "_$P($G(^IB(IBN,0)),"^",11)_" down to $0"
S IBC=IBC+1,IBT(IBC)="in the Accounts Receivable module!!"
D SEND
Q
;
SEND ; Send bulletin to recipients of the Means Test billing mailgroup.
D MAIL^IBAERR1
K IBC,IBT,IBPT,XMSUB,XMY,XMTEXT,XMDUZ,IBMSGT
Q
;
ON() ; Is the CHAMPVA billing module fully installed?
N X S X=+$O(^IBE(350.1,"E","CHAMPVA SUBSISTENCE",0))
Q +$P($G(^IBE(350.1,X,0)),"^",3)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACVA2 3832 printed Dec 13, 2024@02:05:55 Page 2
IBACVA2 ;ALB/CPM - BULLETINS FOR CHAMPVA BILLING ; 29-JUL-93
+1 ;;2.0;INTEGRATED BILLING;**27,52,240**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
ERRMSG(IBIND,IBMSG) ; Process CHAMPVA/TRICARE Error Messages.
+1 ; Input: IBIND -- 1=>billing 0=>canceling
+2 ; IBMSG -- 1=>CHAMPVA msg 2=> TRICARE msg
+3 KILL IBT
SET IBPT=$$PT^IBEFUNC(DFN)
+4 SET IBMSGT=$SELECT($GET(IBMSG)=1:"CHAMPVA inpatient subsistence",1:"TRICARE Pharmacy copayment")
+5 SET XMSUB=$EXTRACT($PIECE(IBPT,"^"),1,14)_" "_$PIECE(IBPT,"^",3)_" - ERROR ENCOUNTERED"
+6 SET IBT(1)="An error occurred while "_$SELECT($GET(IBIND):"billing",1:"cancelling")_" the "_IBMSGT_" charge"
+7 SET IBT(2)=$SELECT($GET(IBIND):"to",1:"for")_" the following patient:"
+8 SET IBT(3)=" "
SET IBC=3
+9 SET IBDUZ=DUZ
DO PAT^IBAERR1
+10 ;S Y=+DGPMA D DD^%DT
+11 ;S IBC=IBC+1,IBT(IBC)="Disc Date: "_Y
+12 SET IBC=IBC+1
SET IBT(IBC)=" "
+13 SET IBC=IBC+1
SET IBT(IBC)="The following error was encountered:"
+14 SET IBC=IBC+1
SET IBT(IBC)=" "
+15 DO ERR^IBAERR1
+16 SET IBC=IBC+1
SET IBT(IBC)=" "
+17 SET IBC=IBC+1
SET IBT(IBC)="Please review the circumstances surrounding this error and use the"
+18 SET IBC=IBC+1
SET IBT(IBC)="Cancel/Edit/Add Patient Charges' option to bill or cancel any necessary"
+19 SET IBC=IBC+1
SET IBT(IBC)="charges."
+20 DO SEND
+21 QUIT
+22 ;
ADM ; Send a bulletin when CHAMPVA patients are admitted.
+1 KILL IBT
SET IBPT=$$PT^IBEFUNC(DFN)
+2 SET XMSUB=$EXTRACT($PIECE(IBPT,"^"),1,14)_" "_$PIECE(IBPT,"^",3)_" - CHAMPVA PATIENT"
+3 SET IBT(1)="The following CHAMPVA patient has been admitted:"
+4 SET IBT(2)=" "
SET IBC=2
+5 SET IBDUZ=DUZ
DO PAT^IBAERR1
+6 SET Y=+DGPMA
DO DD^%DT
+7 SET IBC=IBC+1
SET IBT(IBC)=" Adm Date: "_Y
+8 SET IBC=IBC+1
SET IBT(IBC)=" "
+9 SET IBC=IBC+1
SET IBT(IBC)="This patient will be automatically billed the CHAMPVA inpatient"
+10 SET IBC=IBC+1
SET IBT(IBC)="subsistence charge when discharged."
+11 DO SEND
+12 QUIT
+13 ;
WARN(IBB,IBE) ; Send bulletins when discharges are edited or deleted.
+1 ; Input: IBB -- Discharge date before edit
+2 ; IBE -- Discharge date after edit
+3 KILL IBT
SET IBPT=$$PT^IBEFUNC(DFN)
+4 SET XMSUB=$EXTRACT($PIECE(IBPT,"^"),1,14)_" "_$PIECE(IBPT,"^",3)_" - DISCHARGE CHANGED"
+5 SET IBT(1)="A discharge was "_$SELECT($GET(IBE):"edited",1:"deleted")_" for the following CHAMPVA patient:"
+6 SET IBT(2)=" "
SET IBC=2
+7 SET IBDUZ=DUZ
DO PAT^IBAERR1
+8 SET IBC=IBC+1
SET IBT(IBC)=" "
+9 IF $GET(IBE)
Begin DoDot:1
+10 SET Y=IBB
DO DD^%DT
SET IBC=IBC+1
SET IBT(IBC)="Prev Discharge Date: "_Y
+11 SET Y=IBE
DO DD^%DT
SET IBC=IBC+1
SET IBT(IBC)=" New Discharge Date: "_Y
+12 SET IBC=IBC+1
SET IBT(IBC)=" "
End DoDot:1
+13 SET IBC=IBC+1
SET IBT(IBC)="Please review the circumstances surrounding these movement changes,"
+14 SET IBC=IBC+1
SET IBT(IBC)="and use the 'Cancel/Edit/Add Patient Charges' option to bill or cancel"
+15 SET IBC=IBC+1
SET IBT(IBC)="any necessary charges."
+16 DO SEND
+17 QUIT
+18 ;
DEL(DFN,IBN,IBADM) ; Send bulletins when billed admissions are deleted.
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; IBN -- Pointer to the cancelled charge in file #350
+3 ; IBADM -- Admission date/time
+4 KILL IBT
SET IBPT=$$PT^IBEFUNC(DFN)
+5 SET XMSUB=$EXTRACT($PIECE(IBPT,"^"),1,14)_" "_$PIECE(IBPT,"^",3)_" - ADMISSION DELETED"
+6 SET IBT(1)="A billed admission for the following CHAMPVA patient was deleted:"
+7 SET IBT(2)=" "
SET IBC=2
+8 SET IBDUZ=DUZ
DO PAT^IBAERR1
+9 SET IBC=IBC+1
SET IBT(IBC)=" "
+10 SET Y=+IBADM
DO DD^%DT
+11 SET IBC=IBC+1
SET IBT(IBC)=" Adm Date: "_Y
+12 SET IBC=IBC+1
SET IBT(IBC)=" "
+13 SET IBC=IBC+1
SET IBT(IBC)="The inpatient subsistence charge for this admission has been cancelled"
+14 SET IBC=IBC+1
SET IBT(IBC)="in Billing only. You MUST decrease the receivable "_$PIECE($GET(^IB(IBN,0)),"^",11)_" down to $0"
+15 SET IBC=IBC+1
SET IBT(IBC)="in the Accounts Receivable module!!"
+16 DO SEND
+17 QUIT
+18 ;
SEND ; Send bulletin to recipients of the Means Test billing mailgroup.
+1 DO MAIL^IBAERR1
+2 KILL IBC,IBT,IBPT,XMSUB,XMY,XMTEXT,XMDUZ,IBMSGT
+3 QUIT
+4 ;
ON() ; Is the CHAMPVA billing module fully installed?
+1 NEW X
SET X=+$ORDER(^IBE(350.1,"E","CHAMPVA SUBSISTENCE",0))
+2 QUIT +$PIECE($GET(^IBE(350.1,X,0)),"^",3)
