RC45P306.m

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 ---RC45P306   1741     printed  Apr 09, 2024@20:52:56                                                                                                                                                                                                    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      ;