RCP409.m

RCP409 ;AITC/DOM - Patch PRCA*4.5*371 Post Installation Processing ;20 Feb 2020 14:00:00

 ;;4.5;Accounts Receivable;**409**;Feb 20, 2020;Build 17

 ;Per VA Directive 6402, this routine should not be modified.

 Q

 ;

POST ;

 D REMDES                                       ; Remove Data exceptions

 D RECPTYPE                                     ; Add two new receipt types

 D BMES^XPDUTL("PRCA*4.5*409 post-installation finished "_$$HTE^XLFDT($H))

 Q

 ;

REMDES ; Removes Data Exceptions for all ERAs that have been removed from the worklist

 ; and have data exceptions

 N ERA,RREASON,RUSER,Z

 D MES^XPDUTL(">> Removing EOB Data Exceptions for ERAs that have been removed from the worklist...")

 ;

 S ERA=0

 F  D  Q:'ERA

 . S ERA=$O(^RCY(344.4,ERA))

 . Q:'ERA

 . Q:$P(^RCY(344.4,ERA,0),"^",14)'=4            ; ERA has not been removed from the worklist

 . S Z=$G(^RCY(344.4,ERA,6))                    ; Get removed from worklist data

 . S RUSER=$P(Z,"^",1)                          ; User who removed the ERA from the worklist

 . S RREASON=$P(Z,"^",1)                        ; Reason the ERA was removed from the worklist

 . Q:RREASON=""

 . S:$L(RREASON)<5 RREASON=RREASON_".   "       ; Make sure the reason is at least 3 characters long

 . D REMEXC^RCDPEX31(ERA,RREASON,1)             ; Remove any data exceptions

 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

 ; . D BMES^XPDUTL("Adding new entry 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")

 ;

 I $D(^RC(341.1,"B","OGC-EFT")) D  ; Check if exists

 . D BMES^XPDUTL("Removing entry OGC-EFT from AR Event Type file.")

 . S RCIEN=$O(^RC(341.1,"B","OGC-EFT",0))

 . I RCIEN D  ;

 . . S RCFDA(341.1,RCIEN_",",.01)="@"

 . . D FILE^DIE("","RCFDA")

 ;

 I '$D(^RC(341.1,"B","OGC-CHK")) D  ; Check if already added

 . K RCFDA,RCIENS

 . D BMES^XPDUTL("Adding new entry OGC-CHK to AR Event Type file.")

 . S RCIENS(1)=19

 . S RCFDA(341.1,"+1,",.01)="OGC-CHK"

 . S RCFDA(341.1,"+1,",.02)=19

 . 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 in AR EVENT TYPE file**")

 .  S RCJ=""

 .  F  S RCJ=$O(ERROR(RCJ)) Q:'RCJ  D  ;

 . . D BMES^XPDUTL(ERROR(RCJ))

 I 'ERROR D  ;

 . D BMES^XPDUTL("AR EVENT TYPE file verified.")

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RCP409   2589     printed  Mar 13, 2025@20:52:03                                                                                                                                                                                                      Page 2

RCP409    ;AITC/DOM - Patch PRCA*4.5*371 Post Installation Processing ;20 Feb 2020 14:00:00

 +1       ;;4.5;Accounts Receivable;**409**;Feb 20, 2020;Build 17

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3        QUIT 

 +4       ;

POST      ;

 +1       ; Remove Data exceptions

           DO REMDES

 +2       ; Add two new receipt types

           DO RECPTYPE

 +3        DO BMES^XPDUTL("PRCA*4.5*409 post-installation finished "_$$HTE^XLFDT($HOROLOG))

 +4        QUIT 

 +5       ;

