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

RCDMBWLA.m

Go to the documentation of this file.
  1. RCDMBWLA ;WISC/RFJ-diagnostic measures workload report (build it) (Cont.) ;1 Jan 01
  1. ;;4.5;Accounts Receivable;**167,171**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. RECTYP ; screen on receivable type
  1. I ($P(RCDATA2,"^",8)'="")&($P(RCDATA2,"^",8)'=5) D
  1. . S RCIFSTAT=RCIFSTAT_"I RCRECTYP="_$P(RCDATA2,"^",8)_" "
  1. . S RCIFDESC=RCIFDESC_"[RECEIVABLE TYPE equals "_$S($P(RCDATA2,"^",8)=1:"INPATIENT",$P(RCDATA2,"^",8)=2:"OUTPATIENT",$P(RCDATA2,"^",8)=3:"PROSTHETICS",$P(RCDATA2,"^",8)=4:"PHARMACY REFILL",$P(RCDATA2,"^",8)=5:"ALL RECEIVABLES")_"]"
  1. Q
  1. ;
  1. ;
  1. BUILDIF ; build if statement by clerk
  1. S ^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN,"IF")=RCIFSTAT
  1. S ^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN,"DESC")=RCIFDESC
  1. Q
  1. ;
  1. ;
  1. PAYDAYS(RCBILLDA) ; return number of days since last payment
  1. N DATA1,DAYS,RCDATE,RCTRANDA
  1. ; loop all transactions in reverse order until you find last payment
  1. S RCDATE=0
  1. S RCTRANDA=99999999999 F S RCTRANDA=$O(^PRCA(433,"C",RCBILLDA,RCTRANDA),-1) Q:'RCTRANDA D I RCDATE Q
  1. . S DATA1=$G(^PRCA(433,RCTRANDA,1))
  1. . ; not a payment transaction
  1. . I $P(DATA1,"^",2)'=2,$P(DATA1,"^",2)'=34 Q
  1. . ; get the transaction date
  1. . S RCDATE=+$P($P(DATA1,"^",9),".")
  1. ;
  1. ; if payment not found, use date bill activated
  1. ; if there is a problem with AR and the bill does not have an
  1. ; activation date, use default 1/1/1990
  1. I 'RCDATE S RCDATE=+$P($P($G(^PRCA(430,RCBILLDA,6)),"^",21),".") I 'RCDATE S RCDATE=2900101
  1. ;
  1. ; calculate the number of days from today
  1. S DAYS=$$FMDIFF^XLFDT(DT,RCDATE)
  1. Q DAYS
  1. ;
  1. ;
  1. TRANDAYS(RCBILLDA) ; return number of days since last transaction
  1. N DAYS,RCDATE,RCTRANDA
  1. ; get the last transaction date
  1. S RCTRANDA=+$O(^PRCA(433,"C",RCBILLDA,999999999999),-1)
  1. ; get the transaction date
  1. S RCDATE=+$P($P($G(^PRCA(433,RCTRANDA,1)),"^",9),".")
  1. ;
  1. ; if transaction not found, use date bill activated
  1. ; if there is a problem with AR and the bill does not have an
  1. ; activation date, use default 1/1/1990
  1. I 'RCDATE S RCDATE=+$P($P($G(^PRCA(430,RCBILLDA,6)),"^",21),".") I 'RCDATE S RCDATE=2900101
  1. ;
  1. ; calculate the number of days from today
  1. S DAYS=$$FMDIFF^XLFDT(DT,RCDATE)
  1. Q DAYS
  1. ;
  1. PTNAM(RCBILLDA) ; return patient name if third party
  1. S (RCPTNAM,RCSSN)=""
  1. N IBFOTP,IBBCAT,IBZ
  1. S IBBCAT=$P(RCDATA0,"^",2) Q:'IBBCAT "^"
  1. S IBFOTP=$$CATTYP^IBJD1(IBBCAT)
  1. I IBFOTP="T" D
  1. . I '$D(^DGCR(399,RCBILLDA,0)) Q
  1. . S IBZ=^DGCR(399,RCBILLDA,0),DFN=+$P(IBZ,"^",2)
  1. . D DEM^VADPT S RCPTNAM=VADM(1),RCSSN=+VADM(2)
  1. Q (RCPTNAM_"^"_RCSSN)
  1. ;
  1. LOOP ; loop all active bills and put them into the assignment list
  1. N RCPTNAM,RCSSN,RCX,RCRECTYP,RCY,RCCLDAT0
  1. S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"AC",16,RCBILLDA)) Q:'RCBILLDA D
  1. . ; get the data from the bill file
  1. . S RCDATA0=$G(^PRCA(430,RCBILLDA,0)) I RCDATA0="" Q
  1. . S RCDATA6=$G(^PRCA(430,RCBILLDA,6)) S RCRC=$P(RCDATA6,"^",4)
  1. . S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
  1. . S RCBALANC=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)
  1. . ; get the data for the debtor
  1. . K RCDPDATA
  1. . D DIQ340^RCDPAPLM(+$P(RCDATA0,"^",9),.01)
  1. . S RCNAME=$G(RCDPDATA(340,+$P(RCDATA0,"^",9),.01,"E")) I RCNAME="" S RCNAME=" "
  1. . S RCDEBT=$G(RCDPDATA(340,+$P(RCDATA0,"^",9),.01,"I"))
  1. . ; get the patient name and SSN if third party bill
  1. . S RCY=$$PTNAM^RCDMBWLA(RCBILLDA)
  1. . S RCPTNAM=$P(RCY,"^"),RCSSN=$P(RCY,"^",2)
  1. . ; get the ssn-first party
  1. . I $G(RCDPDATA(340,+$P(RCDATA0,"^",9),.01,"I"))["DPT" S RCSSN=$P($G(^DPT(+$G(RCDPDATA(340,+$P(RCDATA0,"^",9),.01,"I")),0)),"^",9)
  1. . S RCSSN=$E($E(RCSSN,6,9)_" ",1,4)
  1. . ; test for date of death
  1. . S RCFDEATH=0
  1. . I $G(RCDPDATA(340,+$P(RCDATA0,"^",9),.01,"I"))["DPT(",$G(^DPT(+$G(RCDPDATA(340,+$P(RCDATA0,"^",9),.01,"I")),.35)) S RCFDEATH=1
  1. . ; get the receivable type
  1. . S RCCLDAT0=$G(^DGCR(399,RCBILLDA,0))
  1. . S RCX=$$BTYP^IBCOIVM1(RCBILLDA,RCCLDAT0)
  1. . S RCRECTYP=$S(RCX="I":1,RCX="O":2,RCX="P":3,RCX="R":4,1:"")
  1. . ;
  1. . ; loop assignments and see if they should appear on the clerks list
  1. . S RCCLERK=0 F S RCCLERK=$O(^TMP("RCDMBWLR",$J,RCCLERK)) Q:'RCCLERK D
  1. . . S RCASSIGN=0 F S RCASSIGN=$O(^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN)) Q:'RCASSIGN D
  1. . . . S RCIFSTAT=^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN,"IF")
  1. . . . X RCIFSTAT
  1. . . . I $T D
  1. . . . . I $D(^TMP($J,RCCLERK,RCBILLDA)) Q
  1. . . . . S RCDEBTDA=+$P(RCDATA0,"^",9)
  1. . . . . S ^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN,"IF",$E(RCNAME,1,30),RCDEBTDA,RCBILLDA)=RCSSN_"^"_RCFDEATH_"^"_RCBALANC_"^"_RCPTNAM
  1. . . . . S ^TMP($J,RCCLERK,RCBILLDA)=""
  1. Q
  1. ;