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

RCDPEX4.m

Go to the documentation of this file.
  1. RCDPEX4 ;ALB/DRF - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;Jun 06, 2014@19:11:19
  1. ;;4.5;Accounts Receivable;**298,321**;Mar 20, 1995;Build 48
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;Call to $$RXBIL^IBNCPDPU via private IA #4435
  1. ;
  1. ;Cycle through the exception list looking for entries with an ECME number:
  1. EN N ARRAY,ECME,EOB,ERA,RCBILL,RCER
  1. S RCER=0 F S RCER=$O(^RCY(344.4,"AEXC",RCER)) Q:'RCER D
  1. .S ERA="" F S ERA=$O(^RCY(344.4,"AEXC",RCER,ERA)) Q:'ERA D
  1. ..S EOB="" F S EOB=$O(^RCY(344.4,"AEXC",RCER,ERA,EOB)) Q:'EOB D
  1. ...;Ignore the exception if no ECME number is present
  1. ...S ECME=$P($G(^RCY(344.4,ERA,1,EOB,4)),U,2) Q:ECME=""
  1. ...;Lock zero node of ERA DETAIL
  1. ...L +^RCY(344.4,ERA,1,EOB,0):5 Q:'$T
  1. ...;Check for a matching bill in #399 (Rx Released) and if found remove error from exception list
  1. ...K ARRAY S ARRAY("ECME")=ECME,ARRAY("FILLDT")=$$SDATE(ERA,EOB) ; PRCA*4.5*326
  1. ...S RCBILL=$$RXBIL^IBNCPDPU(.ARRAY) ; DBIA 4435
  1. ...I RCBILL>0 S RCBILL(1)=$P($G(^PRCA(430,RCBILL,0)),U) D REMOVE(ERA,EOB,.RCBILL,ECME)
  1. ...;Unlock zero node of ERA DETAIL
  1. ...L -^RCY(344.4,ERA,1,EOB,0)
  1. Q
  1. ;
  1. REMOVE(RCXDA1,RCXDA,RCBILL,RCSAVE) ;Remove from exception list and file EEOB against matched claim
  1. ;RCXDA1 - ERA IEN
  1. ;RCXDA - ERA DETAIL IEN
  1. ;RCBILL - CLAIM array for released Rx
  1. ;RCSAVE - ORIGINAL CLAIM from ERA (ECME #)
  1. K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR")
  1. N DA,Q,Q0,RC0,RCEOB,DIE,DR
  1. S RC0=$G(^RCY(344.4,RCXDA1,1,RCXDA,0))
  1. S Q=0 F S Q=$O(^RCY(344.4,RCXDA1,1,RCXDA,1,Q)) Q:'Q S Q0=$G(^(Q,0)) D
  1. .I $P(Q0,U)["835ERA" S ^TMP($J,"RCDPEOB","HDR")=Q0
  1. .I $P(Q0,U,2)=$P(RC0,U,5) S $P(Q0,U,2)=RCBILL(1)
  1. .S ^TMP($J,"RCDP-EOB",1,Q,0)=Q0
  1. S ^TMP($J,"RCDP-EOB",1,.5,0)="835ERA"
  1. S RCEOB=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"",1)",RCBILL) ; IA 4042
  1. K ^TMP($J,"RCDP-EOB",1,.5,0)
  1. I RCEOB D Q
  1. .N RCWHY S RCWHY(1)="EEOB already found on file while trying to change claim # and filing into IB"
  1. .D STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY)
  1. .S DA(1)=RCXDA1,DA=RCXDA D CHGED(.DA,RCEOB,RCSAVE)
  1. ;
  1. ; Add stub rec to 361.1 if not there
  1. S RCEOB=+$$ADD3611^IBCEOB(+$P($G(^RCY(344.4,RCXDA1,0)),U,12),"","",RCBILL,1,"^TMP("_$J_",""RCDP-EOB"",1)") ; IA 4042
  1. ;
  1. I RCEOB<0 D Q
  1. .N RCWHY S RCWHY(1)="Error encountered trying to change claim # and file into IB"
  1. .D STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY)
  1. ;
  1. ; Update EOB in file 361.1
  1. ; Call needs ^TMP arrays: $J,"RCDPEOB","HDR" and $J,"RCDP-EOB"
  1. D UPD3611^IBCEOB(RCEOB,1,1) ; IA 4042
  1. ; errors in ^TMP("RCDPERR-EOB",$J
  1. I $O(^TMP("RCDPERR-EOB",$J,0)) D
  1. .D ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB") ; Adds error msgs to IB file 361.1 ; IA 4042
  1. ;
  1. N RCWHY S RCWHY(1)="EEOB claim # changed and filed into IB under new claim #"
  1. D STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY)
  1. S DA(1)=RCXDA1,DA=RCXDA
  1. D CHGED(.DA,RCEOB,RCSAVE)
  1. S DIE="^RCY(344.4,"_DA(1)_",1,",DR="1///@" D ^DIE
  1. ;
  1. K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR"),^TMP("RCDPERR-EOB",$J)
  1. Q
  1. ;
  1. CHGED(DA,RCEOB,RCSAVE) ; Change bad bill # to good one for EOB
  1. ; DA = DA and DA(1) to use for DIE call
  1. ; RCEOB = the ien of the entry in file 361.1
  1. ; RCSAVE = the free text of the original bill #
  1. N DIE,DR,X,Y
  1. S DIE="^RCY(344.4,"_DA(1)_",1,",DR=".05///@;.02////"_RCEOB_";.13////1"_$S(RCSAVE'="":";.17////"_RCSAVE,1:"")_";.07///@" D ^DIE
  1. Q
  1. ;
  1. ; BEGIN PRCA*4.5*321
  1. SDATE(ERA,LINE) ;Return Service Date for the ERA
  1. ; INPUT
  1. ; ERA = ERA number
  1. ; LINE = ERA line
  1. ; OUTPUT
  1. ; SDATE = Service date
  1. ;Scan RAW DATA multiple SERVICE DATE is piece 19 of record type 40
  1. N SUB,REC,SDATE,STDAT
  1. S SUB=0,SDATE="",STDAT=""
  1. F S SUB=$O(^RCY(344.4,ERA,1,LINE,1,SUB)) Q:'SUB D Q:SDATE]""
  1. .S REC=$G(^RCY(344.4,ERA,1,LINE,1,SUB,0))
  1. .I +REC=5 S STDAT=$P(REC,U,9) Q
  1. .I +REC=40 S SDATE=$P(REC,U,19)
  1. ;If no service date use statement date
  1. I 'SDATE,STDAT S SDATE=STDAT
  1. Q SDATE
  1. ; END PRCA*4.5*321