RCRCAT ;ALB/CMS - AR/RC AR TRANSACTION TRANSMISSION ;16-JUN-00
V ;;4.5;Accounts Receivable;**63,127,159**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
EN ;Entry from Protocol to Transmit AR Transaction(s) to RC
N LN,PRCABN,RCA,RCCAT,RCCNT,RCCOM,RCDATA,RCDOM,RCMSG,RCOUT,RCSITE,RCXCNT,RCY,X,Y S RCCNT=0,LN=4
D FULL^VALM1
I '$O(^TMP("RCRCAL",$J,"SEL",0)) W !!,"NOTHING TO REFER!",!,"No selected items from list." G ENQ
;D RCCAT^RCRCUTL(.RCCAT)
W !! S DIR("A",1)="Referring transactions for bill(s) on highlighted Selection List "
S DIR("A")="Okay to Continue ",DIR("?")="Enter Yes to Continue"
D ASK^RCRCACP I $G(Y)'=1 G ENQ
K ^TMP("RCRCAT",$J,"XM") S RCXCNT=0
S RCY=0 F S RCY=$O(^TMP("RCRCAL",$J,"SEL",RCY)) Q:('RCY)!($G(RCOUT)) D
.S PRCABN=$P($G(^TMP("RCRCALX",$J,RCY)),U,2)
.S PRCABN0=$G(^PRCA(430,+PRCABN,0)) Q:'PRCABN0
.;I $P($G(RCCAT(+$P(PRCABN0,U,2))),U,1)'=1 Q
.D EN^RCRCAT1
.Q
I $G(RCOUT) G ENQ
; - If nothing to send go write message on screen
I '$O(^TMP("RCRCAT",$J,"XM",0)) W !,"Nothing to transmit!" G ENQ
;
; - create E-Mail and send off
D SEND
;
ENQ K DIR D PAUSE^VALM1 S VALMBCK="R"
Q
;
SEND ;Send bills in mail message
N II,LN,LNCNT,PRCABN,RCDATA,RCI,RCSUB,RCWHO,RETRY,TRCNT
N XNDUZ,XMSUB,XMTEXT,XMY,XMZ,X,Y
S RETRY=0,RCCOM=""
S RCSITE=$$SITE^RCMSITE
I '$D(RCDOM)&($O(RCDIV(0))) S RCDOM=$P($G(RCDIV(+$P($G(RCDIV(0)),U,3))),U,6)
I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
N PRCABN
SNDA ;Come back here if didn't go to mail man
S (XMDUN,XMDUZ)=$S(+$G(DUZ):DUZ,1:.5)
S (RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_" AR "_$S($G(RCTYP)="CL":"COMMENT LOG",$G(RCTYP)="TR":"TRANSACTION HISTORY",1:"REQUEST FOR ACTION")
D XMZ^XMA2 I $G(XMZ)<1 S RETRY=RETRY+1 I RETRY<100 G SNDA
I $G(XMZ)<1 G SENDQ
S RCWHO=RCDOM
S XMY(RCWHO)="",TRCNT=0
S ^XMB(3.9,XMZ,2,0)="^3.92^1^1^"_DT
S ^XMB(3.9,XMZ,2,1,0)="$$RC$"_$G(RCTYP,"TR")_"$$"_RCSITE_"$S.RC RC SERV"
S PRCABN=0,LN=1 F S PRCABN=$O(^TMP("RCRCAT",$J,"XM",PRCABN)) Q:'PRCABN D
.S II=0 F S II=$O(^TMP("RCRCAT",$J,"XM",PRCABN,II)) Q:'II D
..S RCI=0,TRCNT=TRCNT+1 F S RCI=$O(^TMP("RCRCAT",$J,"XM",PRCABN,II,RCI)) Q:'RCI D
...S RCDATA=$G(^TMP("RCRCAT",$J,"XM",PRCABN,II,RCI))
...I RCDATA="" Q
...S LN=LN+1,^XMB(3.9,XMZ,2,LN,0)=RCDATA
;
S LNCNT=LN-1
S LN=LN+1,^XMB(3.9,XMZ,2,LN,0)="$END$"_TRCNT_"$"_LNCNT
S $P(^XMB(3.9,XMZ,2,0),U,3,4)=LN_U_LN
;
D ENT1^XMD
I $E($G(IOST),1,2)="C-" W !!,"Message #",XMZ," Transmitted ",$G(TRCNT,0)," Transaction(s)."
S RCCOM="Message contains AR Transactions."
D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,.RCCOM)
SENDQ Q
;
DISP ;Display Bill and Transactions Select Items
;Input: PRCABN
N DIR,CNT,RCY,PRCA,PRCAEN,X,Y S RCOUT=0
I '$D(^PRCA(430,PRCABN,0)) G DISPQ
D BNVAR^RCRCUTL(PRCABN)
D DEBT^RCRCUTL(PRCABN)
D HD
S (PRCAEN,CNT)=0 F S PRCAEN=$O(^PRCA(433,"C",PRCABN,PRCAEN)) Q:'PRCAEN D
.S CNT=CNT+1
.S RCEN1=$G(^PRCA(433,PRCAEN,1)),RCTY=+$P(RCEN1,U,2)
.S RCTY=$P($G(^PRCA(430.3,RCTY,0)),U,1)
.I RCTY="COMMENT" S RCTY=$P($G(^PRCA(433,PRCAEN,5)),U,2)
.S Y=+RCEN1 D D^DIQ S RCDT=Y
.S DIR("L",CNT)=CNT_" "_PRCAEN_" "_RCTY_" "_RCDT_" "_+$P(RCEN1,U,5)
.S ^TMP("RCRCAL",$J,"XM",PRCA("DEBTNM"),0)=PRCA("DEBTNM")
.S ^TMP("RCRCAL",$J,"XM",PRCA("DEBTNM"),PRCA("BNAME"),PRCAEN,0)=PRCA("BNAME")_" Transaction # "_PRCAEN_" Transaction Date "_DT
DISPQ Q
;
HD ;Write Heading
W @IOF,!,PRCA("DEBTNM"),!,PRCA("DEBTAD1")
W:$G(PRCA("DEBTAD2"))]"" !,PRCA("DEBTAD2")
W !,PRCA("DEBTCT"),", ",PRCA("DEBTST")," ",PRCA("DEBTZIP")
W !,"PHONE #: ",$P(PRCA("DEBTADD"),U,7)
W !!," BILL #: ",PRCA("BNAME")
W !!,"Item",?8,"TR #",?20,"Tran. Type",?45,"Date",?55,"Amount"
W ! F I=1:1:(IOM-1) W "="
HDQ Q
;
PF(RCT) ;Input: PRCAEN, PRCABN Called from PRCAPAY1 and INC^RCRCRT
;Send RC a mail message about Payment in Full or Increase
N PRCA,RCWHO,RCXMB,X,XNDUZ,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
N RCBDIV,RCCAT,RCCOM,RCD,RCDOM,RCDIV,RCSITE,RCSUB,RC1 S XMCHAN=""
D RCCAT^RCRCUTL(.RCCAT)
I $P($G(RCCAT(+$P(^PRCA(430,+PRCABN,0),U,2))),U,1)'=1 G PFQ
I '$$REFST^RCRCUTL(PRCABN),(RCT="I") G PFQ
I RCT="P" S X=$P($G(^PRCA(430,PRCABN,6)),U,4,6) I 'X G PFQ
D BNVAR^RCRCUTL(+PRCABN)
D RCDIV^RCRCDIV(.RCDIV)
I $O(RCDIV(0)) S RCBDIV=$$DIV^IBJDF2(PRCABN) S X=0 F S X=$O(RCDIV(X)) Q:'X D
.;I $P(RCDIV(X),U,3)=+RCBDIV S RCDOM=$P(RCDIV(X),U,2)
.I X=+RCBDIV S RCDOM=$P(RCDIV(X),U,6)
S RCSITE=$$SITE^RCMSITE
I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
S XMDUZ=DUZ,(RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_$S(RCT="I":" INCREASE TO CURRENT BALANCE",1:" FULL PAYMENT FOR BILL")
S RCWHO=RCDOM,XMY(RCWHO)=""
S RCXMB(1,0)="$$RC$"_$S(RCT="I":"IN",1:"FP")_"$$"_RCSITE_"$S.RC RC SERV"
S RC1=$G(^PRCA(433,+PRCAEN,1))
S RCXMB(2,0)=$G(PRCA("BNAME"),"UNK")_U_PRCAEN_U_+$P(RC1,U,1)_U_+$P(RC1,U,5)
S RCXMB(3,0)="$END$1$"
S XMTEXT="RCXMB(" D ^XMD
S RCCOM="Sent "_$S(RCT="I":"Increase Adjustment",1:"Payment in Full")_" information to RC in MM# "_$G(XMZ)
I RCT="I" W !!,RCCOM
I $G(XMZ) D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,RCCOM)
PFQ Q
;RCRCAT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCAT 5098 printed Sep 23, 2025@19:23:40 Page 2
RCRCAT ;ALB/CMS - AR/RC AR TRANSACTION TRANSMISSION ;16-JUN-00
V ;;4.5;Accounts Receivable;**63,127,159**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 QUIT
EN ;Entry from Protocol to Transmit AR Transaction(s) to RC
+1 NEW LN,PRCABN,RCA,RCCAT,RCCNT,RCCOM,RCDATA,RCDOM,RCMSG,RCOUT,RCSITE,RCXCNT,RCY,X,Y
SET RCCNT=0
SET LN=4
+2 DO FULL^VALM1
+3 IF '$ORDER(^TMP("RCRCAL",$JOB,"SEL",0))
WRITE !!,"NOTHING TO REFER!",!,"No selected items from list."
GOTO ENQ
+4 ;D RCCAT^RCRCUTL(.RCCAT)
+5 WRITE !!
SET DIR("A",1)="Referring transactions for bill(s) on highlighted Selection List "
+6 SET DIR("A")="Okay to Continue "
SET DIR("?")="Enter Yes to Continue"
+7 DO ASK^RCRCACP
IF $GET(Y)'=1
GOTO ENQ
+8 KILL ^TMP("RCRCAT",$JOB,"XM")
SET RCXCNT=0
+9 SET RCY=0
FOR
SET RCY=$ORDER(^TMP("RCRCAL",$JOB,"SEL",RCY))
if ('RCY)!($GET(RCOUT))
QUIT
Begin DoDot:1
+10 SET PRCABN=$PIECE($GET(^TMP("RCRCALX",$JOB,RCY)),U,2)
+11 SET PRCABN0=$GET(^PRCA(430,+PRCABN,0))
if 'PRCABN0
QUIT
+12 ;I $P($G(RCCAT(+$P(PRCABN0,U,2))),U,1)'=1 Q
+13 DO EN^RCRCAT1
+14 QUIT
End DoDot:1
+15 IF $GET(RCOUT)
GOTO ENQ
+16 ; - If nothing to send go write message on screen
+17 IF '$ORDER(^TMP("RCRCAT",$JOB,"XM",0))
WRITE !,"Nothing to transmit!"
GOTO ENQ
+18 ;
+19 ; - create E-Mail and send off
+20 DO SEND
+21 ;
ENQ KILL DIR
DO PAUSE^VALM1
SET VALMBCK="R"
+1 QUIT
+2 ;
SEND ;Send bills in mail message
+1 NEW II,LN,LNCNT,PRCABN,RCDATA,RCI,RCSUB,RCWHO,RETRY,TRCNT
+2 NEW XNDUZ,XMSUB,XMTEXT,XMY,XMZ,X,Y
+3 SET RETRY=0
SET RCCOM=""
+4 SET RCSITE=$$SITE^RCMSITE
+5 IF '$DATA(RCDOM)&($ORDER(RCDIV(0)))
SET RCDOM=$PIECE($GET(RCDIV(+$PIECE($GET(RCDIV(0)),U,3))),U,6)
+6 IF $GET(RCDOM)=""
SET RCDOM=$$RCDOM^RCRCUTL
+7 NEW PRCABN
SNDA ;Come back here if didn't go to mail man
+1 SET (XMDUN,XMDUZ)=$SELECT(+$GET(DUZ):DUZ,1:.5)
+2 SET (RCSUB,XMSUB)="AR/RC - "_$GET(RCSITE,"UNK")_" AR "_$SELECT($GET(RCTYP)="CL":"COMMENT LOG",$GET(RCTYP)="TR":"TRANSACTION HISTORY",1:"REQUEST FOR ACTION")
+3 DO XMZ^XMA2
IF $GET(XMZ)<1
SET RETRY=RETRY+1
IF RETRY<100
GOTO SNDA
+4 IF $GET(XMZ)<1
GOTO SENDQ
+5 SET RCWHO=RCDOM
+6 SET XMY(RCWHO)=""
SET TRCNT=0
+7 SET ^XMB(3.9,XMZ,2,0)="^3.92^1^1^"_DT
+8 SET ^XMB(3.9,XMZ,2,1,0)="$$RC$"_$GET(RCTYP,"TR")_"$$"_RCSITE_"$S.RC RC SERV"
+9 SET PRCABN=0
SET LN=1
FOR
SET PRCABN=$ORDER(^TMP("RCRCAT",$JOB,"XM",PRCABN))
if 'PRCABN
QUIT
Begin DoDot:1
+10 SET II=0
FOR
SET II=$ORDER(^TMP("RCRCAT",$JOB,"XM",PRCABN,II))
if 'II
QUIT
Begin DoDot:2
+11 SET RCI=0
SET TRCNT=TRCNT+1
FOR
SET RCI=$ORDER(^TMP("RCRCAT",$JOB,"XM",PRCABN,II,RCI))
if 'RCI
QUIT
Begin DoDot:3
+12 SET RCDATA=$GET(^TMP("RCRCAT",$JOB,"XM",PRCABN,II,RCI))
+13 IF RCDATA=""
QUIT
+14 SET LN=LN+1
SET ^XMB(3.9,XMZ,2,LN,0)=RCDATA
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 SET LNCNT=LN-1
+17 SET LN=LN+1
SET ^XMB(3.9,XMZ,2,LN,0)="$END$"_TRCNT_"$"_LNCNT
+18 SET $PIECE(^XMB(3.9,XMZ,2,0),U,3,4)=LN_U_LN
+19 ;
+20 DO ENT1^XMD
+21 IF $EXTRACT($GET(IOST),1,2)="C-"
WRITE !!,"Message #",XMZ," Transmitted ",$GET(TRCNT,0)," Transaction(s)."
+22 SET RCCOM="Message contains AR Transactions."
+23 DO ENT^RCRCXMS(XMZ,RCSUB,RCWHO,.RCCOM)
SENDQ QUIT
+1 ;
DISP ;Display Bill and Transactions Select Items
+1 ;Input: PRCABN
+2 NEW DIR,CNT,RCY,PRCA,PRCAEN,X,Y
SET RCOUT=0
+3 IF '$DATA(^PRCA(430,PRCABN,0))
GOTO DISPQ
+4 DO BNVAR^RCRCUTL(PRCABN)
+5 DO DEBT^RCRCUTL(PRCABN)
+6 DO HD
+7 SET (PRCAEN,CNT)=0
FOR
SET PRCAEN=$ORDER(^PRCA(433,"C",PRCABN,PRCAEN))
if 'PRCAEN
QUIT
Begin DoDot:1
+8 SET CNT=CNT+1
+9 SET RCEN1=$GET(^PRCA(433,PRCAEN,1))
SET RCTY=+$PIECE(RCEN1,U,2)
+10 SET RCTY=$PIECE($GET(^PRCA(430.3,RCTY,0)),U,1)
+11 IF RCTY="COMMENT"
SET RCTY=$PIECE($GET(^PRCA(433,PRCAEN,5)),U,2)
+12 SET Y=+RCEN1
DO D^DIQ
SET RCDT=Y
+13 SET DIR("L",CNT)=CNT_" "_PRCAEN_" "_RCTY_" "_RCDT_" "_+$PIECE(RCEN1,U,5)
+14 SET ^TMP("RCRCAL",$JOB,"XM",PRCA("DEBTNM"),0)=PRCA("DEBTNM")
+15 SET ^TMP("RCRCAL",$JOB,"XM",PRCA("DEBTNM"),PRCA("BNAME"),PRCAEN,0)=PRCA("BNAME")_" Transaction # "_PRCAEN_" Transaction Date "_DT
End DoDot:1
DISPQ QUIT
+1 ;
HD ;Write Heading
+1 WRITE @IOF,!,PRCA("DEBTNM"),!,PRCA("DEBTAD1")
+2 if $GET(PRCA("DEBTAD2"))]""
WRITE !,PRCA("DEBTAD2")
+3 WRITE !,PRCA("DEBTCT"),", ",PRCA("DEBTST")," ",PRCA("DEBTZIP")
+4 WRITE !,"PHONE #: ",$PIECE(PRCA("DEBTADD"),U,7)
+5 WRITE !!," BILL #: ",PRCA("BNAME")
+6 WRITE !!,"Item",?8,"TR #",?20,"Tran. Type",?45,"Date",?55,"Amount"
+7 WRITE !
FOR I=1:1:(IOM-1)
WRITE "="
HDQ QUIT
+1 ;
PF(RCT) ;Input: PRCAEN, PRCABN Called from PRCAPAY1 and INC^RCRCRT
+1 ;Send RC a mail message about Payment in Full or Increase
+2 NEW PRCA,RCWHO,RCXMB,X,XNDUZ,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
+3 NEW RCBDIV,RCCAT,RCCOM,RCD,RCDOM,RCDIV,RCSITE,RCSUB,RC1
SET XMCHAN=""
+4 DO RCCAT^RCRCUTL(.RCCAT)
+5 IF $PIECE($GET(RCCAT(+$PIECE(^PRCA(430,+PRCABN,0),U,2))),U,1)'=1
GOTO PFQ
+6 IF '$$REFST^RCRCUTL(PRCABN)
IF (RCT="I")
GOTO PFQ
+7 IF RCT="P"
SET X=$PIECE($GET(^PRCA(430,PRCABN,6)),U,4,6)
IF 'X
GOTO PFQ
+8 DO BNVAR^RCRCUTL(+PRCABN)
+9 DO RCDIV^RCRCDIV(.RCDIV)
+10 IF $ORDER(RCDIV(0))
SET RCBDIV=$$DIV^IBJDF2(PRCABN)
SET X=0
FOR
SET X=$ORDER(RCDIV(X))
if 'X
QUIT
Begin DoDot:1
+11 ;I $P(RCDIV(X),U,3)=+RCBDIV S RCDOM=$P(RCDIV(X),U,2)
+12 IF X=+RCBDIV
SET RCDOM=$PIECE(RCDIV(X),U,6)
End DoDot:1
+13 SET RCSITE=$$SITE^RCMSITE
+14 IF $GET(RCDOM)=""
SET RCDOM=$$RCDOM^RCRCUTL
+15 SET XMDUZ=DUZ
SET (RCSUB,XMSUB)="AR/RC - "_$GET(RCSITE,"UNK")_$SELECT(RCT="I":" INCREASE TO CURRENT BALANCE",1:" FULL PAYMENT FOR BILL")
+16 SET RCWHO=RCDOM
SET XMY(RCWHO)=""
+17 SET RCXMB(1,0)="$$RC$"_$SELECT(RCT="I":"IN",1:"FP")_"$$"_RCSITE_"$S.RC RC SERV"
+18 SET RC1=$GET(^PRCA(433,+PRCAEN,1))
+19 SET RCXMB(2,0)=$GET(PRCA("BNAME"),"UNK")_U_PRCAEN_U_+$PIECE(RC1,U,1)_U_+$PIECE(RC1,U,5)
+20 SET RCXMB(3,0)="$END$1$"
+21 SET XMTEXT="RCXMB("
DO ^XMD
+22 SET RCCOM="Sent "_$SELECT(RCT="I":"Increase Adjustment",1:"Payment in Full")_" information to RC in MM# "_$GET(XMZ)
+23 IF RCT="I"
WRITE !!,RCCOM
+24 IF $GET(XMZ)
DO ENT^RCRCXMS(XMZ,RCSUB,RCWHO,RCCOM)
PFQ QUIT
+1 ;RCRCAT