REMDES    ; Removes Data Exceptions for all ERAs that have been removed from the worklist

 +1       ; and have data exceptions

 +2        NEW ERA,RREASON,RUSER,Z

 +3        DO MES^XPDUTL(">> Removing EOB Data Exceptions for ERAs that have been removed from the worklist...")

 +4       ;

 +5        SET ERA=0

 +6        FOR 

               Begin DoDot:1

 +7                SET ERA=$ORDER(^RCY(344.4,ERA))

 +8                if 'ERA

                       QUIT 

 +9       ; ERA has not been removed from the worklist

                   if $PIECE(^RCY(344.4,ERA,0),"^",14)'=4

                       QUIT 

 +10      ; Get removed from worklist data

                   SET Z=$GET(^RCY(344.4,ERA,6))

 +11      ; User who removed the ERA from the worklist

                   SET RUSER=$PIECE(Z,"^",1)

 +12      ; Reason the ERA was removed from the worklist

                   SET RREASON=$PIECE(Z,"^",1)

 +13               if RREASON=""

                       QUIT 

 +14      ; Make sure the reason is at least 3 characters long

                   if $LENGTH(RREASON)<5

                       SET RREASON=RREASON_".   "

 +15      ; Remove any data exceptions

                   DO REMEXC^RCDPEX31(ERA,RREASON,1)

               End DoDot:1

               if 'ERA

                   QUIT 

 +16       QUIT 

 +17      ;

RECPTYPE  ; Add new receipt type OGC-CHK and remove OGC-EFT from IOC sites

 +1        NEW ERROR,RCFDA,RCIEN,RCIENS,RCJ

 +2       ; I '$D(^RC(341.1,"B","OGC-EFT")) D  ; Check if already added

 +3       ; . D BMES^XPDUTL("Adding new entry to AR Event Type file.")

 +4       ; . S RCFDA(341.1,"+1,",.01)="OGC-EFT"

 +5       ; . S RCFDA(341.1,"+1,",.02)=18

 +6       ; . S RCFDA(341.1,"+1,",.06)=1

 +7       ; . D UPDATE^DIE(,"RCFDA")

 +8       ;

 +9       ; Check if exists

           IF $DATA(^RC(341.1,"B","OGC-EFT"))

               Begin DoDot:1

 +10               DO BMES^XPDUTL("Removing entry OGC-EFT from AR Event Type file.")

 +11               SET RCIEN=$ORDER(^RC(341.1,"B","OGC-EFT",0))

 +12      ;

                   IF RCIEN

                       Begin DoDot:2

 +13                       SET RCFDA(341.1,RCIEN_",",.01)="@"

 +14                       DO FILE^DIE("","RCFDA")

                       End DoDot:2

               End DoDot:1

 +15      ;

 +16      ; Check if already added

           IF '$DATA(^RC(341.1,"B","OGC-CHK"))

               Begin DoDot:1

 +17               KILL RCFDA,RCIENS

 +18               DO BMES^XPDUTL("Adding new entry OGC-CHK to AR Event Type file.")

 +19               SET RCIENS(1)=19

 +20               SET RCFDA(341.1,"+1,",.01)="OGC-CHK"

 +21               SET RCFDA(341.1,"+1,",.02)=19

 +22               SET RCFDA(341.1,"+1,",.06)=1

 +23               DO UPDATE^DIE(,"RCFDA","RCIENS")

               End DoDot:1

 +24      ;

 +25      ; Check integrity of the 341.1 file.

 +26       SET ERROR=0

 +27       DO VERIFY^PRCABJ

 +28      ;

           IF ERROR

               Begin DoDot:1

 +29               DO BMES^XPDUTL("**Error in AR EVENT TYPE file**")

 +30               SET RCJ=""

 +31      ;

                   FOR 

                       SET RCJ=$ORDER(ERROR(RCJ))

                       if 'RCJ

                           QUIT 

                       Begin DoDot:2

 +32                       DO BMES^XPDUTL(ERROR(RCJ))

                       End DoDot:2

               End DoDot:1

 +33      ;

           IF 'ERROR

               Begin DoDot:1

 +34               DO BMES^XPDUTL("AR EVENT TYPE file verified.")

               End DoDot:1

 +35       QUIT 

 +36      ;