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

RCXFMSC1.m

Go to the documentation of this file.
  1. RCXFMSC1 ;WISC/RFJ-fms cash receipt (cr) build lines ;1 Oct 97
  1. ;;4.5;Accounts Receivable;**90,96,106,113,135,98,173,220,338**;Mar 20, 1995;Build 69
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. FMSLINES(RECEIPDA,RCTR) ; receipda is the ien for the receipt in file 344
  1. ; return total(fund,revsrce,vendorid,fmstrantype) = dollar amount
  1. ; RCTR = 1 if extracting for a TR document, null or 0 if for CR
  1. ;
  1. N %,ACCRUAL,AMOUNT,BILLDA,CATEGORY,FMSTYPE,FUND,RECEIPT,REVSRCE
  1. N TRAN0,TRAN3,TRANDA,VENDORID,RECEFT,RCEDILB,Z
  1. ;
  1. S RCEDILB=$$EDILB^RCDPEU(RECEIPDA),RCTR=$G(RCTR)
  1. S RECEFT=$S(RCEDILB=1:1,1:"") ; EFT deposit CR doc
  1. S RECEIPT=$P($G(^RCY(344,RECEIPDA,0)),"^")
  1. I RECEIPT="" Q
  1. ;
  1. S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
  1. . S TRAN0=$G(^PRCA(433,TRANDA,0)),TRAN3=$G(^PRCA(433,TRANDA,3))
  1. . S CATEGORY=$P($G(^PRCA(430,+$P(TRAN0,"^",2),0)),"^",2)
  1. . S BILLDA=+$P(TRAN0,"^",2)
  1. . ;
  1. . ; do not send champva
  1. . I CATEGORY=29 D Q
  1. . . ;PRCA*4.5*338 get fund only if not defined
  1. . . S FUND=$$GET1^DIQ(430,BILLDA_",",203)
  1. . . I FUND="" S FUND=$$GETFUNDB^RCXFMSUF(BILLDA)
  1. . . ;end PRCA*4.5*338
  1. . . D SETTMP
  1. . ;
  1. . S ACCRUAL=$$ACCK^PRCAACC(BILLDA)
  1. . ;
  1. . ; if its not an accrual, send a detail document
  1. . I 'ACCRUAL D Q
  1. . . S FMSTYPE=$$GETTYPE(BILLDA,RCTR)
  1. . . I FMSTYPE="" S FMSTYPE="XX" ; make it reject if missing
  1. . . ; send a detail document only if there is principal
  1. . . I $P(TRAN3,"^") S DETAIL(FMSTYPE,BILLDA)=$G(DETAIL(FMSTYPE,BILLDA))+$P(TRAN3,"^")
  1. . . ; set tmp global which is used by the 215 report
  1. . . ;PRCA*4.5*338 get fund only if not defined
  1. . . S FUND=$$GET1^DIQ(430,BILLDA_",",203)
  1. . . I FUND="" S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,,RECEFT)
  1. . . ;end PRCA*4.5*338
  1. . . D SETTMP
  1. . . ;
  1. . . ; look for interest and admin charges
  1. . . ; use vendorid x for totals
  1. . . S VENDORID="MISCN"
  1. . . ; get the revenue source code for the bill
  1. . . S REVSRCE=$$CALCRSC^RCXFMSUR(BILLDA,RECEFT)
  1. . . D INTADMIN
  1. . ;
  1. . ; get the fund for the bill
  1. . ;PRCA*4.5*338 get fund only if not defined
  1. . S FUND=$$GET1^DIQ(430,BILLDA_",",203)
  1. . I FUND="" S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,,RECEFT)
  1. . ;end PRCA*4.5*338
  1. . ;
  1. . ; get the vendor id $p(2) for the bill
  1. . S VENDORID=$S(FUND=528709:"EXCFVALUE",FUND=4032:"EXCFVALUE",1:"MCCFVALUE")
  1. . ;
  1. . ; get the revenue source code for the bill
  1. . S REVSRCE=$$GET1^DIQ(430,BILLDA_",",255)
  1. . S:REVSRCE="" REVSRCE=$$GET1^DIQ(430,BILLDA_",",255.1)
  1. . S:REVSRCE="" REVSRCE=$$CALCRSC^RCXFMSUR(BILLDA) ; (as per CURRENT^RCRJRCOC)
  1. . ;
  1. . ; get the principle collected, $p(tran3,"^"), if prepayment
  1. . ; set it to 1;5 with no interest, admin, etc.
  1. . I CATEGORY=26 S TRAN3=$P($G(^PRCA(433,TRANDA,1)),"^",5)
  1. . ;
  1. . ; total principal
  1. . D TOTAL($P(TRAN3,"^"))
  1. . ;
  1. . ; set tmp for detail
  1. . D SETTMP
  1. . ;
  1. . ; check for interest collected
  1. . D INTADMIN
  1. Q
  1. ;
  1. ;
  1. INTADMIN ; check for interest and admin charges
  1. S AMOUNT=$P(TRAN3,"^",2)
  1. I AMOUNT S FUND=$$GETFUNDO^RCXFMSUF("I") D TOTAL(AMOUNT)
  1. ; check for admin collected
  1. S AMOUNT=$P(TRAN3,"^",3)
  1. I AMOUNT S FUND=$$GETFUNDO^RCXFMSUF("A") D TOTAL(AMOUNT)
  1. ; check for marshall fee collected
  1. S AMOUNT=$P(TRAN3,"^",4)
  1. I AMOUNT S FUND=$$GETFUNDO^RCXFMSUF("M") D TOTAL(AMOUNT)
  1. ; check for court cost collected
  1. S AMOUNT=$P(TRAN3,"^",5)
  1. I AMOUNT S FUND=$$GETFUNDO^RCXFMSUF("C") D TOTAL(AMOUNT)
  1. Q
  1. ;
  1. ;
  1. TOTAL(AMOUNT) ; accumulate totals for summary document
  1. I 'AMOUNT Q
  1. ; check key elements and if null set to X's to reject
  1. I FUND="" S FUND="XXXXXX"
  1. I REVSRCE="" S REVSRCE="XXXX"
  1. I VENDORID="" S VENDORID="XXXXX"
  1. ;
  1. S TOTAL(FUND,REVSRCE,VENDORID)=$G(TOTAL(FUND,REVSRCE,VENDORID))+AMOUNT
  1. Q
  1. ;
  1. ;
  1. SETTMP ; set the tmp global for detailed data by bill
  1. ; the tmp global is used by the 215 report (rcy215a)
  1. I FUND="" S FUND="XXXXXX"
  1. ;
  1. S %=$G(^TMP($J,"RCFMSCR",FUND,BILLDA))
  1. S $P(%,"^",1)=$P(%,"^",1)+$P(TRAN3,"^",1) ; principal
  1. S $P(%,"^",2)=$P(%,"^",2)+$P(TRAN3,"^",2) ; interest
  1. S $P(%,"^",3)=$P(%,"^",3)+$P(TRAN3,"^",3) ; admin
  1. S $P(%,"^",4)=$P(%,"^",4)+$P(TRAN3,"^",4) ; marshal fee
  1. S $P(%,"^",5)=$P(%,"^",5)+$P(TRAN3,"^",5) ; court cost
  1. S ^TMP($J,"RCFMSCR",FUND,BILLDA)=%
  1. Q
  1. ;
  1. ;
  1. GETTYPE(BILLDA,RCTR) ; return a bills fms transaction type (which goes on the CRA code
  1. ; sheet) from the field 259 refund/reimbursement in file 430.
  1. ; If RCTR = 1, return TR code, otherwise return CR code
  1. N REFUND
  1. S RCTR=$S($G(RCTR):7,1:3) ; CR code is in piece 3 of data, TR is in pc 7
  1. S REFUND=$$RECTYP^PRCAFUT(BILLDA)
  1. I REFUND<0 S REFUND=""
  1. I $L(REFUND)=1 S REFUND="0"_REFUND
  1. ; this call gets the transaction type from file 347.4
  1. S REFUND=$$DTYPE^PRCAFBD1(REFUND)
  1. I REFUND<0 S REFUND=""
  1. Q $S($P(REFUND,"^",RCTR)'="":$P(REFUND,"^",RCTR),1:REFUND)
  1. ;
  1. ;
  1. LINE(BILLDA) ;
  1. ;returns FMS line number
  1. N X
  1. S X=$P($G(^PRCA(430,BILLDA,11)),"^",4)
  1. I X="" S X="001"
  1. Q X