Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCP367

RCP367.m

Go to the documentation of this file. 
  1. RCP367 ;AITC/DOM - Patch PRCA*4.5*367 Post Installation Processing ;20 Feb 2020 14:00:00
  1.  ;;4.5;Accounts Receivable;**367**;Feb 20, 2020;Build 11
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1. POST ;
  1.  D BMES^XPDUTL("PRCA*4.5*367 post-installation Started "_$$HTE^XLFDT($H))
  1.  D RECPTYPE
  1.  D CKOLDEFT
  1.  D BMES^XPDUTL("PRCA*4.5*367 post-installation finished "_$$HTE^XLFDT($H))
  1.  Q
  1.  ;
  1. RECPTYPE ; Add new receipt type
  1.  N ERROR,RCFDA,RCJ
  1.  I '$D(^RC(341.1,"B","CHAMPVA")) D  ; Check if already added
  1.  . D BMES^XPDUTL("Adding new entry to AR Event Type file.")
  1.  . S RCFDA(341.1,"+1,",.01)="CHAMPVA"
  1.  . S RCFDA(341.1,"+1,",.02)=17
  1.  . S RCFDA(341.1,"+1,",.06)=1
  1.  . D UPDATE^DIE(,"RCFDA")
  1.  ;
  1.  ; Check integrity of the 341.1 file.
  1.  S ERROR=0
  1.  D VERIFY^PRCABJ
  1.  I ERROR D  ;
  1.  .  D BMES^XPDUTL("**Error in AR EVENT TYPE file**")
  1.  .  S RCJ=""
  1.  .  F  S RCJ=$O(ERROR(RCJ)) Q:'RCJ  D  ;
  1.  . . D BMES^XPDUTL(ERROR(RCJ))
  1.  I 'ERROR D  ;
  1.  . D BMES^XPDUTL("AR EVENT TYPE file verified.")
  1.  Q
  1.  ;
  1. CKOLDEFT ; Check for EFTs that are 7 years or older and are matched to
  1.  ; a paper check.  These EDTs result in an erroneous Old EFT warning
  1.  ; message when working ERAs in the EDI Lockbox Worklist.  If any
  1.  ; EFTs are found that are 7 years or older and are matched to a 
  1.  ; paper check, the first three found are displayed to the IRM who is
  1.  ; then instructed to send an email message to VHAePaymentsTesting@domain.ext mail group
  1.  ; listing the EFT numbers found so testers can verify that these
  1.  ; EFTs are NOT among the list of EFTs causing the need for an
  1.  ; override.
  1.  N CTR,DAYSLIMT,EFTDA,ENDDT,MSG,RECVDT,STARTDT,TARRAY,XX,ZZ
  1.  D BMES^XPDUTL("Looking for old EFTs matched to a paper EOB with purged receipts.")
  1.  S CTR=0
  1.  S STARTDT=$$GET1^DIQ(344.61,1,.09,"I")     ; Pre-Patch EFT Cut-off Date
  1.  S STARTDT=$$FMADD^XLFDT(STARTDT,-1,0,0)    ; Back-Up one day for $O    
  1.  ;
  1.  ; Stop checking if EFTs aren't at least 7 years old because the receipts are only
  1.  ; purged for EFTs at least 7 years old (see MAN^RCDPUT)
  1.  S ENDDT=$$FMADD^XLFDT(DT,(365*-7),0,0)
  1.  S DAYSLIMT("M")=$$GET1^DIQ(344.61,1,.06)   ; Medical
  1.  S DAYSLIMT("P")=$$GET1^DIQ(344.61,1,.07)   ; Pharmacy
  1.  S DAYSLIMT("T")=$$GET1^DIQ(344.61,1,.13)   ; Tricare
  1.  ;
  1.  ; Get 3 examples of EFTs matched to paper checks with purged receipts
  1.  S RECVDT=STARTDT
  1.  F  S RECVDT=$O(^RCY(344.31,"ADR",RECVDT)) Q:'RECVDT  Q:RECVDT>ENDDT  Q:CTR>2  D
  1.  . S EFTDA=""
  1.  . F  S EFTDA=$O(^RCY(344.31,"ADR",RECVDT,EFTDA)) Q:'EFTDA  Q:CTR>2  D
  1.  . . D CHKEFT(RECVDT,EFTDA,"A",.DAYSLIMT,.TARRAY,.CTR)
  1.  ;
  1.  I CTR=0 D  Q
  1.  . D BMES^XPDUTL("No old EFTs matched to a paper EOB with purged receipts were found.")
  1.  ;
  1.  S XX=1
  1.  S MSG(1)="The following trace numbers of old EFTs with purged receipts were found:"
  1.  S ZZ=""
  1.  F  D  Q:ZZ=""
  1.  . S ZZ=$O(TARRAY(ZZ))
  1.  . Q:ZZ=""
  1.  . S XX=XX+1,MSG(XX)="     "_ZZ
  1.  S XX=XX+1,MSG(XX)="Please send an outlook email to:  VHAePaymentsTesting@domain.ext"
  1.  S XX=XX+1,MSG(XX)="Include the installation site and the Trace Numbers listed above."
  1.  D BMES^XPDUTL(.MSG)
  1.  Q
  1.  ;
  1. CHKEFT(RECVDT,EFTDA,TYPE,DAYSLIMT,TRARRY,CTR) ; Check EFT for warnings/errors
  1.  ;Input:    RECVDT  - Current Date Received being processed
  1.  ;          EFTDA   - IEN of EDI THIRD PARY EFT DETAIL
  1.  ;          TYPE    - "A" (Medical, Pharmacy and Tricare)
  1.  ;          DAYSLIMT- days an EFT can age before post prevention rules apply 
  1.  ;          TRARRY  - Current Array of trace numbers of problem EFTs
  1.  ;          CTR     - Current number of EFTs found
  1.  ; Ouput:   TRARRY  - Updated Array of trace numbers of problem EFTs
  1.  ;          CTR     - Updated number of EFTs found
  1.  ;
  1.  N EFTTYPE,ERAREC,TRACE
  1.  Q:$G(^RCY(344.31,EFTDA,0))=""                      ; skip, no data
  1.  Q:+$$GET1^DIQ(344.31,EFTDA_",",.07,"I")=0          ; skip, zero payment amt.
  1.  ;
  1.  ; Ignore duplicate EFTs which have been removed 
  1.  Q:$$GET1^DIQ(344.31,EFTDA_",",.18,"I")             ;^DD(344.31,.18,0)="DATE/TIME DUPLICATE REMOVED
  1.  S ERAREC=+$$GET1^DIQ(344.31,EFTDA_",",.1,"I")      ; Pointer to ERA record
  1.  Q:ERAREC                                           ; Matched to an ERA
  1.  ;
  1.  ; Exclude EFT matched to Paper EOB if receipt is processed
  1.  Q:'$$GET1^DIQ(344.31,EFTDA_",",.08,"I")            ; Not matched to a paper check
  1.  Q:'$$PROC(EFTDA)                                   ; Receipt isn't purged
  1.  S TRACE=$$GET1^DIQ(344.31,EFTDA_",",.04,"I")       ; TRACE #
  1.  S:TRACE="" TRACE="(No trace #)"
  1.  S CTR=CTR+1,TRARRY(TRACE)=""
  1.  Q
  1.  ;
  1. PROC(EFTDA) ; Check if TR Receipt for an EFT linked to Paper EOB was purged 
  1.  ; Input:   EFTDA - IEN for file 344.31
  1.  ; Returns: 1 if TR receipt was purged, 0 otherwise
  1.  N IEN344
  1.  ;
  1.  ; Find TR receipt and check if status is not CLOSED
  1.  S IEN344=$O(^RCY(344,"AEFT",EFTDA,0))
  1.  I IEN344="" Q 1                                       ; Purged Receipt
  1.  Q 0
  1.  ;