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

RCDPLPL3.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1.  ;
  1. LINKPAY ;  link a payment to an account
  1.  N DA,DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCEEOB,X,Y ; PRCA*4.5*321 - added RCEEOB
  1.  ;
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  ;
  1.  W !!,"This option will allow the account to be entered for an unapplied"
  1.  W !,"payment transaction selected from the above list.  If the selected"
  1.  W !,"receipt has been previously processed, the selected account in the"
  1.  W !,"accounts receivable package will be updated with the payment.",!
  1.  N INDEX,RCDPFLAG,RCERROR,RCGECSCR,RCPAY,RCRECTDA,RCSTATUS,RCTRANDA,RCDCHKSW,HRCDCKSW,RCDPTYPE
  1.  S INDEX=$$SELPAY^RCDPLPL1 I 'INDEX Q
  1.  S RCPAY=$G(^TMP("RCDPLPLM",$J,"IDX",INDEX,INDEX))
  1.  S RCRECTDA=+$P(RCPAY,"^"),RCTRANDA=+$P(RCPAY,"^",2)
  1.  ;
  1.  I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
  1.  S RCDPTYPE=$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",19)
  1.  ;
  1.  ;  check to see if the cr document has been sent for the receipt
  1.  S RCGECSCR=$P($G(^RCY(344,RCRECTDA,2)),"^")
  1.  ;  code sheet already sent once, this is a retransmission, check it
  1.  I RCGECSCR'="" D
  1.  .   S RCSTATUS=$$STATUS^GECSSGET(RCGECSCR)
  1.  .   W !!,"This receipt has been processed to FMS with cash receipt document"
  1.  .   W !,$TR(RCGECSCR," "),".  The current status for this document in the"
  1.  .   W !,"Generic Code Sheet Stack file is ",RCSTATUS,"."
  1.  .   ;
  1.  .   ;  okay to continue if status is Error, Rejected, or not defined (-1)
  1.  .   I $E(RCSTATUS)="E"!($E(RCSTATUS)="R")!(RCSTATUS=-1) Q
  1.  .   ;  okay to continue if status is Accepted
  1.  .   I $E(RCSTATUS)="A" Q
  1.  .   ;  okay to continue if document is transmitted for 2 days
  1.  .   I $E(RCSTATUS)="T",$$FMDIFF^XLFDT(DT,$P(^RCY(344,RCRECTDA,0),"^",8))>1 Q
  1.  .   ;
  1.  .   W !!,"You cannot link the payment to an account until the FMS cash receipt"
  1.  .   W !,"document is either Accepted or Rejected by FMS."
  1.  .   W !,"  1.  If the FMS cash receipt is Accepted by FMS, you will need to"
  1.  .   W !,"      remove the payment from the station's suspense account online"
  1.  .   W !,"      in FMS."
  1.  .   W !,"  2.  If the FMS cash receipt document is rejected by FMS, you can"
  1.  .   W !,"      use the option Process Receipt under the Receipt Processing"
  1.  .   W !,"      listmanager screen to regenerate the document.  The payment"
  1.  .   W !,"      has not been deposited in the station's suspense account by"
  1.  .   W !,"      FMS since the cash receipt document rejected.",!
  1.  .   S VALMSG="Try linking this payment again tomorrow."
  1.  .   D WRITE^RCDPRPLU(VALMSG)
  1.  .   S RCDPFLAG=1
  1.  I $G(RCDPFLAG) D QUIT Q
  1.  ;
  1.  ;  show payment transaction
  1.  W !!,"The current payment transaction:",?40,"RECEIPT: ",$P(^RCY(344,RCRECTDA,0),"^")
  1.  W !,"--------------------------------"
  1.  D SHOWPAY(RCRECTDA,RCTRANDA)
  1.  ;
  1.  ;  transaction has account entered
  1.  I $P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3) D  Q
  1.  .   S VALMSG="An account has been assigned to this payment."
  1.  .   D QUIT
  1.  ;
  1.  ;  transaction is cancelled, cannot edit
  1.  I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D  Q
  1.  .   S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
  1.  .   D WRITE^RCDPRPLU(VALMSG)
  1.  .   D QUIT
  1.  ;
  1.  ;PRCA*4.5*304
  1.  ; Will this link payment link to multiple bills
  1.  ; Note:  some of the code and logic below is also in tag PROCESS^RCDPLPL4.  
  1.  ;        If changes in logic are made below, please review this tag as well.
  1.  ;    
  1.  S DIR(0)="YO",DIR("B")="NO"
  1.  S DIR("A")="  Will this transaction be linked to multiple claims (Y/N)"
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) D QUIT Q
  1.  I +Y D MULTIPLE^RCDPLPL4(RCRECTDA,RCTRANDA,RCGECSCR,$G(RCSTATUS)) D QUIT Q
  1.  ;end PRCA*4.5*304
  1.  ;
  1.  W !!,"Editing Payment: ",RCTRANDA
  1. DBTRBIL S RCDCHKSW=1,HRCDCKSW=0 D EDITACCT^RCDPURET(RCRECTDA,RCTRANDA) I RCDCHKSW=0 G DBTRBIL   ;prca*4.5*301
  1.  W !
  1.  ;  account not entered
  1.  I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3) D  Q
  1.  .   S VALMSG="Account was not linked."
  1.  .   D WRITE^RCDPRPLU(VALMSG)
  1.  .   D QUIT
  1.  ;
  1.  ;  show payment transaction
  1.  W !,"The NEW payment transaction:",?40,"RECEIPT: ",$P(^RCY(344,RCRECTDA,0),"^")
  1.  W !,"-----------------------------"
  1.  D SHOWPAY(RCRECTDA,RCTRANDA)
  1.  ;
  1.  I $$ASKACCT()'=1 D  Q
  1.  .   D DELEACCT^RCDPURET(RCRECTDA,RCTRANDA)
  1.  .   S VALMSG="Account was deleted and not linked."
  1.  .   D WRITE^RCDPRPLU(VALMSG)
  1.  .   D QUIT
  1.  ;
  1.  ; Option to restore suspense EEOB - PRCA*4.5*321
  1.  S RCEEOB=$$EEOB^RCDPEM5(RCRECTDA,RCTRANDA)
  1.  Q:RCEEOB<0
  1.  ;
  1.  ;  receipt has been processed since the cash receipt document
  1.  ;  has been generated.  update the new account with payment
  1.  W !
  1.  I RCGECSCR'="" D  I RCERROR Q
  1.  .   W !,"Updating the Linked Account with the payment ..."
  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.  .   .   S VALMSG="Account was deleted and not linked."
  1.  .   .   D WRITE^RCDPRPLU(VALMSG)
  1.  .   .   D QUIT
  1.  .   ;
  1.  .   ;  payment processed correctly
  1.  .   W "  done."
  1.  .   W !
  1.  .   ;
  1.  .   ;PRCA*4.5*304
  1.  .   D REMCMT^RCDPLPL4(RCRECTDA,RCTRANDA)   ; Remove the suspense comment.  No longer needed. 
  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.  .   ;end PRCA*4.5*304
  1.  .   ;
  1.  .   ; Update EEOB claim number and restore to active status - PRCA*4.5*321
  1.  .   D:RCEEOB RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"L")
  1.  .   ;
  1.  .   ; PRCA*4.5*332 - If all money was split off the original EEOB remove it. 
  1.  .   D CHKEOB^RCDPEU2(RCRECTDA,RCTRANDA)
  1.  .   ;
  1.  .   I $E($G(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.  .   .   ;  send mail message to the RCDP PAYMENTS mail group
  1.  .   .   W !,"Sending mail message to 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.  .   I $E($G(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.  .   S VALMSG="Payment linked and removed from list."
  1.  .   D WRITE^RCDPRPLU(VALMSG)
  1.  ;
  1.  ;  receipt has not been processed
  1.  I RCGECSCR="" D
  1.  .   S VALMSG="Since the receipt has not been processed, accounts will not be updated."
  1.  .   D WRITE^RCDPRPLU(VALMSG)
  1.  .   S VALMSG="Payment linked and removed from list."
  1.  .   ; Update EEOB claim number and restore to active status - PRCA*4.5*321
  1.  .   D:RCEEOB RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"L")
  1.  ;
  1. QUIT ;  call here to unlock and rebuild list
  1.  L -^RCY(344,RCRECTDA)
  1.  D INIT^RCDPLPLM
  1.  Q
  1.  ;
  1.  ;
  1. SHOWPAY(RCRECTDA,RCTRANDA) ;  show the payment transaction
  1.  N A,D0,DA,DIC,DIQ,DK,DL,DX,S,Y
  1.  S DIC="^RCY(344,"_RCRECTDA_",1,",DA(1)=RCRECTDA,DA=RCTRANDA,DIQ(0)="C"
  1.  D EN^DIQ
  1.  Q
  1.  ;
  1.  ;
  1. ASKACCT() ; ask if its the correct account
  1.  ;  1 is yes, otherwise no
  1.  N DIR,DIQ2,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="YO",DIR("B")="NO"
  1.  S DIR("A")="  Is this the correct ACCOUNT to apply the payment to"
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1.  Q Y