RCP436 ;AITC/CJE - Patch PRCA*4.5*436 Post Installation Processing ;20 Feb 2020 14:00:00
;;4.5;Accounts Receivable;**436**;Feb 20, 2020;Build 3
;Per VA Directive 6402, this routine should not be modified.
Q
;
POST ;
D RECPTYPE ; Add OGC-EFT receipt type
D BMES^XPDUTL("PRCA*4.5*436 post-installation finished "_$$HTE^XLFDT($H))
Q
;
RECPTYPE ; Add new receipt type OGC-CHK and remove OGC-EFT from IOC sites
N ERROR,RCFDA,RCIEN,RCIENS,RCJ
;
I '$D(^RC(341.1,"B","OGC-EFT")) D ; Check if already added
. S RCIENS(1)=18
. D BMES^XPDUTL("Adding new entry 'OGC-EFT' to AR Event Type file.")
. S RCFDA(341.1,"+1,",.01)="OGC-EFT"
. S RCFDA(341.1,"+1,",.02)=18
. S RCFDA(341.1,"+1,",.06)=1
. D UPDATE^DIE(,"RCFDA","RCIENS")
;
; Check integrity of the 341.1 file.
S ERROR=0
D VERIFY^PRCABJ
I ERROR D ;
. D BMES^XPDUTL("**Error verifying AR reference files**")
. S RCJ=""
. F S RCJ=$O(ERROR(RCJ)) Q:'RCJ D ;
. . D BMES^XPDUTL(ERROR(RCJ))
I 'ERROR D ;
. D BMES^XPDUTL("AR reference files verified.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCP436 1095 printed Dec 13, 2024@01:47:25 Page 2
RCP436 ;AITC/CJE - Patch PRCA*4.5*436 Post Installation Processing ;20 Feb 2020 14:00:00
+1 ;;4.5;Accounts Receivable;**436**;Feb 20, 2020;Build 3
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POST ;
+1 ; Add OGC-EFT receipt type
DO RECPTYPE
+2 DO BMES^XPDUTL("PRCA*4.5*436 post-installation finished "_$$HTE^XLFDT($HOROLOG))
+3 QUIT
+4 ;
RECPTYPE ; Add new receipt type OGC-CHK and remove OGC-EFT from IOC sites
+1 NEW ERROR,RCFDA,RCIEN,RCIENS,RCJ
+2 ;
+3 ; Check if already added
IF '$DATA(^RC(341.1,"B","OGC-EFT"))
Begin DoDot:1
+4 SET RCIENS(1)=18
+5 DO BMES^XPDUTL("Adding new entry 'OGC-EFT' to AR Event Type file.")
+6 SET RCFDA(341.1,"+1,",.01)="OGC-EFT"
+7 SET RCFDA(341.1,"+1,",.02)=18
+8 SET RCFDA(341.1,"+1,",.06)=1
+9 DO UPDATE^DIE(,"RCFDA","RCIENS")
End DoDot:1
+10 ;
+11 ; Check integrity of the 341.1 file.
+12 SET ERROR=0
+13 DO VERIFY^PRCABJ
+14 ;
IF ERROR
Begin DoDot:1
+15 DO BMES^XPDUTL("**Error verifying AR reference files**")
+16 SET RCJ=""
+17 ;
FOR
SET RCJ=$ORDER(ERROR(RCJ))
if 'RCJ
QUIT
Begin DoDot:2
+18 DO BMES^XPDUTL(ERROR(RCJ))
End DoDot:2
End DoDot:1
+19 ;
IF 'ERROR
Begin DoDot:1
+20 DO BMES^XPDUTL("AR reference files verified.")
End DoDot:1
+21 QUIT
