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

RCDPEX32.m

Go to the documentation of this file. 
  1. RCDPEX32 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;Aug 14, 2014@16:27:32
  1.  ;;4.5;Accounts Receivable;**173,249,298,304,321**;Mar 20, 1995;Build 48
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. EDITNUM ; Edit invalid claim # to valid, refile EOB
  1.  N RC,RC0,RCDA,RCXDA,RCXDA1,RCSAVE,RCEOB,RCWARN,Q,Q0,DA,DR,DIE,DIC,DIR,DTOUT,DIRUT,X,Y,RCBILL,RCCHG,RCSUSP,RCQUIT,RCDONE
  1.  D FULL^VALM1
  1.  D SEL^RCDPEX3(.RCDA)
  1.  G:'$O(RCDA(0)) EDITNQ
  1.  ;
  1.  S RC=0 F  S RC=$O(RCDA(RC)) Q:'RC  D  L -^RCY(344.4,RCXDA1,1,RCXDA,0)
  1.  . S RCXDA1=+RCDA(RC),RCXDA=+$P(RCDA(RC),U,2),RCSAVE=""
  1.  . I '$$LOCK^RCDPEX31(RCXDA1,RCXDA,1) D  Q
  1.  .. S DIR(0)="EA",DIR("A",1)="**Selection #"_RC_" is being edited by another user - ... please try again later",DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR
  1.  . S RC0=$G(^RCY(344.4,RCXDA1,1,RCXDA,0))
  1.  . I $P(RC0,U,5)="" D  Q
  1.  .. S DIR(0)="EA",DIR("A",1)="The claim for selection #"_RC_" can't be edited as the bill # is not invalid",DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR
  1.  . I $P(RC0,U,9) D  Q
  1.  .. S DIR(0)="EA",DIR("A",1)="The claim for selection #"_RC_" can't be edited as the claim has already",DIR("A")="been transferred to another site - PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR
  1.  . ;
  1.  . I $D(^RCY(344.49,RCXDA1)) D
  1.  .. N X
  1.  .. S X=$G(^RCY(344,+$P($G(^RCY(344.49,RCXDA1,0)),U,2),0))
  1.  .. W !!,*7,"Warning: EEOB Worklist entry #"_RCXDA1_$S($P(X,U)'="":" and receipt "_$P(X,U),1:"")_" exist for this EEOB"
  1.  .. I X="" W !,"You should refresh the worklist entry to include the new claim #",!," before creating the receipt",!
  1.  . I $P($G(^RCY(344.4,RCXDA1,0)),U,8) D
  1.  .. W !,"Since the receipt for this EEOB ("_$P($G(^RCY(344,+$P($G(^RCY(344.4,RCXDA1,0)),U,8),0)),U)_") already exists"
  1.  .. I '$P($G(^RCY(344,+$P($G(^RCY(344.4,RCXDA1,0)),U,8),0)),U,14) W !," and is closed, you will need to use link payment to apply the payment",!," to the correct account",! Q
  1.  .. W !," you should edit the receipt and change the claim # so it posts to the",!," correct account",!
  1.  . ;
  1.  . I $P(RC0,U,17)="" S RCSAVE=$P(RC0,U,5)
  1.  . W !,"Selection #: "_RC_$J("",5)_$P(RC0,U,5)
  1.  . S (RCQUIT,RCDONE)=0
  1.  . F  D  Q:RCQUIT!RCDONE
  1.  .. K DIR
  1.  .. S DIR("?",1)="Answer with ACCOUNTS RECEIVABLE BILL NO., or PATIENT, or DEBTOR, or"
  1.  .. S DIR("?")="    TOP REFUND STATUS, or FMS TRANSMISSION DATE"
  1.  .. S DIR(0)="FAO^1:15",DIR("A")="Select A/R Bill this EEOB is actually paying on: "
  1.  .. D ^DIR I $D(DIRUT)!$D(DTOUT) S RCQUIT=1 Q
  1.  .. S DIC="^PRCA(430,",DIC(0)="EM",DIC("S")="I $D(^DGCR(399,+Y,0))" W ! D ^DIC I X="^" S RCQUIT=1 Q
  1.  .. S RCSUSP=X
  1.  .. I '(Y>0) D  Q:RCQUIT
  1.  ... S DIR("A")="   THIS CLAIM WAS NOT FOUND IN YOUR AR.  DO YOU WANT TO CONTINUE?: "
  1.  ... S DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR W ! I $D(DIRUT)!$D(DTOUT) S RCQUIT=1 Q
  1.  ... I Y=1 S RCBILL=0,RCBILL(1)=RCSUSP,RCWARN=0,RCDONE=1
  1.  .. E  D
  1.  ... S RCBILL=+Y,RCBILL(1)=$P($G(^PRCA(430,RCBILL,0)),U),RCWARN=0,RCDONE=1
  1.  . Q:RCQUIT
  1.  . I $P($G(^RCY(344.4,RCXDA1,0)),U,14) S RCWARN=RCWARN+1,DIR("A",RCWARN+1)=$J("",4)_"THE RECEIPT FOR THIS EEOB HAS ALREADY BEEN POSTED."
  1.  . I RCBILL>0,$P($G(^PRCA(430.3,+$P($G(^PRCA(430,RCBILL,0)),U,8),0)),U,3)'=102 S RCWARN=RCWARN+1,DIR("A",RCWARN+1)=$J("",4)_"THIS IS NOT AN ACTIVE ACCOUNTS RECEIVABLE."
  1.  . I RCWARN>0 D  I Y'=1 Q
  1.  .. S DIR("A",1)="** WARNING"_$S(RCWARN>1:"S",1:"")_":"
  1.  .. S DIR("A",RCWARN+2)=" "
  1.  .. S DIR(0)="YA",DIR("A")="ARE YOU SURE YOU WANT TO FILE THIS EEOB FOR CLAIM #: "_RCBILL(1)_"?: ",DIR("B")="NO" W ! D ^DIR K DIR
  1.  .. ;
  1.  . ; File EOB for new claim #
  1.  . K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR")
  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=0 I RCBILL>0 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 RCCHG=1,DA(1)=RCXDA1,DA=RCXDA D CHGED(.DA,RCEOB,RCSAVE,.RCBILL)
  1.  .. S DIR(0)="E"
  1.  .. S DIR("A",1)="EEOB detail is already on file for "_RCBILL(1)_" - Exception removed",DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR
  1.  . ;
  1.  . ; Add stub rec to 361.1 if not there
  1.  . I RCBILL>0 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.  .. S DIR("A")="EA",DIR("A",1)="Error - EEOB detail not added to IB for bill "_RCBILL(1),DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR
  1.  . ;
  1.  . ; Update EOB in file 361.1
  1.  . ; Call needs ^TMP arrays: $J,"RCDPEOB","HDR" and $J,"RCDP-EOB"
  1.  . I RCEOB>0 D
  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.  . S RCCHG=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,.RCBILL)
  1.  . S DIE="^RCY(344.4,"_DA(1)_",1,",DR="1///@" D ^DIE
  1.  . D ^DIE
  1.  . W !!,"EEOB Filed. "_$S(RCBILL>0:"Its detail may be viewed using Third Party Joint Inquiry.",1:"")
  1.  . ; Check if auto-post candidate
  1.  . N AUTOPOST
  1.  . S AUTOPOST=$$AUTOCHK2^RCDPEAP1(RCXDA1,0) ; added parameter - PRCA*4.5*321
  1.  . I AUTOPOST D
  1.  .. D SETSTA^RCDPEAP(RCXDA1,0,"Exceptions: Marked as Auto-Post Candidate")
  1.  .. W !,"ERA has been successfully Marked as an Auto-Post CANDIDATE"
  1.  . I 'AUTOPOST D
  1.  .. D AUDITLOG^RCDPEAP(RCXDA1,"","Exceptions: Not Marked as Auto-Post Candidate-"_$P(AUTOPOST,U,2))
  1.  .. W !,"ERA was NOT Marked as an Auto-Post CANDIDATE - ",$P(AUTOPOST,U,2)
  1.  . ;
  1.  . K DIR
  1.  . S DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)="EA"
  1.  . D ^DIR K DIR
  1.  . S VALMBG=1
  1.  ;
  1. EDITNQ I $G(RCCHG) D BLD^RCDPEX2
  1.  K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR"),^TMP("RCDPERR-EOB",$J)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. CHGED(DA,RCEOB,RCSAVE,RCBILL) ;  Update Invalid Bill # 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.  ; RCBILL = Array containing Bill Information
  1.  N DIE,DR,X,Y,INVBILL
  1.  S INVBILL="@" I +$G(RCBILL)=0 S INVBILL=$G(RCBILL(1))
  1.  S DIE="^RCY(344.4,"_DA(1)_",1,",DR=".05///"_INVBILL_";.02////"_RCEOB_";.13////1"_$S(RCSAVE'="":";.17////"_RCSAVE,1:"")_";.07///@" D ^DIE
  1.  Q
  1.  ;
  1. EDITRXC ; Edit pharmacy comment - PRCA*4.5*298
  1.  N DA,DIC,DIE,DIR,DR,Q,Q0,RC,RC0,RCBILL,RCDA,RCDSEL,RCEOB,RCSAVE,RCWARN,RCXDA,RCXDA1,X,Y
  1.  D FULL^VALM1
  1.  ; PRCA*4.5*304 - Pharmacy claim selection based coming from Exception or APAR screen 
  1.  I '$D(RCAPAR) D SEL^RCDPEX3(.RCDA)
  1.  I $D(RCAPAR) D SEL^RCDPEX3(.RCDA,1)
  1.  ;Only allow action if the selected exception has an ECME number
  1.  S RCDSEL=$O(RCDA(0)) D:RCDSEL
  1.  .N IENS,RCRXNO,RCRLSDT   ; IENS for FileMan, Rx number, Rx release date
  1.  .S IENS=$P(RCDA(RCDSEL),U,2)_","_$P(RCDA(RCDSEL),U,1)_","
  1.  .S RCRXNO=$$GET1^DIQ(344.41,IENS,.24) I RCRXNO=""  D  Q
  1.  ..W !,"Comment not allowed. This is not a pharmacy exception." D WAIT^VALM1
  1.  .;
  1.  .; IA #4701, RELEASE DATE for the prescription/fill
  1.  .S RCRLSDT=$$RXRLDT^PSOBPSUT(RCRXNO)   ; get release date
  1.  .I RCRLSDT]"" D  Q
  1.  ..W !!,"Release Date: "_$$FMTE^XLFDT(RCRLSDT)
  1.  ..W !,"Comment not allowed for Rx with Release Date." D WAIT^VALM1
  1.  .;
  1.  .;Display sequence and INVALID BILL NUMBER
  1.  .W !,"Selection #: ",RCDSEL,"     ",$$GET1^DIQ(344.41,IENS,.05)
  1.  .;Allow edit of pharmacy comment
  1.  .S DIE="^RCY(344.4,"_$P(RCDA(RCDSEL),U,1)_",1,",DA=$P(RCDA(RCDSEL),U,2),DA(1)=$P(RCDA(RCDSEL),U,1),DR="9.01Comment" D ^DIE Q:$D(DUOUT)!$D(DTOUT)
  1.  .D WAIT^VALM1,BLD^RCDPEX2
  1.  ;
  1.  K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR"),^TMP("RCDPERR-EOB",$J)
  1.  S VALMBCK="R"
  1.  Q