- 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 Jan 18, 2025@02:50:28 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