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 Nov 22, 2024@16:52:32 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 ;
