RCXFMSC1 ;WISC/RFJ-fms cash receipt (cr) build lines ;1 Oct 97
;;4.5;Accounts Receivable;**90,96,106,113,135,98,173,220,338**;Mar 20, 1995;Build 69
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
FMSLINES(RECEIPDA,RCTR) ; receipda is the ien for the receipt in file 344
; return total(fund,revsrce,vendorid,fmstrantype) = dollar amount
; RCTR = 1 if extracting for a TR document, null or 0 if for CR
;
N %,ACCRUAL,AMOUNT,BILLDA,CATEGORY,FMSTYPE,FUND,RECEIPT,REVSRCE
N TRAN0,TRAN3,TRANDA,VENDORID,RECEFT,RCEDILB,Z
;
S RCEDILB=$$EDILB^RCDPEU(RECEIPDA),RCTR=$G(RCTR)
S RECEFT=$S(RCEDILB=1:1,1:"") ; EFT deposit CR doc
S RECEIPT=$P($G(^RCY(344,RECEIPDA,0)),"^")
I RECEIPT="" Q
;
S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
. S TRAN0=$G(^PRCA(433,TRANDA,0)),TRAN3=$G(^PRCA(433,TRANDA,3))
. S CATEGORY=$P($G(^PRCA(430,+$P(TRAN0,"^",2),0)),"^",2)
. S BILLDA=+$P(TRAN0,"^",2)
. ;
. ; do not send champva
. I CATEGORY=29 D Q
. . ;PRCA*4.5*338 get fund only if not defined
. . S FUND=$$GET1^DIQ(430,BILLDA_",",203)
. . I FUND="" S FUND=$$GETFUNDB^RCXFMSUF(BILLDA)
. . ;end PRCA*4.5*338
. . D SETTMP
. ;
. S ACCRUAL=$$ACCK^PRCAACC(BILLDA)
. ;
. ; if its not an accrual, send a detail document
. I 'ACCRUAL D Q
. . S FMSTYPE=$$GETTYPE(BILLDA,RCTR)
. . I FMSTYPE="" S FMSTYPE="XX" ; make it reject if missing
. . ; send a detail document only if there is principal
. . I $P(TRAN3,"^") S DETAIL(FMSTYPE,BILLDA)=$G(DETAIL(FMSTYPE,BILLDA))+$P(TRAN3,"^")
. . ; set tmp global which is used by the 215 report
. . ;PRCA*4.5*338 get fund only if not defined
. . S FUND=$$GET1^DIQ(430,BILLDA_",",203)
. . I FUND="" S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,,RECEFT)
. . ;end PRCA*4.5*338
. . D SETTMP
. . ;
. . ; look for interest and admin charges
. . ; use vendorid x for totals
. . S VENDORID="MISCN"
. . ; get the revenue source code for the bill
. . S REVSRCE=$$CALCRSC^RCXFMSUR(BILLDA,RECEFT)
. . D INTADMIN
. ;
. ; get the fund for the bill
. ;PRCA*4.5*338 get fund only if not defined
. S FUND=$$GET1^DIQ(430,BILLDA_",",203)
. I FUND="" S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,,RECEFT)
. ;end PRCA*4.5*338
. ;
. ; get the vendor id $p(2) for the bill
. S VENDORID=$S(FUND=528709:"EXCFVALUE",FUND=4032:"EXCFVALUE",1:"MCCFVALUE")
. ;
. ; get the revenue source code for the bill
. S REVSRCE=$$GET1^DIQ(430,BILLDA_",",255)
. S:REVSRCE="" REVSRCE=$$GET1^DIQ(430,BILLDA_",",255.1)
. S:REVSRCE="" REVSRCE=$$CALCRSC^RCXFMSUR(BILLDA) ; (as per CURRENT^RCRJRCOC)
. ;
. ; get the principle collected, $p(tran3,"^"), if prepayment
. ; set it to 1;5 with no interest, admin, etc.
. I CATEGORY=26 S TRAN3=$P($G(^PRCA(433,TRANDA,1)),"^",5)
. ;
. ; total principal
. D TOTAL($P(TRAN3,"^"))
. ;
. ; set tmp for detail
. D SETTMP
. ;
. ; check for interest collected
. D INTADMIN
Q
;
;
INTADMIN ; check for interest and admin charges
S AMOUNT=$P(TRAN3,"^",2)
I AMOUNT S FUND=$$GETFUNDO^RCXFMSUF("I") D TOTAL(AMOUNT)
; check for admin collected
S AMOUNT=$P(TRAN3,"^",3)
I AMOUNT S FUND=$$GETFUNDO^RCXFMSUF("A") D TOTAL(AMOUNT)
; check for marshall fee collected
S AMOUNT=$P(TRAN3,"^",4)
I AMOUNT S FUND=$$GETFUNDO^RCXFMSUF("M") D TOTAL(AMOUNT)
; check for court cost collected
S AMOUNT=$P(TRAN3,"^",5)
I AMOUNT S FUND=$$GETFUNDO^RCXFMSUF("C") D TOTAL(AMOUNT)
Q
;
;
TOTAL(AMOUNT) ; accumulate totals for summary document
I 'AMOUNT Q
; check key elements and if null set to X's to reject
I FUND="" S FUND="XXXXXX"
I REVSRCE="" S REVSRCE="XXXX"
I VENDORID="" S VENDORID="XXXXX"
;
S TOTAL(FUND,REVSRCE,VENDORID)=$G(TOTAL(FUND,REVSRCE,VENDORID))+AMOUNT
Q
;
;
SETTMP ; set the tmp global for detailed data by bill
; the tmp global is used by the 215 report (rcy215a)
I FUND="" S FUND="XXXXXX"
;
S %=$G(^TMP($J,"RCFMSCR",FUND,BILLDA))
S $P(%,"^",1)=$P(%,"^",1)+$P(TRAN3,"^",1) ; principal
S $P(%,"^",2)=$P(%,"^",2)+$P(TRAN3,"^",2) ; interest
S $P(%,"^",3)=$P(%,"^",3)+$P(TRAN3,"^",3) ; admin
S $P(%,"^",4)=$P(%,"^",4)+$P(TRAN3,"^",4) ; marshal fee
S $P(%,"^",5)=$P(%,"^",5)+$P(TRAN3,"^",5) ; court cost
S ^TMP($J,"RCFMSCR",FUND,BILLDA)=%
Q
;
;
GETTYPE(BILLDA,RCTR) ; return a bills fms transaction type (which goes on the CRA code
; sheet) from the field 259 refund/reimbursement in file 430.
; If RCTR = 1, return TR code, otherwise return CR code
N REFUND
S RCTR=$S($G(RCTR):7,1:3) ; CR code is in piece 3 of data, TR is in pc 7
S REFUND=$$RECTYP^PRCAFUT(BILLDA)
I REFUND<0 S REFUND=""
I $L(REFUND)=1 S REFUND="0"_REFUND
; this call gets the transaction type from file 347.4
S REFUND=$$DTYPE^PRCAFBD1(REFUND)
I REFUND<0 S REFUND=""
Q $S($P(REFUND,"^",RCTR)'="":$P(REFUND,"^",RCTR),1:REFUND)
;
;
LINE(BILLDA) ;
;returns FMS line number
N X
S X=$P($G(^PRCA(430,BILLDA,11)),"^",4)
I X="" S X="001"
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXFMSC1 5187 printed Sep 11, 2024@02:09:23 Page 2
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
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
FMSLINES(RECEIPDA,RCTR) ; receipda is the ien for the receipt in file 344
+1 ; return total(fund,revsrce,vendorid,fmstrantype) = dollar amount
+2 ; RCTR = 1 if extracting for a TR document, null or 0 if for CR
+3 ;
+4 NEW %,ACCRUAL,AMOUNT,BILLDA,CATEGORY,FMSTYPE,FUND,RECEIPT,REVSRCE
+5 NEW TRAN0,TRAN3,TRANDA,VENDORID,RECEFT,RCEDILB,Z
+6 ;
+7 SET RCEDILB=$$EDILB^RCDPEU(RECEIPDA)
SET RCTR=$GET(RCTR)
+8 ; EFT deposit CR doc
SET RECEFT=$SELECT(RCEDILB=1:1,1:"")
+9 SET RECEIPT=$PIECE($GET(^RCY(344,RECEIPDA,0)),"^")
+10 IF RECEIPT=""
QUIT
+11 ;
+12 SET TRANDA=0
FOR
SET TRANDA=$ORDER(^PRCA(433,"AF",RECEIPT,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:1
+13 SET TRAN0=$GET(^PRCA(433,TRANDA,0))
SET TRAN3=$GET(^PRCA(433,TRANDA,3))
+14 SET CATEGORY=$PIECE($GET(^PRCA(430,+$PIECE(TRAN0,"^",2),0)),"^",2)
+15 SET BILLDA=+$PIECE(TRAN0,"^",2)
+16 ;
+17 ; do not send champva
+18 IF CATEGORY=29
Begin DoDot:2
+19 ;PRCA*4.5*338 get fund only if not defined
+20 SET FUND=$$GET1^DIQ(430,BILLDA_",",203)
+21 IF FUND=""
SET FUND=$$GETFUNDB^RCXFMSUF(BILLDA)
+22 ;end PRCA*4.5*338
+23 DO SETTMP
End DoDot:2
QUIT
+24 ;
+25 SET ACCRUAL=$$ACCK^PRCAACC(BILLDA)
+26 ;
+27 ; if its not an accrual, send a detail document
+28 IF 'ACCRUAL
Begin DoDot:2
+29 SET FMSTYPE=$$GETTYPE(BILLDA,RCTR)
+30 ; make it reject if missing
IF FMSTYPE=""
SET FMSTYPE="XX"
+31 ; send a detail document only if there is principal
+32 IF $PIECE(TRAN3,"^")
SET DETAIL(FMSTYPE,BILLDA)=$GET(DETAIL(FMSTYPE,BILLDA))+$PIECE(TRAN3,"^")
+33 ; set tmp global which is used by the 215 report
+34 ;PRCA*4.5*338 get fund only if not defined
+35 SET FUND=$$GET1^DIQ(430,BILLDA_",",203)
+36 IF FUND=""
SET FUND=$$GETFUNDB^RCXFMSUF(BILLDA,,RECEFT)
+37 ;end PRCA*4.5*338
+38 DO SETTMP
+39 ;
+40 ; look for interest and admin charges
+41 ; use vendorid x for totals
+42 SET VENDORID="MISCN"
+43 ; get the revenue source code for the bill
+44 SET REVSRCE=$$CALCRSC^RCXFMSUR(BILLDA,RECEFT)
+45 DO INTADMIN
End DoDot:2
QUIT
+46 ;
+47 ; get the fund for the bill
+48 ;PRCA*4.5*338 get fund only if not defined
+49 SET FUND=$$GET1^DIQ(430,BILLDA_",",203)
+50 IF FUND=""
SET FUND=$$GETFUNDB^RCXFMSUF(BILLDA,,RECEFT)
+51 ;end PRCA*4.5*338
+52 ;
+53 ; get the vendor id $p(2) for the bill
+54 SET VENDORID=$SELECT(FUND=528709:"EXCFVALUE",FUND=4032:"EXCFVALUE",1:"MCCFVALUE")
+55 ;
+56 ; get the revenue source code for the bill
+57 SET REVSRCE=$$GET1^DIQ(430,BILLDA_",",255)
+58 if REVSRCE=""
SET REVSRCE=$$GET1^DIQ(430,BILLDA_",",255.1)
+59 ; (as per CURRENT^RCRJRCOC)
if REVSRCE=""
SET REVSRCE=$$CALCRSC^RCXFMSUR(BILLDA)
+60 ;
+61 ; get the principle collected, $p(tran3,"^"), if prepayment
+62 ; set it to 1;5 with no interest, admin, etc.
+63 IF CATEGORY=26
SET TRAN3=$PIECE($GET(^PRCA(433,TRANDA,1)),"^",5)
+64 ;
+65 ; total principal
+66 DO TOTAL($PIECE(TRAN3,"^"))
+67 ;
+68 ; set tmp for detail
+69 DO SETTMP
+70 ;
+71 ; check for interest collected
+72 DO INTADMIN
End DoDot:1
+73 QUIT
+74 ;
+75 ;
INTADMIN ; check for interest and admin charges
+1 SET AMOUNT=$PIECE(TRAN3,"^",2)
+2 IF AMOUNT
SET FUND=$$GETFUNDO^RCXFMSUF("I")
DO TOTAL(AMOUNT)
+3 ; check for admin collected
+4 SET AMOUNT=$PIECE(TRAN3,"^",3)
+5 IF AMOUNT
SET FUND=$$GETFUNDO^RCXFMSUF("A")
DO TOTAL(AMOUNT)
+6 ; check for marshall fee collected
+7 SET AMOUNT=$PIECE(TRAN3,"^",4)
+8 IF AMOUNT
SET FUND=$$GETFUNDO^RCXFMSUF("M")
DO TOTAL(AMOUNT)
+9 ; check for court cost collected
+10 SET AMOUNT=$PIECE(TRAN3,"^",5)
+11 IF AMOUNT
SET FUND=$$GETFUNDO^RCXFMSUF("C")
DO TOTAL(AMOUNT)
+12 QUIT
+13 ;
+14 ;
TOTAL(AMOUNT) ; accumulate totals for summary document
+1 IF 'AMOUNT
QUIT
+2 ; check key elements and if null set to X's to reject
+3 IF FUND=""
SET FUND="XXXXXX"
+4 IF REVSRCE=""
SET REVSRCE="XXXX"
+5 IF VENDORID=""
SET VENDORID="XXXXX"
+6 ;
+7 SET TOTAL(FUND,REVSRCE,VENDORID)=$GET(TOTAL(FUND,REVSRCE,VENDORID))+AMOUNT
+8 QUIT
+9 ;
+10 ;
SETTMP ; set the tmp global for detailed data by bill
+1 ; the tmp global is used by the 215 report (rcy215a)
+2 IF FUND=""
SET FUND="XXXXXX"
+3 ;
+4 SET %=$GET(^TMP($JOB,"RCFMSCR",FUND,BILLDA))
+5 ; principal
SET $PIECE(%,"^",1)=$PIECE(%,"^",1)+$PIECE(TRAN3,"^",1)
+6 ; interest
SET $PIECE(%,"^",2)=$PIECE(%,"^",2)+$PIECE(TRAN3,"^",2)
+7 ; admin
SET $PIECE(%,"^",3)=$PIECE(%,"^",3)+$PIECE(TRAN3,"^",3)
+8 ; marshal fee
SET $PIECE(%,"^",4)=$PIECE(%,"^",4)+$PIECE(TRAN3,"^",4)
+9 ; court cost
SET $PIECE(%,"^",5)=$PIECE(%,"^",5)+$PIECE(TRAN3,"^",5)
+10 SET ^TMP($JOB,"RCFMSCR",FUND,BILLDA)=%
+11 QUIT
+12 ;
+13 ;
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.
+2 ; If RCTR = 1, return TR code, otherwise return CR code
+3 NEW REFUND
+4 ; CR code is in piece 3 of data, TR is in pc 7
SET RCTR=$SELECT($GET(RCTR):7,1:3)
+5 SET REFUND=$$RECTYP^PRCAFUT(BILLDA)
+6 IF REFUND<0
SET REFUND=""
+7 IF $LENGTH(REFUND)=1
SET REFUND="0"_REFUND
+8 ; this call gets the transaction type from file 347.4
+9 SET REFUND=$$DTYPE^PRCAFBD1(REFUND)
+10 IF REFUND<0
SET REFUND=""
+11 QUIT $SELECT($PIECE(REFUND,"^",RCTR)'="":$PIECE(REFUND,"^",RCTR),1:REFUND)
+12 ;
+13 ;
LINE(BILLDA) ;
+1 ;returns FMS line number
+2 NEW X
+3 SET X=$PIECE($GET(^PRCA(430,BILLDA,11)),"^",4)
+4 IF X=""
SET X="001"
+5 QUIT X
