RCAEOB ;ALB/CMS - AEOB FILE 433 CROSS-REF ROUTINE ; 16-JUN-00
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
AEOB ;File 433 Cross-Ref on Transaction Type AEOB
; -used to alert pending EOB processing when Payment in Part
; transaction is created for referred TP bills
; -used to send MM to RC when Payment if Full is made
N PRCABN,PRCAEN,RCAT
I (X'=2)!($G(DA)<1) G AEOBQ
S PRCABN=+$P($G(^PRCA(433,DA,0)),U,2) I 'PRCABN G AEOBQ
D RCCAT^RCRCUTL(.RCAT)
I '$G(RCAT(+$P($G(^PRCA(430,PRCABN,0)),U,2))) G AEOBQ
I '$$REFST^RCRCUTL(PRCABN) G AEOBQ
S ^PRCA(433,"AEOB",PRCABN,DA)=""
AEOBQ Q
;
SND ;Send RC a mail message about Payment in Full
N PRCA,RCBDIV,RCWHO,RCXMB,X,XNDUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
N RCCOM,RCDOM,RCSITE,RCSUB
I $P($G(RCCAT(+$P(^PRCA(430,PRCABN,0),U,2))),U,1)'=1 Q
D BNVAR^RCRCUTL(PRCABN)
S Y=$G(^PRCA(433,PRCAEN,1))
S RCXMB(2,0)=$G(PRCA("BNAME"),"UNK")_U_PRCAEN_U_+$P(Y,U,1)_U_+$P(Y,U,5)
S RCSITE=$$SITE^RCMSITE
D RCDIV^RCRCDIV(.RCDIV)
I $G(RCDIV(0)) S RCBDIV=$$DIV^RCRCDIV(PRCABN)
S X=0 F X=$O(RCDIV(X)) Q:'X D
.I X=+RCBDIV S RCDOM=$P(RCDIV(X),"^",6)
.Q
I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
S XMDUZ=DUZ,(RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_" FULL PAYMENT"
S RCWHO=RCDOM,XMY(RCWHO)="",XMY(DUZ)=""
S RCXMB(1,0)="$$RC$$FP$"_RCSITE_"$S.RC RC SERV"
S RCXMB(3,0)="$$END$1$"
S XMTEXT="RCXMB(" D ^XMD
S RCCOM="Sent a Payment in Full Information to RC in MM# "_$G(XMZ)
I $G(XMZ) D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,RCCOM)
SNDQ Q
;RCAEOB
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCAEOB 1609 printed Dec 13, 2024@01:42:23 Page 2
RCAEOB ;ALB/CMS - AEOB FILE 433 CROSS-REF ROUTINE ; 16-JUN-00
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 QUIT
+3 ;
AEOB ;File 433 Cross-Ref on Transaction Type AEOB
+1 ; -used to alert pending EOB processing when Payment in Part
+2 ; transaction is created for referred TP bills
+3 ; -used to send MM to RC when Payment if Full is made
+4 NEW PRCABN,PRCAEN,RCAT
+5 IF (X'=2)!($GET(DA)<1)
GOTO AEOBQ
+6 SET PRCABN=+$PIECE($GET(^PRCA(433,DA,0)),U,2)
IF 'PRCABN
GOTO AEOBQ
+7 DO RCCAT^RCRCUTL(.RCAT)
+8 IF '$GET(RCAT(+$PIECE($GET(^PRCA(430,PRCABN,0)),U,2)))
GOTO AEOBQ
+9 IF '$$REFST^RCRCUTL(PRCABN)
GOTO AEOBQ
+10 SET ^PRCA(433,"AEOB",PRCABN,DA)=""
AEOBQ QUIT
+1 ;
SND ;Send RC a mail message about Payment in Full
+1 NEW PRCA,RCBDIV,RCWHO,RCXMB,X,XNDUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
+2 NEW RCCOM,RCDOM,RCSITE,RCSUB
+3 IF $PIECE($GET(RCCAT(+$PIECE(^PRCA(430,PRCABN,0),U,2))),U,1)'=1
QUIT
+4 DO BNVAR^RCRCUTL(PRCABN)
+5 SET Y=$GET(^PRCA(433,PRCAEN,1))
+6 SET RCXMB(2,0)=$GET(PRCA("BNAME"),"UNK")_U_PRCAEN_U_+$PIECE(Y,U,1)_U_+$PIECE(Y,U,5)
+7 SET RCSITE=$$SITE^RCMSITE
+8 DO RCDIV^RCRCDIV(.RCDIV)
+9 IF $GET(RCDIV(0))
SET RCBDIV=$$DIV^RCRCDIV(PRCABN)
+10 SET X=0
FOR X=$ORDER(RCDIV(X))
if 'X
QUIT
Begin DoDot:1
+11 IF X=+RCBDIV
SET RCDOM=$PIECE(RCDIV(X),"^",6)
+12 QUIT
End DoDot:1
+13 IF $GET(RCDOM)=""
SET RCDOM=$$RCDOM^RCRCUTL
+14 SET XMDUZ=DUZ
SET (RCSUB,XMSUB)="AR/RC - "_$GET(RCSITE,"UNK")_" FULL PAYMENT"
+15 SET RCWHO=RCDOM
SET XMY(RCWHO)=""
SET XMY(DUZ)=""
+16 SET RCXMB(1,0)="$$RC$$FP$"_RCSITE_"$S.RC RC SERV"
+17 SET RCXMB(3,0)="$$END$1$"
+18 SET XMTEXT="RCXMB("
DO ^XMD
+19 SET RCCOM="Sent a Payment in Full Information to RC in MM# "_$GET(XMZ)
+20 IF $GET(XMZ)
DO ENT^RCRCXMS(XMZ,RCSUB,RCWHO,RCCOM)
SNDQ QUIT
+1 ;RCAEOB
