Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPLPL4

RCDPLPL4.m

Go to the documentation of this file. 
  1. RCDPLPL4 ;ALB/SAB - Multiple Bill Link Payments ;17 Mar 16
  1.  ;;4.5;Accounts Receivable;**304,301,321,326,332**;Mar 20, 1995;Build 40
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. MULTIPLE(RCRECTDA,RCTRANDA,RCGECSCR,RCSTATUS) ; Process multiple bills for the same receipt transaction.
  1.  ;
  1.  N RCAMT,RCCT,RCAMTRM,RCEXIT,RCMSG,RCNWTRAN,RCTACCT,RCTAMT,RCTDATA,RCACT,RCARRAY,RCEXT,RCRSP,RCSPRSS
  1.  N RCDACNO,I,RCNM,RCBLIEN,RCDACNOI,RCUNAPN,RCQTSP,RCANS,RCDACT,RCDATA,RCPIEN,RCTACCTT
  1.  N RCTAMT,RCTCMT,RCTDNM,RCUNRCN,RCDCHKSW,HRCDCKSW
  1.  ;
  1.  S (RCSPRSS,RCEXIT,RCCT)=0
  1.  S RCTDATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
  1.  I RCTDATA="" D  Q
  1.  .  S RCMSG="The initial receipt transaction data is missing.  Unable to link a claim to this transaction."
  1.  .  D WRITE^RCDPRPLU(RCMSG)
  1.  ;
  1.  ; Retrieve payment amount on the transaction
  1.  S (RCAMT,RCAMTRM)=+$P(RCTDATA,U,4)
  1.  ;
  1.  I RCAMT=0 D  Q
  1.  .  S RCMSG="The transaction balance is 0.  Unable to link a claim to this transaction."
  1.  .  D WRITE^RCDPRPLU(RCMSG)
  1.  ;
  1.  ;Retrieve list of Bills to link to payment
  1.  F  D  Q:RCAMTRM=0  Q:RCEXIT
  1.  . ;
  1.  . ;Re-init the suspense quit flag
  1.  . S RCQTSP=0
  1.  . ;
  1.  . ;Ask the user for the account
  1.  . S RCDCHKSW=1,HRCDCKSW=0,RCACCT=$$GETACCT(RCRECTDA) I RCDCHKSW=0 W ! Q    ;prca*4.5*301
  1.  . I RCACCT=-1 D  Q
  1.  . . S RCRSP=$$CONQUIT()
  1.  . . S:RCRSP=1 RCEXIT=1
  1.  . ;
  1.  . I RCACCT=0 D  Q
  1.  . . W !,?6,"Invalid Bill Number, Please try again...."
  1.  . S:RCACCT="SUSPENSE" RCACCT=""     ;Payment needs to remain in suspense.
  1.  . ;
  1.  . ;Ask the user for the amount
  1.  . S RCAMT=$$GETAMT(RCACCT,RCAMTRM)
  1.  . Q:RCAMT=-1
  1.  . ;
  1.  . ;Ask the user for Comment if no account is entered.
  1.  . S RCCMT=""
  1.  . I RCACCT="" S RCCMT=$$GETCMT()
  1.  . ;timed out or ^ - exit.
  1.  . I (RCCMT=-1)!(RCCMT="^") Q
  1.  . ;
  1.  . ;Update the array and amount remaining.
  1.  . S RCCT=RCCT+1
  1.  . S RCARRAY(RCCT)=RCACCT_U_RCAMT_U_RCCMT_U_$$GETACTNM(RCACCT)
  1.  . S RCAMTRM=RCAMTRM-RCAMT
  1.  . ;
  1.  . ;Check to see if user wishes to continue
  1.  . I RCAMTRM>0 D
  1.  . . ;
  1.  . . ;ask if user wishes to continue
  1.  . . S RCRSP=$$CONTINUE(RCAMTRM)
  1.  . . ;
  1.  . . ;User wishes to continue
  1.  . . Q:RCRSP=1
  1.  . . ;
  1.  . . ;if no, ask if user is sure and that all selected payments will not be linked.
  1.  . . S RCRSP=$$CONQUIT()
  1.  . . I RCRSP=1 S RCEXIT=1
  1.  ;
  1.  ; If the user is exiting before completion, quit.
  1.  Q:RCEXIT
  1.  ;
  1.  ;State all money is disbursed and display all accounts for confirmation
  1.  W !!,"*** RECEIPT HAS BEEN FULLY DISBURSED ***",!
  1.  ;
  1.  ; Ask if user wishes to review the list again
  1.  S RCANS=$$GETANS(1)
  1.  ;
  1.  ;Spacing line
  1.  W !
  1.  ;
  1.  ; Review the list if necessary
  1.  I RCANS=1 D
  1.  . S I=0
  1.  . W !,?5,"PATIENT NAME",?36,"ACCOUNT",?50,"PAYMENT TO APPLY",!
  1.  . F I=1:1:RCCT D
  1.  . . S (RCNM,RCDACNO,RCDACNOI)=""
  1.  . . S RCDATA=$G(RCARRAY(I))
  1.  . . S RCDACT=$P(RCDATA,U)
  1.  . . S:RCDACT="" RCNM="SUSPENSE"
  1.  . . I RCDACT[";DPT" D
  1.  . . . S RCNM=$P($G(^DPT($P(RCDACT,";"),0)),U)
  1.  . . . S RCDACNO=""
  1.  . . I RCDACT[";PRCA" D
  1.  . . . S RCDACNOI=$P(RCDACT,";")
  1.  . . . S RCDACNO=$P($G(^PRCA(430,$P(RCDACNOI,U),0)),U)
  1.  . . . S RCPIEN=$P($G(^DGCR(399,RCDACNOI,0)),U,2)
  1.  . . . I RCPIEN="" S RCNM="PATIENT NAME NOT FOUND" Q
  1.  . . . S RCNM=$P($G(^DPT(RCPIEN,0)),U)
  1.  . . . I RCNM="" S RCNM="PATIENT NAME NOT FOUND"
  1.  . . W ?5,RCNM,?36,RCDACNO,?50,"$",$J($FN($P(RCDATA,U,2),",",2),15),!
  1.  ;
  1.  ; Ask the user if they wish to update.  Quit if they time out, "^" out, or say No to updating.
  1.  S RCANS=$$GETANS(2)
  1.  Q:RCANS'=1
  1.  ;
  1.  ;Initialize error flag
  1.  S RCERROR=0
  1.  ;
  1.  ;Surpress PNORBILL^RCDPURED output
  1.  S RCSPRSS=1
  1.  ;
  1.  ;create line spacing
  1.  W !!
  1.  ;
  1.  ;Link the payments
  1.  F RCACT=1:1:RCCT D  Q:RCERROR
  1.  . ;
  1.  . ;Extract data to update
  1.  . S RCTAMT=$P(RCARRAY(RCACT),U,2)   ;Payment Amount
  1.  . S RCTACCT=$P(RCARRAY(RCACT),U,1)    ;Account to link to.
  1.  . S RCTCMT=$P(RCARRAY(RCACT),U,3)
  1.  . S RCTDNM=$P(RCARRAY(RCACT),U,4)
  1.  . S RCTACCTT=$S(RCTACCT="":"the Suspense Item",1:RCTACCT)
  1.  . ;
  1.  . ;If not the first transaction, create a new one
  1.  . I RCACT'=1 D  Q
  1.  . . ;
  1.  . . ; Create new transaction
  1.  . . S RCNWTRAN=$$COPYTRAN(RCRECTDA,RCTDATA,RCTAMT,RCGECSCR)
  1.  . . ;
  1.  . . ; Link the Payment using the display name
  1.  . . D LINKPAY(RCRECTDA,RCNWTRAN,RCTDNM)
  1.  . . ;
  1.  . . ; build unapplied deposit number
  1.  . . S RCUNRCN=$P($G(^RCY(344,RCRECTDA,0)),U)
  1.  . . S RCUNAPN=$S($L(RCUNRCN)>9:$E(RCUNRCN,$L(RCUNRCN-9),$L(RCUNRCN)),1:RCUNRCN)
  1.  . . S RCUNAPN=RCUNAPN_$E("0000",1,4-$L(RCNWTRAN))_RCNWTRAN
  1.  . . D SETUNAPP^RCDPURET(RCRECTDA,RCNWTRAN,RCUNAPN) ; add new unapplied deposit #
  1.  . . ;
  1.  . . ; If creating a new suspense item, update the comment field and audit logs
  1.  . . I RCTCMT'="" D
  1.  . . . ;
  1.  . . . D UPDCMT(RCRECTDA,RCNWTRAN,RCTCMT)  ; add comment
  1.  . . . I $G(RCGECSCR)'="" D
  1.  . . . . D AUDIT^RCBEPAY(RCRECTDA,RCNWTRAN,"I")
  1.  . . . . D SUSPDIS^RCBEPAY(RCRECTDA,RCNWTRAN,"P")
  1.  . . . W !,"***** PAYMENT AMOUNT LEFT IN SUSPENSE = $",$J(RCTAMT,"",2)," ... done."
  1.  . . ;
  1.  . . ; If linking an account, process the linking
  1.  . . I RCTCMT="" D
  1.  . . . ;
  1.  . . . ; If the receipt has been processed, process the payment
  1.  . . . I $G(RCGECSCR)'="" D  Q
  1.  . . . . W !,RCTDNM," - Updating the Linked Account with PMT = $",$J(RCTAMT,"",2)," ... done."
  1.  . . . . D REMCMT(RCRECTDA,RCNWTRAN)   ; Remove the supense comment.  No longer needed.
  1.  . . . . D PROCESS(RCRECTDA,RCNWTRAN,RCTDNM)
  1.  . . . ;
  1.  . . . ; The receipt has not been processed
  1.  . . . W !,RCTDNM," - Receipt has not been processed.  Account linked but not"
  1.  . . . W !,?6,"updated for the PMT = $",$J(RCTAMT,"",2)
  1.  . ;
  1.  . ;If this is the first transaction, adjust the payment amount to be the amount not split out.
  1.  . I RCACT=1 D
  1.  . . ;
  1.  . . ; Modify the original payment amount
  1.  . . D ADJTRAMT(RCRECTDA,RCTRANDA,RCTAMT,RCGECSCR,.RCARRAY) ; Added RCARRAY - PRCA*4.5*326
  1.  . . ;
  1.  . . ; Adjusting the amount in suspense, update the comment field and audit logs
  1.  . . I RCTCMT'="" D  Q
  1.  . . . D UPDCMT(RCRECTDA,RCTRANDA,RCTCMT)  ; add comment
  1.  . . . I $G(RCGECSCR)'="" D
  1.  . . . . D AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"I")
  1.  . . . . D SUSPDIS^RCBEPAY(RCRECTDA,RCTRANDA,"P")
  1.  . . . W !,"***** PAYMENT AMOUNT LEFT IN SUSPENSE = $",$J(RCTAMT,"",2)," ... done."
  1.  . . ;
  1.  . . ; Link the Payment, send account if PRCA, Patient name in Patient
  1.  . . D LINKPAY(RCRECTDA,RCTRANDA,RCTDNM)
  1.  . . ;
  1.  . . ;Remove the comment, item is no longer in suspense
  1.  . . D REMCMT(RCRECTDA,RCTRANDA)
  1.  . . ;
  1.  . . ; If the receipt has been processed, process the payment
  1.  . . I $G(RCGECSCR)'="" D  Q
  1.  . . . W !,RCTDNM," - Updating the Linked Account with PMT = $",$J(RCTAMT,"",2)," ... done."
  1.  . . . D PROCESS(RCRECTDA,RCTRANDA,RCTDNM)
  1.  . . ;
  1.  . . ; The receipt has not been processed
  1.  . . W !,RCTDNM," - Receipt has not been processed.  Account linked but not"
  1.  . . W !,?6,"updated for the PMT = $",$J(RCTAMT,"",2)
  1.  ;
  1.  ; PRCA*4.5*332 - If all money was split off the original EEOB remove it. 
  1.  D CHKEOB^RCDPEU2(RCRECTDA,RCTRANDA,.RCARRAY)
  1.  ;
  1.  W !!
  1.  ;
  1.  D ENDMSG(RCSTATUS)
  1.  ;
  1.  D WRITE^RCDPRPLU(" ")
  1.  ;
  1.  Q
  1.  ;
  1. GETACCT(RCRECTDA) ; Ask the user for the account
  1.  ;
  1.  N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,DA,RCSUSFLG,RCSTAT
  1.  ;
  1.  S RCSUSFLG=0
  1.  S DIR("A")="BILL NUMBER: ",DIR(0)="FAO"
  1.  S DIR("PRE")="I X=""SUSPENSE"" S X=""^"",RCSUSFLG=1"
  1.  D ^DIR
  1.  Q:RCSUSFLG "SUSPENSE"
  1.  I $D(DTOUT)!$D(DUOUT)!(Y="")  Q -1
  1.  ;
  1.  ;Force to all caps
  1.  S Y=$$UP^XLFSTR(Y)
  1.  ;
  1.  ; Check for valid bill number
  1.  I '$O(^PRCA(430,"D",Y,"")) S Y=""      ; Not a valid bill number
  1.  ;
  1.  Q:Y="" 0   ; quit if invalid bill number or lookup number
  1.  ;
  1.  S X=Y
  1.  S DA(1)=RCRECTDA
  1.  D PNORBILL^RCDPURED
  1.  ; 
  1.  ;if this is an account, is it active?  If not, request a new account.
  1.  I $G(X)[";PRCA" D  Q:RCSTAT'="ACTIVE" 0
  1.  . S RCSTAT=$$GET1^DIQ(430,$P($G(X),";")_",",8,"E")
  1.  . I RCSTAT'="ACTIVE",$P($G(^RCD(340,+$P(^PRCA(430,$P($G(X),";"),0),"^",9),0)),"^")[";DPT(" W !,"This bill's status is currently ",RCSTAT,".",!,"Please select a different account."
  1.  ;
  1.  ;Something went wrong.  Try again.
  1.  I '$D(X) Q 0
  1.  ;
  1.  ; Account found, return it
  1.  Q X
  1.  ;
  1. GETAMT(RCACCT,RCAMT) ; Ask the user for the amount
  1.  ;
  1.  N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,DA,RCFLG,AMTFLG
  1.  ;
  1.  ;
  1.  S RCFLG=0
  1.  F  D  Q:RCFLG
  1.  . S AMTFLG=1  ; Set amount flag check to 1 in case the account is a SUSPENSE account
  1.  . S DIR("A")="Amount to apply to Account",DIR(0)="N^0.01:"_$J(RCAMT,"",2)_":2"
  1.  . D ^DIR
  1.  . I $D(DTOUT)!$D(DUOUT)!(Y="")  S Y=-1,RCFLG=1 Q
  1.  . ;If not a SUSPENSE account, check the balance.
  1.  . I RCACCT'="" S AMTFLG=$$PAYCHK(RCACCT,Y)
  1.  . ;amount applied is greater than the amount owed.  Try again
  1.  . Q:'AMTFLG
  1.  . I +Y>0 S RCFLG=1 Q
  1.  . S Y=0,RCFLG=1
  1.  Q Y
  1.  ;
  1. GETCMT() ; Ask the user for a comment
  1.  ;
  1.  N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
  1.  F  D  Q:Y'=""
  1.  . S Y=$$COM^RCDPECH ; PRCA*4.5*321
  1.  . ;strip all leading and trailing spaces
  1.  . S Y=$$TRIM^XLFSTR(Y)
  1.  . I Y="" W !,"A comment is required when changing the status of an item in Suspense.  Please",!,"try again." Q
  1.  . I $D(DTOUT) S Y=-1
  1.  Q Y
  1.  ;
  1. CONTINUE(RCAMTRM) ; Ask the user to see if they wish to continue
  1.  ;
  1.  N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
  1.  S DIR("A")="Receipt has $"_$J(RCAMTRM,10,2)_" left to link.  Do you wish to link another? ",DIR(0)="YA"
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT)!(Y="")  Q -1
  1.  Q Y
  1.  ;
  1.  ; Confirm with the user that the wish to stop before completing the linking of payments
  1. CONQUIT() ;
  1.  ;
  1.  N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
  1.  S DIR("A",1)="Exiting now will prevent the linking of any previously selected claims to this"
  1.  S DIR("A")="receipt.  Are you sure? ",DIR(0)="YA"
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT)!(Y="")  Q 1
  1.  Q Y
  1.  ;
  1.  ;Create a new transaction using an existing transaction as the foundation.
  1. COPYTRAN(RCRECTDA,RCTDATA,RCAMT,RCGECSCR) ;
  1.  ; Input 
  1.  ;   RCRECTDA - IEN of Receipt file #344
  1.  ;   RCPAYDA  - IEN of Receipt Transaction file #344.01
  1.  ;   RCAMT    - Amount
  1.  ;   RCGECSCR - null = receipt not processed
  1.  ; Output
  1.  ;   Update Receipt file #344 and Audit log #344,71
  1.  ;
  1.  N RCNWTRAN,DR,DA,DTOUT,DIE,X,Y,RCTDATA3
  1.  ;
  1.  S RCTDATA3=$G(^RCY(344,RCRECTDA,1,RCTRANDA,3))
  1.  ;Create a new transaction
  1.  S RCNWTRAN=$$ADDTRAN^RCDPURET(RCRECTDA)
  1.  S RCCMT="Multi-Trans Split"
  1.  ;
  1.  ;Update Transaction
  1.  S DR=".02////"_$P(RCTDATA,U,2)       ;Original Confirmation #
  1.  S DR=DR_";.04///"_RCAMT              ;Amount
  1.  S DR=DR_";.06////"_$P(RCTDATA,U,6)   ;Original date of payment
  1.  S DR=DR_";.07////"_$P(RCTDATA,U,7)   ;Original Check #
  1.  S DR=DR_";.08////"_$P(RCTDATA,U,8)   ;Original Check routing #
  1.  S DR=DR_";.1////"_$P(RCTDATA,U,10)   ;Original date on the check
  1.  S DR=DR_";.11////"_$P(RCTDATA,U,11)  ;Original CC number
  1.  S DR=DR_";.12////"_$P(RCTDATA,U,12)  ;Original user who entered the check
  1.  S DR=DR_";.13////"_$P(RCTDATA,U,13)  ;Original check account #
  1.  S DR=DR_";.14///"_DUZ                ;User Linking the payment
  1.  S DR=DR_";1.02////"_RCCMT            ;Initial Comment
  1.  S DR=DR_";3.02////"_$P(RCTDATA3,U,2) ;Date Trans. originally suspense
  1.  S DR=DR_";3.03////"_$P(RCTDATA3,U,3) ;User who originally suspended Trans.
  1.  S DIE="^RCY(344,"_RCRECTDA_",1,"
  1.  S DA=RCNWTRAN,DA(1)=RCRECTDA
  1.  D ^DIE
  1.  S $P(^RCY(344,RCRECTDA,1,RCNWTRAN,0),"^",19)=$G(RCDPTYPE)
  1.  ;
  1.  ;Update the Audit Log
  1.  I $G(RCGECSCR)'="" D AUDIT^RCBEPAY(RCRECTDA,RCNWTRAN,"I")
  1.  ;
  1.  Q RCNWTRAN
  1.  ;
  1.  ;Adjust the original transaction's payment amount to match to the actual, split amount.
  1. ADJTRAMT(RCRECTDA,RCTRANDA,RCAMT,RCGECSCR,RCARRAY) ; Added RCARRAY - PRCA*4.5*326
  1.  ; Input 
  1.  ;   RCRECTDA - IEN of Receipt file #344
  1.  ;   RCPAYDA  - IEN of Receipt Transaction file #344.01
  1.  ;   RCAMT    - Amount
  1.  ;   RCGECSCR - null = receipt not processed
  1.  ;   RCARRAY  - Array of Multi-Trans split information (OPTIONAL)
  1.  ; Output
  1.  ;   Update Receipt file #344 and Audit log #344,71
  1.  ;
  1.  N RCCMT,DR,DIE,DA,DTOUT
  1.  S RCCMT="Multi-Trans Split"
  1.  ;
  1.  S DR=".04///"_RCAMT_";1.02///"_RCCMT
  1.  S DIE="^RCY(344,"_RCRECTDA_",1,"
  1.  S DA=RCTRANDA,DA(1)=RCRECTDA
  1.  D ^DIE
  1.  D LASTEDIT^RCDPUREC(RCRECTDA)
  1.  ;
  1.  ;Update the Audit Log
  1.  I $G(RCGECSCR)'="" D AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"I",.RCARRAY) ; Added RCARRAY - PRCA*4.5*326
  1.  ;Update comment history - PRCA*4.5*321
  1.  D AUDIT^RCDPECH(RCRECTDA,RCTRANDA,"","")
  1.  Q
  1.  ;
  1.  ;Link the Transaction to an existing account
  1. LINKPAY(RCRECTDA,RCTRANDA,RCACCT) ;
  1.  ;
  1.  N DR,DIE,DA,DTOUT
  1.  S DR=".09///"_RCACCT
  1.  S DIE="^RCY(344,"_RCRECTDA_",1,"
  1.  S DA=RCTRANDA,DA(1)=RCRECTDA
  1.  D ^DIE
  1.  D LASTEDIT^RCDPUREC(RCRECTDA)
  1.  Q
  1.  ;
  1.  ;Remove the suspense comment, item no longer in suspense
  1. REMCMT(RCRECTDA,RCTRANDA) ;
  1.  ;
  1.  N DR,DIE,DA,DTOUT
  1.  S DR="1.02///@"
  1.  S DIE="^RCY(344,"_RCRECTDA_",1,"
  1.  S DA=RCTRANDA,DA(1)=RCRECTDA
  1.  D ^DIE
  1.  D LASTEDIT^RCDPUREC(RCRECTDA)
  1.  Q
  1.  ;
  1. GETACTNM(RCACCT) ;
  1.  N RCACCTL,RCIEN,RCFILE
  1.  S RCACCTL=""
  1.  Q:RCACCT="" RCACCTL
  1.  S RCFILE=$S(RCACCT[";PRCA(430":430,1:2)
  1.  S RCIEN=$P(RCACCT,";")
  1.  S RCACCTL=$$GET1^DIQ(RCFILE,RCIEN_",",".01","E")
  1.  S:$L(RCACCTL,"-")>1 RCACCTL=$P(RCACCTL,"-",2)
  1.  Q RCACCTL
  1.  ;
  1.  ;Update the suspense comment
  1. UPDCMT(RCRECTDA,RCTRANDA,RCCMT) ;
  1.  ;
  1.  N DR,DIE,DA,DTOUT
  1.  S DR="1.02///"_RCCMT_";" S DIE="^RCY(344,"_RCRECTDA_",1,"
  1.  S DA=RCTRANDA,DA(1)=RCRECTDA
  1.  D ^DIE
  1.  ;Update comment history - PRCA*4.5*321
  1.  D AUDIT^RCDPECH(RCRECTDA,RCTRANDA,"","")
  1.  Q
  1.  ;
  1.  ;Process and update the payment amounts
  1.  ;Note:  some of the code and logic below is also in tag PROCESS^RCDPLPL3.  
  1.  ;       If changes in logic are made below, please review this tag as well.
  1. PROCESS(RCRECTDA,RCTRANDA,RCTDNM) ;
  1.  ;
  1.  N RCERROR
  1.  S RCERROR=$$PROCESS^RCBEPAY(RCRECTDA,RCTRANDA)
  1.  ;  an error occurred during processing a payment
  1.  I RCERROR D  Q
  1.  . W !
  1.  . W !,"+------------------------------------------------------------------------------+"
  1.  . W !,"|  An ERROR has occurred when processing payment ",RCTRANDA," on receipt ",$P(^RCY(344,RCRECTDA,0),"^"),".",?79,"|"
  1.  . W !,"|  The error message returned during processing is:",?79,"|"
  1.  . W !,"|",?79,"|"
  1.  . W !,"|  ",$P(RCERROR,"^",2),?79,"|"
  1.  . W !,"|",?79,"|"
  1.  . W !,"|  You will need to correct the error before you can link the payment.",?79,"|"
  1.  . W !,"+------------------------------------------------------------------------------+"
  1.  . W !
  1.  . D DELEACCT^RCDPURET(RCRECTDA,RCTRANDA)
  1.  . W !,"Account "_RCTDNM_" was deleted and not linked."
  1.  ;
  1.  ;File entry in Audit Log
  1.  D AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"P")
  1.  ;
  1.  ; Update Suspense Status
  1.  D SUSPDIS^RCBEPAY(RCRECTDA,RCTRANDA,"PD")
  1.  ;
  1.  I $E(RCSTATUS)="A" D
  1.  . ;  send mail message to the RCDP PAYMENTS mail group
  1.  . D MAILMSG^RCDPLPSR(RCRECTDA,RCTRANDA)
  1.  . ;  place an x in the fms doc field so it will show on the
  1.  . ;  suspense report
  1.  . D EDITFMS^RCDPURET(RCRECTDA,RCTRANDA,"x")
  1.  Q
  1.  ;
  1.  ;Display end of processing message.
  1. ENDMSG(RCSTATUS) ;
  1.  ;
  1.  I $E(RCSTATUS)="A" D
  1.  . W !,"Since the FMS cash receipt document is Accepted in FMS, you need to go"
  1.  . W !,"online in FMS and transfer the amount paid out of the station's suspense"
  1.  . W !,"account.",!
  1.  . W !,"Mail message(s) sent to RCDP PAYMENTS mail group.",!
  1.  I $E(RCSTATUS)'="A" D
  1.  . W !,"Since the FMS cash receipt document is NOT Accepted in FMS, you can use"
  1.  . W !,"the option Process Receipt located under the Receipt Processing Menu"
  1.  . W !,"to regenerate the cash receipt document to FMS.",!
  1.  Q
  1.  ;
  1.  ;Get users answers to questions for reports.
  1. GETANS(RCIDX) ;
  1.  N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT
  1.  ;
  1.  ; Ask the user what kind of report
  1.  I RCIDX=1 D
  1.  . S DIR("?")="Select to Y to review the payments, N to skip the review."
  1.  . S DIR("A")="Do you want to review the payment list before updating accounts (Y/N)? "
  1.  ;
  1.  ; Ask the user for the payer to start the reporting on (Range Option)
  1.  I RCIDX=2 D
  1.  . S DIR("?")="Enter Y to update the accounts, N to return to the LP menu"
  1.  . S DIR("A")="Do you want to update accounts with these payments (Y/N)? "
  1.  ;
  1.  S DIR(0)="YA"
  1.  D ^DIR
  1.  K DIR
  1.  I $G(DTOUT)!$G(DUOUT) Q -1
  1.  Q Y
  1.  ;
  1.  ;Retrieve the review response question from the user
  1. GETANS1() ;
  1.  ;
  1.  N FLG,X,Y
  1.  S FLG=0,Y=0
  1.  F  D  Q:FLG=1
  1.  . R !,"Do you want to review the payment list before updating accounts (Y/N)? ",X:DTIME
  1.  . ;I $G(DTOUT) S FLG=1 Q    ;If it times out, treat it like a No and go to the next prompt.
  1.  . I X="" W !,"Enter Y or N to continue." Q
  1.  . I X["?" W !,"Select to Y to review the payments, N to skip the review." Q
  1.  . S X=$$UP^XLFSTR(X)
  1.  . I X="Y" S Y=1,FLG=1 Q
  1.  . I X="N" S Y=0,FLG=1 Q
  1.  . W !,"Select to Y to review the payments, N to skip the review."
  1.  Q Y
  1.  ;
  1.  ;Is the amount entered < the amount owed. (AR ACCOUNTS ONLY, NO DEBTORS)
  1. PAYCHK(RCACCT,RCAMT) ;
  1.  ;
  1.  N OWED,FLG
  1.  ;
  1.  S FLG=0
  1.  ; account is the debtor account. No need to check...
  1.  Q:RCACCT'["PRCA" 1
  1.  ;  calculate amount owed for a bill
  1.  S OWED=$G(^PRCA(430,+RCACCT,7))
  1.  S OWED=$P(OWED,"^")+$P(OWED,"^",2)+$P(OWED,"^",3)+$P(OWED,"^",4)+$P(OWED,"^",5)
  1.  I RCAMT>OWED W !,"The requested payment is greater than then amount owed please try again.",! Q FLG
  1.  S FLG=1
  1.  Q FLG