- RC45P306 ;OAK/ELZ-POST-INSTALL PRCA*4.5*306 ROLLBACK DEPOSIT ;14-SEP-08
- ;;4.5;Accounts Receivable;**306**;Mar 20, 1995;Build 3
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;
- POST ;This will find and backout a deposit that needs to be reversed
- ; the deposit ticket number is 16822 + 3 digit station number
- ; - explain job
- ;
- D BMES^XPDUTL(" Post-install for PRCA*4.5*306 Starting.")
- ;
- N RCDPOSIT,RCDPDT,RCDTOP,RCRCPT,RCDATA0,RCMSG,RCMSGC
- S RCMSGC=0
- S RCDPOSIT=16822_(+$P($$SITE^VASITE,"^",3))
- ;
- ; look up deposit
- S RCDPDT=$O(^RCY(344.1,"B",RCDPOSIT,0))
- I 'RCDPDT D Q
- . D BMES^XPDUTL(" - Unable to find deposit "_RCDPOSIT_".")
- . D BMES^XPDUTL(" Nothing done, quitting post-install")
- ;
- ; display deposit found.
- D BMES^XPDUTL(" - Found deposit ticket "_RCDPOSIT_" **REVERSING**")
- S RCRCPT=0 F S RCRCPT=$O(^RCY(344,"AD",RCDPDT,RCRCPT)) Q:'RCRCPT D
- . S RCDATA0=$G(^RCY(344,RCRCPT,0))
- . S RCDTOP=$P(RCDATA0,"^",3)
- . I 'RCDTOP D Q
- .. D BMES^XPDUTL(" - AR Batch Payment "_$P(RCDATA0,"^")_"has no date opened!")
- .. D BMES^XPDUTL(" CANNOT PROCESS IT FURTHER!")
- . S RCDTOP($P(RCDATA0,"^",3))=""
- . S RCMSGC=RCMSGC+1,RCMSG(RCMSGC)=" - Date Opened "_$$FMTE^XLFDT(RCDTOP)_" with "_$P($G(^RCY(344,RCRCPT,1,0)),"^",4)_" transactions"
- D BMES^XPDUTL(.RCMSG) K RCMSG
- ;
- ; call to roll back the deposit
- D BMES^XPDUTL(" - Rolling back deposit(s)...")
- S RCDTOP=0 F S RCDTOP=$O(RCDTOP(RCDTOP)) Q:'RCDTOP D REVERSE^RCDPXFIX(RCDPOSIT,RCDTOP)
- S RCMSG(1)=" - All done, the members of RCDP PAYMENTS will receive"
- S RCMSG(2)=" MailMan message(s) of the results."
- D BMES^XPDUTL(.RCMSG)
- ;
- D BMES^XPDUTL(" Post-install for PRCA*4.5*306 Complete.")
- ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRC45P306 1741 printed Jan 18, 2025@02:43:33 Page 2
- 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
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;
- POST ;This will find and backout a deposit that needs to be reversed
- +1 ; the deposit ticket number is 16822 + 3 digit station number
- +2 ; - explain job
- +3 ;
- +4 DO BMES^XPDUTL(" Post-install for PRCA*4.5*306 Starting.")
- +5 ;
- +6 NEW RCDPOSIT,RCDPDT,RCDTOP,RCRCPT,RCDATA0,RCMSG,RCMSGC
- +7 SET RCMSGC=0
- +8 SET RCDPOSIT=16822_(+$PIECE($$SITE^VASITE,"^",3))
- +9 ;
- +10 ; look up deposit
- +11 SET RCDPDT=$ORDER(^RCY(344.1,"B",RCDPOSIT,0))
- +12 IF 'RCDPDT
- Begin DoDot:1
- +13 DO BMES^XPDUTL(" - Unable to find deposit "_RCDPOSIT_".")
- +14 DO BMES^XPDUTL(" Nothing done, quitting post-install")
- End DoDot:1
- QUIT
- +15 ;
- +16 ; display deposit found.
- +17 DO BMES^XPDUTL(" - Found deposit ticket "_RCDPOSIT_" **REVERSING**")
- +18 SET RCRCPT=0
- FOR
- SET RCRCPT=$ORDER(^RCY(344,"AD",RCDPDT,RCRCPT))
- if 'RCRCPT
- QUIT
- Begin DoDot:1
- +19 SET RCDATA0=$GET(^RCY(344,RCRCPT,0))
- +20 SET RCDTOP=$PIECE(RCDATA0,"^",3)
- +21 IF 'RCDTOP
- Begin DoDot:2
- +22 DO BMES^XPDUTL(" - AR Batch Payment "_$PIECE(RCDATA0,"^")_"has no date opened!")
- +23 DO BMES^XPDUTL(" CANNOT PROCESS IT FURTHER!")
- End DoDot:2
- QUIT
- +24 SET RCDTOP($PIECE(RCDATA0,"^",3))=""
- +25 SET RCMSGC=RCMSGC+1
- SET RCMSG(RCMSGC)=" - Date Opened "_$$FMTE^XLFDT(RCDTOP)_" with "_$PIECE($GET(^RCY(344,RCRCPT,1,0)),"^",4)_" transactions"
- End DoDot:1
- +26 DO BMES^XPDUTL(.RCMSG)
- KILL RCMSG
- +27 ;
- +28 ; call to roll back the deposit
- +29 DO BMES^XPDUTL(" - Rolling back deposit(s)...")
- +30 SET RCDTOP=0
- FOR
- SET RCDTOP=$ORDER(RCDTOP(RCDTOP))
- if 'RCDTOP
- QUIT
- DO REVERSE^RCDPXFIX(RCDPOSIT,RCDTOP)
- +31 SET RCMSG(1)=" - All done, the members of RCDP PAYMENTS will receive"
- +32 SET RCMSG(2)=" MailMan message(s) of the results."
- +33 DO BMES^XPDUTL(.RCMSG)
- +34 ;
- +35 DO BMES^XPDUTL(" Post-install for PRCA*4.5*306 Complete.")
- +36 ;
- +37 QUIT
- +38 ;