RCDPLPL3 ;WISC/RFJ - link payments listmanager options (link payment) ;1 Jun 00
;;4.5;Accounts Receivable;**153,304,301,321,332**;Mar 20, 1995;Build 40
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
LINKPAY ; link a payment to an account
N DA,DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCEEOB,X,Y ; PRCA*4.5*321 - added RCEEOB
;
D FULL^VALM1
S VALMBCK="R"
;
W !!,"This option will allow the account to be entered for an unapplied"
W !,"payment transaction selected from the above list. If the selected"
W !,"receipt has been previously processed, the selected account in the"
W !,"accounts receivable package will be updated with the payment.",!
N INDEX,RCDPFLAG,RCERROR,RCGECSCR,RCPAY,RCRECTDA,RCSTATUS,RCTRANDA,RCDCHKSW,HRCDCKSW,RCDPTYPE
S INDEX=$$SELPAY^RCDPLPL1 I 'INDEX Q
S RCPAY=$G(^TMP("RCDPLPLM",$J,"IDX",INDEX,INDEX))
S RCRECTDA=+$P(RCPAY,"^"),RCTRANDA=+$P(RCPAY,"^",2)
;
I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
S RCDPTYPE=$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",19)
;
; check to see if the cr document has been sent for the receipt
S RCGECSCR=$P($G(^RCY(344,RCRECTDA,2)),"^")
; code sheet already sent once, this is a retransmission, check it
I RCGECSCR'="" D
. S RCSTATUS=$$STATUS^GECSSGET(RCGECSCR)
. W !!,"This receipt has been processed to FMS with cash receipt document"
. W !,$TR(RCGECSCR," "),". The current status for this document in the"
. W !,"Generic Code Sheet Stack file is ",RCSTATUS,"."
. ;
. ; okay to continue if status is Error, Rejected, or not defined (-1)
. I $E(RCSTATUS)="E"!($E(RCSTATUS)="R")!(RCSTATUS=-1) Q
. ; okay to continue if status is Accepted
. I $E(RCSTATUS)="A" Q
. ; okay to continue if document is transmitted for 2 days
. I $E(RCSTATUS)="T",$$FMDIFF^XLFDT(DT,$P(^RCY(344,RCRECTDA,0),"^",8))>1 Q
. ;
. W !!,"You cannot link the payment to an account until the FMS cash receipt"
. W !,"document is either Accepted or Rejected by FMS."
. W !," 1. If the FMS cash receipt is Accepted by FMS, you will need to"
. W !," remove the payment from the station's suspense account online"
. W !," in FMS."
. W !," 2. If the FMS cash receipt document is rejected by FMS, you can"
. W !," use the option Process Receipt under the Receipt Processing"
. W !," listmanager screen to regenerate the document. The payment"
. W !," has not been deposited in the station's suspense account by"
. W !," FMS since the cash receipt document rejected.",!
. S VALMSG="Try linking this payment again tomorrow."
. D WRITE^RCDPRPLU(VALMSG)
. S RCDPFLAG=1
I $G(RCDPFLAG) D QUIT Q
;
; show payment transaction
W !!,"The current payment transaction:",?40,"RECEIPT: ",$P(^RCY(344,RCRECTDA,0),"^")
W !,"--------------------------------"
D SHOWPAY(RCRECTDA,RCTRANDA)
;
; transaction has account entered
I $P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3) D Q
. S VALMSG="An account has been assigned to this payment."
. D QUIT
;
; transaction is cancelled, cannot edit
I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D Q
. S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
. D WRITE^RCDPRPLU(VALMSG)
. D QUIT
;
;PRCA*4.5*304
; Will this link payment link to multiple bills
; Note: some of the code and logic below is also in tag PROCESS^RCDPLPL4.
; If changes in logic are made below, please review this tag as well.
;
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Will this transaction be linked to multiple claims (Y/N)"
D ^DIR
I $G(DTOUT)!($G(DUOUT)) D QUIT Q
I +Y D MULTIPLE^RCDPLPL4(RCRECTDA,RCTRANDA,RCGECSCR,$G(RCSTATUS)) D QUIT Q
;end PRCA*4.5*304
;
W !!,"Editing Payment: ",RCTRANDA
DBTRBIL S RCDCHKSW=1,HRCDCKSW=0 D EDITACCT^RCDPURET(RCRECTDA,RCTRANDA) I RCDCHKSW=0 G DBTRBIL ;prca*4.5*301
W !
; account not entered
I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3) D Q
. S VALMSG="Account was not linked."
. D WRITE^RCDPRPLU(VALMSG)
. D QUIT
;
; show payment transaction
W !,"The NEW payment transaction:",?40,"RECEIPT: ",$P(^RCY(344,RCRECTDA,0),"^")
W !,"-----------------------------"
D SHOWPAY(RCRECTDA,RCTRANDA)
;
I $$ASKACCT()'=1 D Q
. D DELEACCT^RCDPURET(RCRECTDA,RCTRANDA)
. S VALMSG="Account was deleted and not linked."
. D WRITE^RCDPRPLU(VALMSG)
. D QUIT
;
; Option to restore suspense EEOB - PRCA*4.5*321
S RCEEOB=$$EEOB^RCDPEM5(RCRECTDA,RCTRANDA)
Q:RCEEOB<0
;
; receipt has been processed since the cash receipt document
; has been generated. update the new account with payment
W !
I RCGECSCR'="" D I RCERROR Q
. W !,"Updating the Linked Account with the payment ..."
. S RCERROR=$$PROCESS^RCBEPAY(RCRECTDA,RCTRANDA)
. ; an error occurred during processing a payment
. I RCERROR D Q
. . W !
. . W !,"+------------------------------------------------------------------------------+"
. . W !,"| An ERROR has occurred when processing payment ",RCTRANDA," on receipt ",$P(^RCY(344,RCRECTDA,0),"^"),".",?79,"|"
. . W !,"| The error message returned during processing is:",?79,"|"
. . W !,"|",?79,"|"
. . W !,"| ",$P(RCERROR,"^",2),?79,"|"
. . W !,"|",?79,"|"
. . W !,"| You will need to correct the error before you can link the payment.",?79,"|"
. . W !,"+------------------------------------------------------------------------------+"
. . W !
. . D DELEACCT^RCDPURET(RCRECTDA,RCTRANDA)
. . S VALMSG="Account was deleted and not linked."
. . D WRITE^RCDPRPLU(VALMSG)
. . D QUIT
. ;
. ; payment processed correctly
. W " done."
. W !
. ;
. ;PRCA*4.5*304
. D REMCMT^RCDPLPL4(RCRECTDA,RCTRANDA) ; Remove the suspense comment. No longer needed.
. ;
. ;File entry in Audit Log
. D AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"P")
. ;
. ; Update Suspense Status
. D SUSPDIS^RCBEPAY(RCRECTDA,RCTRANDA,"PD")
. ;end PRCA*4.5*304
. ;
. ; Update EEOB claim number and restore to active status - PRCA*4.5*321
. D:RCEEOB RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"L")
. ;
. ; PRCA*4.5*332 - If all money was split off the original EEOB remove it.
. D CHKEOB^RCDPEU2(RCRECTDA,RCTRANDA)
. ;
. I $E($G(RCSTATUS))="A" D
. . W !,"Since the FMS cash receipt document is Accepted in FMS, you need to go"
. . W !,"online in FMS and transfer the amount paid out of the station's suspense"
. . W !,"account.",!
. . ; send mail message to the RCDP PAYMENTS mail group
. . W !,"Sending mail message to RCDP PAYMENTS mail group."
. . D MAILMSG^RCDPLPSR(RCRECTDA,RCTRANDA)
. . ; place an x in the fms doc field so it will show on the
. . ; suspense report
. . D EDITFMS^RCDPURET(RCRECTDA,RCTRANDA,"x")
. I $E($G(RCSTATUS))'="A" D
. . W !,"Since the FMS cash receipt document is NOT Accepted in FMS, you can use"
. . W !,"the option Process Receipt located under the Receipt Processing Menu"
. . W !,"to regenerate the cash receipt document to FMS.",!
. S VALMSG="Payment linked and removed from list."
. D WRITE^RCDPRPLU(VALMSG)
;
; receipt has not been processed
I RCGECSCR="" D
. S VALMSG="Since the receipt has not been processed, accounts will not be updated."
. D WRITE^RCDPRPLU(VALMSG)
. S VALMSG="Payment linked and removed from list."
. ; Update EEOB claim number and restore to active status - PRCA*4.5*321
. D:RCEEOB RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"L")
;
QUIT ; call here to unlock and rebuild list
L -^RCY(344,RCRECTDA)
D INIT^RCDPLPLM
Q
;
;
SHOWPAY(RCRECTDA,RCTRANDA) ; show the payment transaction
N A,D0,DA,DIC,DIQ,DK,DL,DX,S,Y
S DIC="^RCY(344,"_RCRECTDA_",1,",DA(1)=RCRECTDA,DA=RCTRANDA,DIQ(0)="C"
D EN^DIQ
Q
;
;
ASKACCT() ; ask if its the correct account
; 1 is yes, otherwise no
N DIR,DIQ2,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Is this the correct ACCOUNT to apply the payment to"
D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPLPL3 8225 printed Sep 23, 2025@19:22:12 Page 2
RCDPLPL3 ;WISC/RFJ - link payments listmanager options (link payment) ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153,304,301,321,332**;Mar 20, 1995;Build 40
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
LINKPAY ; link a payment to an account
+1 ; PRCA*4.5*321 - added RCEEOB
NEW DA,DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCEEOB,X,Y
+2 ;
+3 DO FULL^VALM1
+4 SET VALMBCK="R"
+5 ;
+6 WRITE !!,"This option will allow the account to be entered for an unapplied"
+7 WRITE !,"payment transaction selected from the above list. If the selected"
+8 WRITE !,"receipt has been previously processed, the selected account in the"
+9 WRITE !,"accounts receivable package will be updated with the payment.",!
+10 NEW INDEX,RCDPFLAG,RCERROR,RCGECSCR,RCPAY,RCRECTDA,RCSTATUS,RCTRANDA,RCDCHKSW,HRCDCKSW,RCDPTYPE
+11 SET INDEX=$$SELPAY^RCDPLPL1
IF 'INDEX
QUIT
+12 SET RCPAY=$GET(^TMP("RCDPLPLM",$JOB,"IDX",INDEX,INDEX))
+13 SET RCRECTDA=+$PIECE(RCPAY,"^")
SET RCTRANDA=+$PIECE(RCPAY,"^",2)
+14 ;
+15 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
QUIT
+16 SET RCDPTYPE=$PIECE(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",19)
+17 ;
+18 ; check to see if the cr document has been sent for the receipt
+19 SET RCGECSCR=$PIECE($GET(^RCY(344,RCRECTDA,2)),"^")
+20 ; code sheet already sent once, this is a retransmission, check it
+21 IF RCGECSCR'=""
Begin DoDot:1
+22 SET RCSTATUS=$$STATUS^GECSSGET(RCGECSCR)
+23 WRITE !!,"This receipt has been processed to FMS with cash receipt document"
+24 WRITE !,$TRANSLATE(RCGECSCR," "),". The current status for this document in the"
+25 WRITE !,"Generic Code Sheet Stack file is ",RCSTATUS,"."
+26 ;
+27 ; okay to continue if status is Error, Rejected, or not defined (-1)
+28 IF $EXTRACT(RCSTATUS)="E"!($EXTRACT(RCSTATUS)="R")!(RCSTATUS=-1)
QUIT
+29 ; okay to continue if status is Accepted
+30 IF $EXTRACT(RCSTATUS)="A"
QUIT
+31 ; okay to continue if document is transmitted for 2 days
+32 IF $EXTRACT(RCSTATUS)="T"
IF $$FMDIFF^XLFDT(DT,$PIECE(^RCY(344,RCRECTDA,0),"^",8))>1
QUIT
+33 ;
+34 WRITE !!,"You cannot link the payment to an account until the FMS cash receipt"
+35 WRITE !,"document is either Accepted or Rejected by FMS."
+36 WRITE !," 1. If the FMS cash receipt is Accepted by FMS, you will need to"
+37 WRITE !," remove the payment from the station's suspense account online"
+38 WRITE !," in FMS."
+39 WRITE !," 2. If the FMS cash receipt document is rejected by FMS, you can"
+40 WRITE !," use the option Process Receipt under the Receipt Processing"
+41 WRITE !," listmanager screen to regenerate the document. The payment"
+42 WRITE !," has not been deposited in the station's suspense account by"
+43 WRITE !," FMS since the cash receipt document rejected.",!
+44 SET VALMSG="Try linking this payment again tomorrow."
+45 DO WRITE^RCDPRPLU(VALMSG)
+46 SET RCDPFLAG=1
End DoDot:1
+47 IF $GET(RCDPFLAG)
DO QUIT
QUIT
+48 ;
+49 ; show payment transaction
+50 WRITE !!,"The current payment transaction:",?40,"RECEIPT: ",$PIECE(^RCY(344,RCRECTDA,0),"^")
+51 WRITE !,"--------------------------------"
+52 DO SHOWPAY(RCRECTDA,RCTRANDA)
+53 ;
+54 ; transaction has account entered
+55 IF $PIECE(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3)
Begin DoDot:1
+56 SET VALMSG="An account has been assigned to this payment."
+57 DO QUIT
End DoDot:1
QUIT
+58 ;
+59 ; transaction is cancelled, cannot edit
+60 IF '$PIECE(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4)
IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'=""
Begin DoDot:1
+61 SET VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
+62 DO WRITE^RCDPRPLU(VALMSG)
+63 DO QUIT
End DoDot:1
QUIT
+64 ;
+65 ;PRCA*4.5*304
+66 ; Will this link payment link to multiple bills
+67 ; Note: some of the code and logic below is also in tag PROCESS^RCDPLPL4.
+68 ; If changes in logic are made below, please review this tag as well.
+69 ;
+70 SET DIR(0)="YO"
SET DIR("B")="NO"
+71 SET DIR("A")=" Will this transaction be linked to multiple claims (Y/N)"
+72 DO ^DIR
+73 IF $GET(DTOUT)!($GET(DUOUT))
DO QUIT
QUIT
+74 IF +Y
DO MULTIPLE^RCDPLPL4(RCRECTDA,RCTRANDA,RCGECSCR,$GET(RCSTATUS))
DO QUIT
QUIT
+75 ;end PRCA*4.5*304
+76 ;
+77 WRITE !!,"Editing Payment: ",RCTRANDA
DBTRBIL ;prca*4.5*301
SET RCDCHKSW=1
SET HRCDCKSW=0
DO EDITACCT^RCDPURET(RCRECTDA,RCTRANDA)
IF RCDCHKSW=0
GOTO DBTRBIL
+1 WRITE !
+2 ; account not entered
+3 IF '$PIECE(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3)
Begin DoDot:1
+4 SET VALMSG="Account was not linked."
+5 DO WRITE^RCDPRPLU(VALMSG)
+6 DO QUIT
End DoDot:1
QUIT
+7 ;
+8 ; show payment transaction
+9 WRITE !,"The NEW payment transaction:",?40,"RECEIPT: ",$PIECE(^RCY(344,RCRECTDA,0),"^")
+10 WRITE !,"-----------------------------"
+11 DO SHOWPAY(RCRECTDA,RCTRANDA)
+12 ;
+13 IF $$ASKACCT()'=1
Begin DoDot:1
+14 DO DELEACCT^RCDPURET(RCRECTDA,RCTRANDA)
+15 SET VALMSG="Account was deleted and not linked."
+16 DO WRITE^RCDPRPLU(VALMSG)
+17 DO QUIT
End DoDot:1
QUIT
+18 ;
+19 ; Option to restore suspense EEOB - PRCA*4.5*321
+20 SET RCEEOB=$$EEOB^RCDPEM5(RCRECTDA,RCTRANDA)
+21 if RCEEOB<0
QUIT
+22 ;
+23 ; receipt has been processed since the cash receipt document
+24 ; has been generated. update the new account with payment
+25 WRITE !
+26 IF RCGECSCR'=""
Begin DoDot:1
+27 WRITE !,"Updating the Linked Account with the payment ..."
+28 SET RCERROR=$$PROCESS^RCBEPAY(RCRECTDA,RCTRANDA)
+29 ; an error occurred during processing a payment
+30 IF RCERROR
Begin DoDot:2
+31 WRITE !
+32 WRITE !,"+------------------------------------------------------------------------------+"
+33 WRITE !,"| An ERROR has occurred when processing payment ",RCTRANDA," on receipt ",$PIECE(^RCY(344,RCRECTDA,0),"^"),".",?79,"|"
+34 WRITE !,"| The error message returned during processing is:",?79,"|"
+35 WRITE !,"|",?79,"|"
+36 WRITE !,"| ",$PIECE(RCERROR,"^",2),?79,"|"
+37 WRITE !,"|",?79,"|"
+38 WRITE !,"| You will need to correct the error before you can link the payment.",?79,"|"
+39 WRITE !,"+------------------------------------------------------------------------------+"
+40 WRITE !
+41 DO DELEACCT^RCDPURET(RCRECTDA,RCTRANDA)
+42 SET VALMSG="Account was deleted and not linked."
+43 DO WRITE^RCDPRPLU(VALMSG)
+44 DO QUIT
End DoDot:2
QUIT
+45 ;
+46 ; payment processed correctly
+47 WRITE " done."
+48 WRITE !
+49 ;
+50 ;PRCA*4.5*304
+51 ; Remove the suspense comment. No longer needed.
DO REMCMT^RCDPLPL4(RCRECTDA,RCTRANDA)
+52 ;
+53 ;File entry in Audit Log
+54 DO AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"P")
+55 ;
+56 ; Update Suspense Status
+57 DO SUSPDIS^RCBEPAY(RCRECTDA,RCTRANDA,"PD")
+58 ;end PRCA*4.5*304
+59 ;
+60 ; Update EEOB claim number and restore to active status - PRCA*4.5*321
+61 if RCEEOB
DO RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"L")
+62 ;
+63 ; PRCA*4.5*332 - If all money was split off the original EEOB remove it.
+64 DO CHKEOB^RCDPEU2(RCRECTDA,RCTRANDA)
+65 ;
+66 IF $EXTRACT($GET(RCSTATUS))="A"
Begin DoDot:2
+67 WRITE !,"Since the FMS cash receipt document is Accepted in FMS, you need to go"
+68 WRITE !,"online in FMS and transfer the amount paid out of the station's suspense"
+69 WRITE !,"account.",!
+70 ; send mail message to the RCDP PAYMENTS mail group
+71 WRITE !,"Sending mail message to RCDP PAYMENTS mail group."
+72 DO MAILMSG^RCDPLPSR(RCRECTDA,RCTRANDA)
+73 ; place an x in the fms doc field so it will show on the
+74 ; suspense report
+75 DO EDITFMS^RCDPURET(RCRECTDA,RCTRANDA,"x")
End DoDot:2
+76 IF $EXTRACT($GET(RCSTATUS))'="A"
Begin DoDot:2
+77 WRITE !,"Since the FMS cash receipt document is NOT Accepted in FMS, you can use"
+78 WRITE !,"the option Process Receipt located under the Receipt Processing Menu"
+79 WRITE !,"to regenerate the cash receipt document to FMS.",!
End DoDot:2
+80 SET VALMSG="Payment linked and removed from list."
+81 DO WRITE^RCDPRPLU(VALMSG)
End DoDot:1
IF RCERROR
QUIT
+82 ;
+83 ; receipt has not been processed
+84 IF RCGECSCR=""
Begin DoDot:1
+85 SET VALMSG="Since the receipt has not been processed, accounts will not be updated."
+86 DO WRITE^RCDPRPLU(VALMSG)
+87 SET VALMSG="Payment linked and removed from list."
+88 ; Update EEOB claim number and restore to active status - PRCA*4.5*321
+89 if RCEEOB
DO RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"L")
End DoDot:1
+90 ;
QUIT ; call here to unlock and rebuild list
+1 LOCK -^RCY(344,RCRECTDA)
+2 DO INIT^RCDPLPLM
+3 QUIT
+4 ;
+5 ;
SHOWPAY(RCRECTDA,RCTRANDA) ; show the payment transaction
+1 NEW A,D0,DA,DIC,DIQ,DK,DL,DX,S,Y
+2 SET DIC="^RCY(344,"_RCRECTDA_",1,"
SET DA(1)=RCRECTDA
SET DA=RCTRANDA
SET DIQ(0)="C"
+3 DO EN^DIQ
+4 QUIT
+5 ;
+6 ;
ASKACCT() ; ask if its the correct account
+1 ; 1 is yes, otherwise no
+2 NEW DIR,DIQ2,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="YO"
SET DIR("B")="NO"
+4 SET DIR("A")=" Is this the correct ACCOUNT to apply the payment to"
+5 DO ^DIR
+6 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+7 QUIT Y
