- 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 Jan 18, 2025@02:48:38 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