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

RCBEADJ1.m

Go to the documentation of this file.
  1. RCBEADJ1 ;ALB/PJH - PENDING PAYMENTS ;24-FEB-03
  1. ;;4.5;Accounts Receivable;**173,276,321,326,332**;Mar 20, 1995;Build 40
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. WARN(RCBILLDA) ; Display warning if pending payments exist EP ^RCBEADJ
  1. ; Input - RCBILLDA - Pointer #430 - required
  1. ; Output - None - output to screen only
  1. ;
  1. ; Check for valid input
  1. Q:'$G(RCBILLDA)
  1. ;
  1. N DEBTOR,RCAMT,RCEOB,RCERA,RCLINE,RCPAID,RCPEND,RCRCPT,RCRCPTN,RCSUB,RCTOT,RCTRACE,RCTRANDA,RCZ,RCZL
  1. ; Set DEBTOR value
  1. S DEBTOR=RCBILLDA_";PRCA(430,"
  1. ; Check for unprocessed receipts
  1. S RCPEND=$$PENDPAY^RCDPURET(DEBTOR)
  1. ; Extract receipt numbers and amounts paid on individual lines for pending receipts
  1. S RCRCPT=0
  1. F S RCRCPT=$O(^TMP($J,"RCDPUREC","PP",RCRCPT)) Q:'RCRCPT D
  1. . S RCRCPTN=$$GET1^DIQ(344,RCRCPT_",",.01) Q:RCRCPTN=""
  1. . S RCPEND("R",RCRCPTN)=0
  1. . S RCTRANDA=0
  1. . F S RCTRANDA=$O(^TMP($J,"RCDPUREC","PP",RCRCPT,RCTRANDA)) Q:'RCTRANDA D
  1. . . S RCAMT=$P($G(^TMP($J,"RCDPUREC","PP",RCRCPT,RCTRANDA)),U,4) Q:+RCAMT=0
  1. . . ; Save paid amount for this claim on this receipt
  1. . . S RCPEND("R",RCRCPTN)=RCPEND("R",RCRCPTN)+RCAMT
  1. . . ; Get trace number for ERA
  1. . . S RCERA=$$GET1^DIQ(344,RCRCPT_",",.18,"I")
  1. . . S RCTRACE=$S(RCERA:$$GET1^DIQ(344.4,RCERA_",",.02,"I"),1:"No Trace Number")
  1. . . ; Save trace number
  1. . . S RCPEND("R",RCRCPTN,"T")=RCTRACE
  1. ; Clear ^TMP array returned by $$PENDPAY
  1. K ^TMP($J,"RCDPUREC","PP")
  1. ; Find EEOB's for this claim
  1. S RCEOB=0
  1. F S RCEOB=$O(^IBM(361.1,"B",RCBILLDA,RCEOB)) Q:'RCEOB D
  1. . ;Find ERAs for this EOB - may be multiple
  1. . S RCERA=0
  1. . F S RCERA=$O(^RCY(344.4,"ADET",RCEOB,RCERA)) Q:'RCERA D
  1. . . ; Ignore ERA which already has a receipt - processed or otherwise
  1. . . I $$GET1^DIQ(344.4,RCERA_",",.08,"I") Q
  1. . . ; Get ERA lines for this EOB
  1. . . S RCLINE=0,RCTOT=0
  1. . . F S RCLINE=$O(^RCY(344.4,"ADET",RCEOB,RCERA,RCLINE)) Q:'RCLINE D
  1. . . . ; Get paid amount from ERA line
  1. . . . S RCPAID=$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03)
  1. . . . ; Ignore zero lines
  1. . . . Q:'RCPAID
  1. . . . ; If no scratchpad use paid amount from ERA - does not take into account ERA level adjustments
  1. . . . I '$D(^RCY(344.49,RCERA)) S RCTOT=RCTOT+RCPAID Q
  1. . . . ; Find ERA line in scratchpad
  1. . . . S RCZL=$$FIND(RCERA,RCLINE) Q:'RCZL
  1. . . . ; If scratchpad exists scan B index for split lines(344.49 is DINUM with 344.4)
  1. . . . S RCSUB=RCZL
  1. . . . F S RCSUB=$O(^RCY(344.49,RCERA,1,"B",RCSUB)) Q:(RCSUB\1)'=RCZL D
  1. . . . . S RCZ=$O(^RCY(344.49,RCERA,1,"B",RCSUB,"")) Q:'RCZ
  1. . . . . ; Check AR BILL is for this claim
  1. . . . . Q:$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.07,"I")'=RCBILLDA
  1. . . . . ; Add AMOUNT TO POST ON RECEIPT to pending total - should resolve reversals
  1. . . . . S RCTOT=RCTOT+$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.03)
  1. . . ; If claim total for the ERA is zero do not save trace number and paid amount
  1. . . Q:RCTOT=0
  1. . . ; Otherwise get trace number
  1. . . S RCTRACE=$$GET1^DIQ(344.4,RCERA_",",.02,"I")
  1. . . S RCPEND=RCPEND+RCTOT
  1. . . ; Save totals by ERA
  1. . . S RCPEND("E",RCERA)=RCTOT,RCPEND("E",RCERA,"T")=$S(RCTRACE'="":RCTRACE,1:"No Trace Number")
  1. Q:'RCPEND
  1. W !!,"Warning - Pending Payments of $"_$J(RCPEND,0,2)_" exist."
  1. ; List unprocessed receipts
  1. S RCRCPTN=""
  1. F S RCRCPTN=$O(RCPEND("R",RCRCPTN)) Q:RCRCPTN="" W !,"Rcpt: ",RCRCPTN,?16,$J("$"_$J(RCPEND("R",RCRCPTN),0,2),11),?29,$G(RCPEND("R",RCRCPTN,"T"))
  1. ; List unprocessed EOB
  1. S RCERA=""
  1. F S RCERA=$O(RCPEND("E",RCERA)) Q:'RCERA W !,"ERA : ",RCERA,?16,$J("$"_$J(RCPEND("E",RCERA),0,2),11),?29,$G(RCPEND("E",RCERA,"T"))
  1. Q
  1. ;
  1. FIND(RCERA,RCLINE) ; Search ORIGINAL ERA SEQUENCES for this line
  1. ; Input RCERA - Scratchpad IEN
  1. ; RCLINE - ERA line to find
  1. ; Output RET - Scratchpad line number
  1. ;
  1. N DA,ORIG,RCSUB,RET
  1. S RCSUB=0,RET=0
  1. F S RCSUB=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB)) Q:RET Q:'RCSUB D
  1. . S DA=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB,"")) Q:'DA
  1. . ;Get Original sequences
  1. . S ORIG=$$GET1^DIQ(344.491,DA_","_RCERA_",",.09) Q:ORIG=""
  1. . ;Check if scratchpad line is for original ERA line
  1. . S ORIG=","_ORIG_","
  1. . S:$F(ORIG,","_RCLINE_",") RET=RCSUB
  1. Q RET