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

RC45P306.m

Go to the documentation of this file.
  1. RC45P306 ;OAK/ELZ-POST-INSTALL PRCA*4.5*306 ROLLBACK DEPOSIT ;14-SEP-08
  1. ;;4.5;Accounts Receivable;**306**;Mar 20, 1995;Build 3
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. POST ;This will find and backout a deposit that needs to be reversed
  1. ; the deposit ticket number is 16822 + 3 digit station number
  1. ; - explain job
  1. ;
  1. D BMES^XPDUTL(" Post-install for PRCA*4.5*306 Starting.")
  1. ;
  1. N RCDPOSIT,RCDPDT,RCDTOP,RCRCPT,RCDATA0,RCMSG,RCMSGC
  1. S RCMSGC=0
  1. S RCDPOSIT=16822_(+$P($$SITE^VASITE,"^",3))
  1. ;
  1. ; look up deposit
  1. S RCDPDT=$O(^RCY(344.1,"B",RCDPOSIT,0))
  1. I 'RCDPDT D Q
  1. . D BMES^XPDUTL(" - Unable to find deposit "_RCDPOSIT_".")
  1. . D BMES^XPDUTL(" Nothing done, quitting post-install")
  1. ;
  1. ; display deposit found.
  1. D BMES^XPDUTL(" - Found deposit ticket "_RCDPOSIT_" **REVERSING**")
  1. S RCRCPT=0 F S RCRCPT=$O(^RCY(344,"AD",RCDPDT,RCRCPT)) Q:'RCRCPT D
  1. . S RCDATA0=$G(^RCY(344,RCRCPT,0))
  1. . S RCDTOP=$P(RCDATA0,"^",3)
  1. . I 'RCDTOP D Q
  1. .. D BMES^XPDUTL(" - AR Batch Payment "_$P(RCDATA0,"^")_"has no date opened!")
  1. .. D BMES^XPDUTL(" CANNOT PROCESS IT FURTHER!")
  1. . S RCDTOP($P(RCDATA0,"^",3))=""
  1. . S RCMSGC=RCMSGC+1,RCMSG(RCMSGC)=" - Date Opened "_$$FMTE^XLFDT(RCDTOP)_" with "_$P($G(^RCY(344,RCRCPT,1,0)),"^",4)_" transactions"
  1. D BMES^XPDUTL(.RCMSG) K RCMSG
  1. ;
  1. ; call to roll back the deposit
  1. D BMES^XPDUTL(" - Rolling back deposit(s)...")
  1. S RCDTOP=0 F S RCDTOP=$O(RCDTOP(RCDTOP)) Q:'RCDTOP D REVERSE^RCDPXFIX(RCDPOSIT,RCDTOP)
  1. S RCMSG(1)=" - All done, the members of RCDP PAYMENTS will receive"
  1. S RCMSG(2)=" MailMan message(s) of the results."
  1. D BMES^XPDUTL(.RCMSG)
  1. ;
  1. D BMES^XPDUTL(" Post-install for PRCA*4.5*306 Complete.")
  1. ;
  1. Q
  1. ;