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 ---[H[J[2J[HRCP409 2589 printed Apr 09, 2024@20:53:06 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 ;
