Summary Table

Categories Total Count
PII 0
URL 1
DNS 1
EKL 0
IP 0
PORT 0
VsID 0
CF 0
AI 0
VPD 0
PL 0
Other 0

File Content

KIDS Distribution saved on Jun 10, 2019@14:03:39
Build 5
**KIDS**:PRCA*4.5*351^

**INSTALL NAME**
PRCA*4.5*351
"BLD",11244,0)
PRCA*4.5*351^ACCOUNTS RECEIVABLE^0^3190610^y
"BLD",11244,4,0)
^9.64PA^^
"BLD",11244,6.3)
14
"BLD",11244,"KRN",0)
^9.67PA^1.5^24
"BLD",11244,"KRN",.4,0)
.4
"BLD",11244,"KRN",.401,0)
.401
"BLD",11244,"KRN",.402,0)
.402
"BLD",11244,"KRN",.403,0)
.403
"BLD",11244,"KRN",.5,0)
.5
"BLD",11244,"KRN",.84,0)
.84
"BLD",11244,"KRN",1.5,0)
1.5
"BLD",11244,"KRN",1.6,0)
1.6
"BLD",11244,"KRN",1.61,0)
1.61
"BLD",11244,"KRN",1.62,0)
1.62
"BLD",11244,"KRN",3.6,0)
3.6
"BLD",11244,"KRN",3.8,0)
3.8
"BLD",11244,"KRN",9.2,0)
9.2
"BLD",11244,"KRN",9.8,0)
9.8
"BLD",11244,"KRN",9.8,"NM",0)
^9.68A^11^9
"BLD",11244,"KRN",9.8,"NM",2,0)
RCTCSPD^^0^B171015277
"BLD",11244,"KRN",9.8,"NM",4,0)
RCRJRDEP^^0^B68618854
"BLD",11244,"KRN",9.8,"NM",5,0)
RCDPRTP1^^0^B51135158
"BLD",11244,"KRN",9.8,"NM",6,0)
RCRJRBD^^0^B101571445
"BLD",11244,"KRN",9.8,"NM",7,0)
RCXFMSPR^^0^B59053655
"BLD",11244,"KRN",9.8,"NM",8,0)
RCXFMSUF^^0^B57862958
"BLD",11244,"KRN",9.8,"NM",9,0)
PRCABJ2^^0^B20492059
"BLD",11244,"KRN",9.8,"NM",10,0)
RCRJRCOU^^0^B143024308
"BLD",11244,"KRN",9.8,"NM",11,0)
RCRJRCOR^^0^B71863366
"BLD",11244,"KRN",9.8,"NM","B","PRCABJ2",9)

"BLD",11244,"KRN",9.8,"NM","B","RCDPRTP1",5)

"BLD",11244,"KRN",9.8,"NM","B","RCRJRBD",6)

"BLD",11244,"KRN",9.8,"NM","B","RCRJRCOR",11)

"BLD",11244,"KRN",9.8,"NM","B","RCRJRCOU",10)

"BLD",11244,"KRN",9.8,"NM","B","RCRJRDEP",4)

"BLD",11244,"KRN",9.8,"NM","B","RCTCSPD",2)

"BLD",11244,"KRN",9.8,"NM","B","RCXFMSPR",7)

"BLD",11244,"KRN",9.8,"NM","B","RCXFMSUF",8)

"BLD",11244,"KRN",19,0)
19
"BLD",11244,"KRN",19.1,0)
19.1
"BLD",11244,"KRN",101,0)
101
"BLD",11244,"KRN",409.61,0)
409.61
"BLD",11244,"KRN",771,0)
771
"BLD",11244,"KRN",779.2,0)
779.2
"BLD",11244,"KRN",870,0)
870
"BLD",11244,"KRN",8989.51,0)
8989.51
"BLD",11244,"KRN",8989.52,0)
8989.52
"BLD",11244,"KRN",8994,0)
8994
"BLD",11244,"KRN","B",.4,.4)

"BLD",11244,"KRN","B",.401,.401)

"BLD",11244,"KRN","B",.402,.402)

"BLD",11244,"KRN","B",.403,.403)

"BLD",11244,"KRN","B",.5,.5)

"BLD",11244,"KRN","B",.84,.84)

"BLD",11244,"KRN","B",1.5,1.5)

"BLD",11244,"KRN","B",1.6,1.6)

"BLD",11244,"KRN","B",1.61,1.61)

"BLD",11244,"KRN","B",1.62,1.62)

"BLD",11244,"KRN","B",3.6,3.6)

"BLD",11244,"KRN","B",3.8,3.8)

"BLD",11244,"KRN","B",9.2,9.2)

"BLD",11244,"KRN","B",9.8,9.8)

"BLD",11244,"KRN","B",19,19)

"BLD",11244,"KRN","B",19.1,19.1)

"BLD",11244,"KRN","B",101,101)

"BLD",11244,"KRN","B",409.61,409.61)

"BLD",11244,"KRN","B",771,771)

"BLD",11244,"KRN","B",779.2,779.2)

"BLD",11244,"KRN","B",870,870)

"BLD",11244,"KRN","B",8989.51,8989.51)

"BLD",11244,"KRN","B",8989.52,8989.52)

"BLD",11244,"KRN","B",8994,8994)

"BLD",11244,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",11244,"QUES",0)
^9.62^^
"BLD",11244,"REQB",0)
^9.611^4^4
"BLD",11244,"REQB",1,0)
PRCA*4.5*336^1
"BLD",11244,"REQB",2,0)
PRCA*4.5*338^1
"BLD",11244,"REQB",3,0)
PRCA*4.5*346^1
"BLD",11244,"REQB",4,0)
PRCA*4.5*339^1
"BLD",11244,"REQB","B","PRCA*4.5*336",1)

"BLD",11244,"REQB","B","PRCA*4.5*338",2)

"BLD",11244,"REQB","B","PRCA*4.5*339",4)

"BLD",11244,"REQB","B","PRCA*4.5*346",3)

"MBREQ")
0
"PKG",561,-1)
1^1
"PKG",561,0)
ACCOUNTS RECEIVABLE^PRCA^FMS
"PKG",561,22,0)
^9.49I^1^1
"PKG",561,22,1,0)
4.5^2950320^2950331
"PKG",561,22,1,"PAH",1,0)
351^3190610
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
9
"RTN","PRCABJ2")
0^9^B20492059
"RTN","PRCABJ2",1,0)
PRCABJ2 ;OIT/hrub - NIGHTLY PROCESS FOR ACCOUNTS RECEIVABLE ;31 Oct 2018 16:00:59
"RTN","PRCABJ2",2,0)
;;4.5;Accounts Receivable;**304,321,326,332,338,351**;Mar 20, 1995;Build 14
"RTN","PRCABJ2",3,0)
;Per VA Directive 6402, this routine should not be modified.
"RTN","PRCABJ2",4,0)
;
"RTN","PRCABJ2",5,0)
; read of ^DGCR(399.2 allowed by DBIA 3822
"RTN","PRCABJ2",6,0)
; refactored 17 October 2018, PRCA*4.5*332
"RTN","PRCABJ2",7,0)
Q
"RTN","PRCABJ2",8,0)
; Auto-audit Paper, Electronic, and Tricare bills if ready
"RTN","PRCABJ2",9,0)
; PRCA*4.5*332 - Whole subroutine re-written
"RTN","PRCABJ2",10,0)
ABAUDIT ;
"RTN","PRCABJ2",11,0)
; APIEN - Accounts Payable (file #430) ien (also same ien for file #399)
"RTN","PRCABJ2",12,0)
N APIEN,ARBILL,C,FLAG,J,PRCA,RTYPE ;PRCA*4.5*321, PRCA*4.5*332
"RTN","PRCABJ2",13,0)
;
"RTN","PRCABJ2",14,0)
S ARBILL("newBillIEN")=$O(^PRCA(430.3,"B","NEW BILL","")) ; New Bill IEN
"RTN","PRCABJ2",15,0)
Q:ARBILL("newBillIEN")="" ; must have the IEN for new bills
"RTN","PRCABJ2",16,0)
; Check parameters to see if audit needs to run
"RTN","PRCABJ2",17,0)
S FLAG("aaMedPaper")=$$GET1^DIQ(342,"1,",7.05,"I") ; (#7.05) AUTO-AUDIT MEDICAL PAPER BILLS [5S]
"RTN","PRCABJ2",18,0)
S FLAG("aaRxPaper")=$$GET1^DIQ(342,"1,",7.06,"I") ; (#7.06) AUTO-AUDIT RX PAPER BILLS [6S]
"RTN","PRCABJ2",19,0)
S FLAG("aaMedEDI")=$$GET1^DIQ(342,"1,",7.07,"I") ; (#7.07) AUTO-AUDIT MEDICAL EDI BILLS [7S] - PRCA*4.5*321
"RTN","PRCABJ2",20,0)
S FLAG("aaRxEDI")=$$GET1^DIQ(342,"1,",7.08,"I") ; (#7.08) AUTO-AUDIT RX EDI BILLS [8S] - PRCA*4.5*321
"RTN","PRCABJ2",21,0)
S FLAG("aaTricare")=$$GET1^DIQ(342,"1,",7.09,"I") ; (#7.09) AUTO-AUDIT TRICARE BILLS [9S] - PRCA*4.5*332
"RTN","PRCABJ2",22,0)
; quit if all auto-audit parameters are 'No'
"RTN","PRCABJ2",23,0)
Q:('FLAG("aaMedPaper"))&('FLAG("aaRxPaper"))&('FLAG("aaMedEDI"))&('FLAG("aaRxEDI"))&('FLAG("aaTricare")) ; PRCA*4.5*321
"RTN","PRCABJ2",24,0)
;
"RTN","PRCABJ2",25,0)
; RTYPE - array of RATE TYPE entries that have (#.11) BILL RESULTING FROM [11P:430.6] - PRCA*4.5*332
"RTN","PRCABJ2",26,0)
S C=0 F S C=$O(^DGCR(399.3,C)) Q:'C S J=$G(^(C,0)) S:$P(J,U,11) RTYPE(C)=J
"RTN","PRCABJ2",27,0)
; loop through new bills
"RTN","PRCABJ2",28,0)
; BILL - info for this bill
"RTN","PRCABJ2",29,0)
; PRCA - bill # and ECME info
"RTN","PRCABJ2",30,0)
; RTDGCR - used for file #399 info (except rate type)
"RTN","PRCABJ2",31,0)
S APIEN="" F S APIEN=$O(^PRCA(430,"AC",ARBILL("newBillIEN"),APIEN)) Q:'APIEN D
"RTN","PRCABJ2",32,0)
. N BILL,PRCA,RTDGCR
"RTN","PRCABJ2",33,0)
. ;
"RTN","PRCABJ2",34,0)
. S BILL("rtTyp")=$$GET1^DIQ(399,APIEN_",",.07,"I") ; (#.07) RATE TYPE [7P:399.3] - PRCA*4.5*326
"RTN","PRCABJ2",35,0)
. Q:'BILL("rtTyp") ; must have rate type
"RTN","PRCABJ2",36,0)
. Q:'$D(RTYPE(BILL("rtTyp"))) ; no auto-audit for this RATE TYPE
"RTN","PRCABJ2",37,0)
. ; BEGIN - PRCA*4.5*321
"RTN","PRCABJ2",38,0)
. Q:$$GET1^DIQ(430,APIEN_",",7,"I")="" ; quit if no (#7) PATIENT [7P:2]
"RTN","PRCABJ2",39,0)
. Q:$$GET1^DIQ(430,APIEN_",",9,"I")="" ; quit if no (#9) DEBTOR [9P:340]
"RTN","PRCABJ2",40,0)
. Q:$$GET1^DIQ(430,APIEN_",",239,"I")="" ; quit if no (#239) INSURED NAME [1F]
"RTN","PRCABJ2",41,0)
. Q:$$GET1^DIQ(430,APIEN_",",243,"I")="" ; quit if no (#243) GROUP NAME [5F]
"RTN","PRCABJ2",42,0)
. Q:$$GET1^DIQ(430,APIEN_",",244,"I")="" ; quit if no (#244) GROUP NUMBER [6F]
"RTN","PRCABJ2",43,0)
. Q:$$BILLREJ^PRCAUDT(APIEN) ; PRCA*4.5*321 - claim has reject messages, do not audit
"RTN","PRCABJ2",44,0)
. ;
"RTN","PRCABJ2",45,0)
. S RTDGCR("type")=$$GET1^DIQ(399,APIEN_",",.07,"E") ; (#.07) RATE TYPE [7P:399.3] (IA 4118)
"RTN","PRCABJ2",46,0)
. S RTDGCR("paper")=$$GET1^DIQ(399,APIEN_",",27,"I") ; (#.27) BILL CHARGE TYPE [27S] (ICR 3820)
"RTN","PRCABJ2",47,0)
. S BILL("audit?")=0 ; Boolean flag, need to audit bill?
"RTN","PRCABJ2",48,0)
. S BILL("doneCheck?")=0 ; Boolean flag, done checking?
"RTN","PRCABJ2",49,0)
. ; Get Bill number to check if it's a Pharmacy bill
"RTN","PRCABJ2",50,0)
. S PRCA("bill#")=$$GET1^DIQ(430,APIEN_",",.01,"I") ; (#.01) BILL NO. [1F]
"RTN","PRCABJ2",51,0)
. S PRCA("ecme#")=$$GETECME^RCDPENR1(APIEN) ; ECME# from the bill
"RTN","PRCABJ2",52,0)
. ;
"RTN","PRCABJ2",53,0)
. I PRCA("ecme#")'="" D ; has ECME#, check pharmacy flags
"RTN","PRCABJ2",54,0)
.. I RTDGCR("paper"),'FLAG("aaRxPaper") S BILL("doneCheck?")=1 Q ; Skip paper bill if No auto-audit
"RTN","PRCABJ2",55,0)
.. I 'RTDGCR("paper"),'FLAG("aaRxEDI") S BILL("doneCheck?")=1 Q ; Skip EDI bill if No auto-audit
"RTN","PRCABJ2",56,0)
.. S BILL("audit?")="1^pharmacy" ; audit this pharmacy bill
"RTN","PRCABJ2",57,0)
. ;
"RTN","PRCABJ2",58,0)
. I BILL("audit?") D AUDITX^PRCAUDT(APIEN) Q ; audit pharmacy bill, continue loop
"RTN","PRCABJ2",59,0)
. Q:BILL("doneCheck?") ; done checking, continue loop through bills
"RTN","PRCABJ2",60,0)
. ;
"RTN","PRCABJ2",61,0)
. I RTDGCR("type")["TRICARE" D
"RTN","PRCABJ2",62,0)
.. I FLAG("aaTricare") S BILL("audit?")="1^Tricare" ; audit this Tricare bill
"RTN","PRCABJ2",63,0)
.. S BILL("doneCheck?")=1
"RTN","PRCABJ2",64,0)
. I BILL("audit?") D AUDITX^PRCAUDT(APIEN) Q ; audit Tricare bill, continue loop
"RTN","PRCABJ2",65,0)
. Q:BILL("doneCheck?") ; done checking, continue loop through bills
"RTN","PRCABJ2",66,0)
. D ; medical bill, check medical flags
"RTN","PRCABJ2",67,0)
.. I RTDGCR("paper"),'FLAG("aaMedPaper") S BILL("doneCheck?")=1 Q ; Skip paper bill if No auto-audit
"RTN","PRCABJ2",68,0)
.. I 'RTDGCR("paper"),'FLAG("aaMedEDI") S BILL("doneCheck?")=1 Q ; Skip EDI bill if No auto-audit
"RTN","PRCABJ2",69,0)
.. S BILL("audit?")="1^medical" ; audit this medical bill
"RTN","PRCABJ2",70,0)
. Q:BILL("doneCheck?") ; no auto-audit for medical bill
"RTN","PRCABJ2",71,0)
. ; passed medical checks call auto-audit for this Bill
"RTN","PRCABJ2",72,0)
. I BILL("audit?") D AUDITX^PRCAUDT(APIEN)
"RTN","PRCABJ2",73,0)
;
"RTN","PRCABJ2",74,0)
Q
"RTN","PRCABJ2",75,0)
;
"RTN","RCDPRTP1")
0^5^B51135158
"RTN","RCDPRTP1",1,0)
RCDPRTP1 ;ALB/LDB - CLAIMS MATCHING REPORT (PRINT) ;1/26/01 2:56 PM
"RTN","RCDPRTP1",2,0)
;;4.5;Accounts Receivable;**151,169,276,284,315,339,351**;Mar 20, 1995;Build 14
"RTN","RCDPRTP1",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","RCDPRTP1",4,0)
;
"RTN","RCDPRTP1",5,0)
EN ; Entry point to print the Claims Matching Report.
"RTN","RCDPRTP1",6,0)
N %,DATEDIS1,DATEDIS2,NOW,PG,RCBILL,RCAMT,RCAMT1,RCIBDAT,RCIBFN,RCNAM,RCNAM1,RCNO,RCNOW,RCDLINE,RCLINE,RCPHIT
"RTN","RCDPRTP1",7,0)
; PRCA*4.5*284 - Remove RCPT 'new' as this is the receipt # from user entry
"RTN","RCDPRTP1",8,0)
N RCQ,RCSSN,RCSTAT,RCTP,X,Y,RCLPFLG
"RTN","RCDPRTP1",9,0)
;
"RTN","RCDPRTP1",10,0)
; - initialize report header variables
"RTN","RCDPRTP1",11,0)
S PG=0
"RTN","RCDPRTP1",12,0)
Q:RCQUIT
"RTN","RCDPRTP1",13,0)
I RCSORT'=2,(RCSORT'=4) D
"RTN","RCDPRTP1",14,0)
.S Y=$P(DATESTRT,".") D DD^%DT S DATEDIS1=Y
"RTN","RCDPRTP1",15,0)
.S Y=$P(DATEEND,".") D DD^%DT S DATEDIS2=Y
"RTN","RCDPRTP1",16,0)
D NOW^%DTC S Y=% D DD^%DT S RCNOW=$E(Y,1,18)
"RTN","RCDPRTP1",17,0)
S RCDLINE=$TR($J("",80)," ","-")
"RTN","RCDPRTP1",18,0)
S RCLINE=$TR($J("",80)," ","*")
"RTN","RCDPRTP1",19,0)
;
"RTN","RCDPRTP1",20,0)
; - main report loop
"RTN","RCDPRTP1",21,0)
K ^TMP($J)
"RTN","RCDPRTP1",22,0)
;
"RTN","RCDPRTP1",23,0)
I 'RCEXCEL D HDR ; initial header
"RTN","RCDPRTP1",24,0)
S RCNO=0 ; flag to indicate at least one matching claim
"RTN","RCDPRTP1",25,0)
;
"RTN","RCDPRTP1",26,0)
S RCNAM="" F S RCNAM=$O(^TMP("RCDPRTPB",$J,RCNAM)) Q:RCNAM=""!$G(RCQ) D
"RTN","RCDPRTP1",27,0)
.S RCBILL=0 F S RCBILL=$O(^TMP("RCDPRTPB",$J,RCNAM,RCBILL)) Q:'RCBILL!$G(RCQ) D
"RTN","RCDPRTP1",28,0)
..S RCPHIT=0 ; flag that requires patient info to print
"RTN","RCDPRTP1",29,0)
..D PROC ; process a single third party bill
"RTN","RCDPRTP1",30,0)
..K ^TMP("IBRBT",$J),^TMP("IBRBF",$J)
"RTN","RCDPRTP1",31,0)
;
"RTN","RCDPRTP1",32,0)
I $G(RCQ) G ENQ
"RTN","RCDPRTP1",33,0)
;
"RTN","RCDPRTP1",34,0)
I $O(^TMP("RCDPRTPB",$J,0))="" W !!,?18,"No matching debts." Q
"RTN","RCDPRTP1",35,0)
;I 'RCNO W !!,?18,"No matching debts."
"RTN","RCDPRTP1",36,0)
ENQ ;
"RTN","RCDPRTP1",37,0)
Q
"RTN","RCDPRTP1",38,0)
;
"RTN","RCDPRTP1",39,0)
;
"RTN","RCDPRTP1",40,0)
PROC ; Process each third party bill for a patient.
"RTN","RCDPRTP1",41,0)
D RELBILL^IBRFN(RCBILL)
"RTN","RCDPRTP1",42,0)
S RCQUIT=0 ;added for care type check
"RTN","RCDPRTP1",43,0)
;Add code to check ^TMP("IBRBT",$J -------------------------------------------------------------------------------for third party charges
"RTN","RCDPRTP1",44,0)
I $D(RCTYPE)>1,$D(^TMP("IBRBT",$J)) N J S J=0 F S J=$O(^TMP("IBRBT",$J,RCBILL,J)) Q:'J D
"RTN","RCDPRTP1",45,0)
. S RCTYP=$$TYP^IBRFN(J),RCTYP=$S(RCTYP="":-1,RCTYP="PR":"P",RCTYP="PH":"R",1:RCTYP)
"RTN","RCDPRTP1",46,0)
. I '$D(RCTYPE(RCTYP)) K ^TMP("IBRBT",$J,RCBILL,J) ; Verify that the type is one of the selected type, if not delete the ^TMP global node for that claim
"RTN","RCDPRTP1",47,0)
; - quit if there are no associated first party bills
"RTN","RCDPRTP1",48,0)
I '$O(^TMP("IBRBF",$J,0)) K ^TMP("RCDPRTPB",$J,RCNAM,RCBILL) G PROCQ
"RTN","RCDPRTP1",49,0)
;
"RTN","RCDPRTP1",50,0)
S (RCAMT(0),RCAMT(1))=0
"RTN","RCDPRTP1",51,0)
S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:'RCTP(0) S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:'RCTP(1) S ^TMP($J,"IBRBF",RCTP(1),RCTP(0))=""
"RTN","RCDPRTP1",52,0)
; PRCA*4.5*284 - Change typo of RCPT(0)=0 to RCTP(0)=0
"RTN","RCDPRTP1",53,0)
S RCTP(0)=0 F S RCTP(0)=$O(^TMP($J,"IBRBF",RCTP(0))) Q:'RCTP(0) S RCTP(1)=0 F S RCTP(1)=$O(^TMP($J,"IBRBF",RCTP(0),RCTP(1))) Q:'RCTP(1) D
"RTN","RCDPRTP1",54,0)
.I RCTP(1)=RCBILL Q
"RTN","RCDPRTP1",55,0)
.I $D(^TMP($J,"IBRBF",RCTP(0),RCBILL))!(RCTP(1)'=$O(^TMP($J,"IBRBF",RCTP(0),0))) K ^TMP("IBRBF",$J,RCTP(1),RCTP(0)),^TMP($J,"IBRBF",RCTP(0),RCTP(1)) I '$O(^TMP("IBRBF",$J,RCTP(1),0)) K ^TMP("IBRBF",$J,RCTP(1))
"RTN","RCDPRTP1",56,0)
;
"RTN","RCDPRTP1",57,0)
S RCTP(0)="" F S RCTP(0)=$O(^TMP("IBRBT",$J,RCBILL,RCTP(0))) Q:RCTP(0)="" D
"RTN","RCDPRTP1",58,0)
.;if associated third party has had payment also do not list twice
"RTN","RCDPRTP1",59,0)
.I $D(^TMP("RCDPRTPB",$J,RCNAM,RCTP(0))),(RCBILL'=RCTP(0)) S RCTP(RCTP(0))=^TMP("RCDPRTPB",$J,RCNAM,RCTP(0)) K ^(RCTP(0))
"RTN","RCDPRTP1",60,0)
.;if no prescription coverage exclude associated rx co-pay charges
"RTN","RCDPRTP1",61,0)
.I '$P(^TMP("IBRBT",$J,RCBILL),"^") D
"RTN","RCDPRTP1",62,0)
..S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:RCTP(1)="" I $G(^TMP("IBRBF",$J,RCTP(0),RCTP(1)))["RX" K ^TMP("IBRBF",$J,RCTP(0),RCTP(1)) I '$O(^TMP("IBRBF",$J,RCTP(0),"")) K ^TMP("IBRBF",$J,RCTP(0))
"RTN","RCDPRTP1",63,0)
.;if duplicate charges exclude them from report
"RTN","RCDPRTP1",64,0)
S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:RCTP(0)="" S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:'RCTP(1) D
"RTN","RCDPRTP1",65,0)
.I RCTP(0)'=RCBILL,($D(^TMP("IBRBF",$J,RCBILL,RCTP(1)))) K ^TMP("IBRBF",$J,RCTP(0),RCTP(1)) K:'$O(^TMP("IBRBF",$J,RCTP(0),0)) ^TMP("IBRBF",$J,RCTP(0))
"RTN","RCDPRTP1",66,0)
;
"RTN","RCDPRTP1",67,0)
;exclude cancelled charges if not selected to be on report
"RTN","RCDPRTP1",68,0)
I 'RCAN D
"RTN","RCDPRTP1",69,0)
.S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:RCTP(0)="" S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:'RCTP(1) D
"RTN","RCDPRTP1",70,0)
..I $P(^TMP("IBRBF",$J,RCTP(0),RCTP(1)),"^",3) K ^TMP("IBRBF",$J,RCTP(0),RCTP(1)) Q
"RTN","RCDPRTP1",71,0)
..S RCPT(2)=$O(^PRCA(430,"B",+$P(^TMP("IBRBF",$J,RCTP(0),RCTP(1)),"^",4),0)) I ($P($G(^PRCA(430,+RCPT(2),0)),"^",8)=39)!($P($G(^PRCA(430,+RCPT(2),0)),"^",8)=26) K ^TMP("IBRBF",$J,RCTP(0),RCTP(1))
"RTN","RCDPRTP1",72,0)
..I '$O(^TMP("IBRBF",$J,RCTP(0),"")) K ^TMP("IBRBF",$J,RCTP(0))
"RTN","RCDPRTP1",73,0)
I '$O(^TMP("IBRBF",$J,RCBILL,0)) K ^TMP("RCDPRTPB",$J,RCNAM,RCBILL) G PROCQ
"RTN","RCDPRTP1",74,0)
;
"RTN","RCDPRTP1",75,0)
I RCEXCEL D PRNTPAT^RCDPRTEX K ^TMP($J) Q ;Print in claims in excel format and quit
"RTN","RCDPRTP1",76,0)
;
"RTN","RCDPRTP1",77,0)
; - print patient detail line
"RTN","RCDPRTP1",78,0)
I 'RCPHIT S RCPHIT=1 D PRINT3^RCDPRTP2 G:$G(RCQ) PROCQ
"RTN","RCDPRTP1",79,0)
;
"RTN","RCDPRTP1",80,0)
; - print third party bills
"RTN","RCDPRTP1",81,0)
; o print the header first; need room for the header and
"RTN","RCDPRTP1",82,0)
; the bill that was paid.
"RTN","RCDPRTP1",83,0)
; o print the bill that was paid.
"RTN","RCDPRTP1",84,0)
S RCTP=RCBILL,RCIBDAT=$G(^TMP("IBRBT",$J,RCBILL,RCBILL))
"RTN","RCDPRTP1",85,0)
I $Y>(IOSL-7) D PAUSE^RCDPRTP2 G:$G(RCQ) PROCQ D HDR
"RTN","RCDPRTP1",86,0)
D HDR1^RCDPRTP2,PRINT1^RCDPRTP2 G:$G(RCQ) PROCQ
"RTN","RCDPRTP1",87,0)
;
"RTN","RCDPRTP1",88,0)
; PRCA*4.5*284, corrected typo of 'assoicated' to 'associated'
"RTN","RCDPRTP1",89,0)
; - print the other associated third party bills
"RTN","RCDPRTP1",90,0)
S RCTP=0 F S RCTP=$O(^TMP("IBRBT",$J,RCBILL,RCTP)) Q:'RCTP!$G(RCQ) D
"RTN","RCDPRTP1",91,0)
.I RCBILL=RCTP Q ; don't reprint the bill that was paid.
"RTN","RCDPRTP1",92,0)
.S RCIBDAT=$G(^TMP("IBRBT",$J,RCBILL,RCTP))
"RTN","RCDPRTP1",93,0)
.I 'RCAN,($P(RCIBDAT,"^",3)) Q ; exclude cancelled claims
"RTN","RCDPRTP1",94,0)
.D PRINT1^RCDPRTP2
"RTN","RCDPRTP1",95,0)
G:$G(RCQ) PROCQ
"RTN","RCDPRTP1",96,0)
;
"RTN","RCDPRTP1",97,0)
; - print the third party totals
"RTN","RCDPRTP1",98,0)
; PRCA*4.5*276 - adjusted header to make room for EEOB indicator '%'
"RTN","RCDPRTP1",99,0)
I $Y>(IOSL-2) D PAUSE^RCDPRTP2 G:$G(RCQ) PROCQ D HDR W !
"RTN","RCDPRTP1",100,0)
W !,?63,"----------",?75,"----------"
"RTN","RCDPRTP1",101,0)
W !,?64,$J(RCAMT(0),9,2),?76,$J(RCAMT(1),9,2)
"RTN","RCDPRTP1",102,0)
;
"RTN","RCDPRTP1",103,0)
; - print the associated first party charges
"RTN","RCDPRTP1",104,0)
;
"RTN","RCDPRTP1",105,0)
; PRCA*4.5*315 new screen for first party charges by (CARE TYPES)
"RTN","RCDPRTP1",106,0)
; check global node ^TMP("IBRBF",$J, all bills, all charges) --
"RTN","RCDPRTP1",107,0)
N RCACTYP,I,J ;Do the next section of code only if Care Types were selected - Stored in RCTYPE([care type])
"RTN","RCDPRTP1",108,0)
; We must loop through all Bills and First party charges for this screening
"RTN","RCDPRTP1",109,0)
I $D(RCTYPE)>1 S I=0 F S I=$O(^TMP("IBRBF",$J,I)) Q:'I S J=0 F S J=$O(^TMP("IBRBF",$J,I,J)) Q:'J D
"RTN","RCDPRTP1",110,0)
. S RCACTYP=$P(^TMP("IBRBF",$J,I,J),U,6) Q:RCACTYP="" ;6th piece is Action Type
"RTN","RCDPRTP1",111,0)
. I RCACTYP["TRICARE"!(RCACTYP["CHAMPVA") Q ;Not needed for screening 1st party charges
"RTN","RCDPRTP1",112,0)
. ;PRCA*4.5*351 - Allow Community Care RX to appear on the Outpatient Care Type Reports
"RTN","RCDPRTP1",113,0)
. I RCACTYP["RX" D Q
"RTN","RCDPRTP1",114,0)
.. Q:RCACTYP["CC"
"RTN","RCDPRTP1",115,0)
.. Q:RCACTYP["CHOICE"
"RTN","RCDPRTP1",116,0)
.. S RCTYP="R" D KILFPTY
"RTN","RCDPRTP1",117,0)
. ;end PRCA*4.5*351
"RTN","RCDPRTP1",118,0)
. I RCACTYP["OPT"!(RCACTYP["OBSERV") S RCTYP="O" D KILFPTY Q
"RTN","RCDPRTP1",119,0)
. I RCACTYP["INPT"!(RCACTYP["NHCU")!(RCACTYP["ADMIS")!(RCACTYP["MEDICARE DEDUCTIBLE")!(RCACTYP["PER DIEM") S RCTYP="I" D KILFPTY Q
"RTN","RCDPRTP1",120,0)
. Q
"RTN","RCDPRTP1",121,0)
;
"RTN","RCDPRTP1",122,0)
S RCTP(0)=0,RCLPFLG=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:'RCTP(0)!$G(RCQ) D
"RTN","RCDPRTP1",123,0)
.Q:$D(^TMP("IBRBF",$J,RCTP(0)))<10 ;New code - quit if ^TMP("IBRBF" has no sub nodes
"RTN","RCDPRTP1",124,0)
.I $Y>(IOSL-5) D PAUSE^RCDPRTP2 Q:$G(RCQ) D HDR
"RTN","RCDPRTP1",125,0)
.; - print the header for the first charge
"RTN","RCDPRTP1",126,0)
.I 'RCLPFLG D HDR2^RCDPRTP2 S RCLPFLG=1
"RTN","RCDPRTP1",127,0)
.S RCTP=0 F S RCTP=$O(^TMP("IBRBF",$J,RCTP(0),RCTP)) Q:'RCTP!$G(RCQ) D
"RTN","RCDPRTP1",128,0)
..S RCNO=1 ; set flag for at least one match
"RTN","RCDPRTP1",129,0)
..S RCIBDAT=$G(^TMP("IBRBF",$J,RCTP(0),RCTP))
"RTN","RCDPRTP1",130,0)
..; - print the patient detail line
"RTN","RCDPRTP1",131,0)
..I RCNO D PRINT2^RCDPRTP2
"RTN","RCDPRTP1",132,0)
;.
"RTN","RCDPRTP1",133,0)
; PRCA*4.5*284, cleanup ^TMP($J) only
"RTN","RCDPRTP1",134,0)
PROCQ ;
"RTN","RCDPRTP1",135,0)
K ^TMP($J) Q
"RTN","RCDPRTP1",136,0)
;
"RTN","RCDPRTP1",137,0)
;
"RTN","RCDPRTP1",138,0)
HDR ; Print the main report header.
"RTN","RCDPRTP1",139,0)
S PG=PG+1 I PG'=1!($E(IOST,1,2)="C-") W @IOF
"RTN","RCDPRTP1",140,0)
W !,?5,"THIRD PARTY CLAIMS W/MATCHING FIRST PARTY DEBTS ",RCNOW," PAGE ",PG
"RTN","RCDPRTP1",141,0)
I RCSORT'=2,(RCSORT'=4) W !,?18,"FOR THE PAYMENT DATES: ",DATEDIS1," TO ",DATEDIS2
"RTN","RCDPRTP1",142,0)
I RCSORT=4 W !,?18,"RECEIPT NUMBER ",RCPT
"RTN","RCDPRTP1",143,0)
W !,RCDLINE
"RTN","RCDPRTP1",144,0)
I PG=1 D
"RTN","RCDPRTP1",145,0)
.W !!,"Remember that any actions taken to decrease the first party receivables must"
"RTN","RCDPRTP1",146,0)
.W !,"consider any applicable deductibles or coinsurance amounts specified on the EOB."
"RTN","RCDPRTP1",147,0)
Q
"RTN","RCDPRTP1",148,0)
;
"RTN","RCDPRTP1",149,0)
;PRCA*4.5*315
"RTN","RCDPRTP1",150,0)
KILFPTY ;KILL 1st party associated claim from ^TMP("IBRBF", $J), used to screen out unwanted 1st party bills (wrong Care Type)
"RTN","RCDPRTP1",151,0)
;Verify that the type is one of the selected care types, if not delete the ^TMP global node for that charge
"RTN","RCDPRTP1",152,0)
I '$D(RCTYPE(RCTYP)) K ^TMP("IBRBF",$J,I,J)
"RTN","RCDPRTP1",153,0)
Q
"RTN","RCDPRTP1",154,0)
;
"RTN","RCRJRBD")
0^6^B101571445
"RTN","RCRJRBD",1,0)
RCRJRBD ;WISC/RFJ,TJK-bad debt extractor and report ;10/18/10 9:00am
"RTN","RCRJRBD",2,0)
;;4.5;Accounts Receivable;**101,139,170,193,203,215,220,138,239,273,282,310,315,340,346,338,351**;Mar 20, 1995;Build 14
"RTN","RCRJRBD",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","RCRJRBD",4,0)
; IA 4385 for calls to $$MRATYPE^IBCEMU2 and $$MRADTACT^IBCEMU2
"RTN","RCRJRBD",5,0)
Q
"RTN","RCRJRBD",6,0)
;
"RTN","RCRJRBD",7,0)
;PRCA*4.5*346 Modify SGL compile code 133.N3 to 133N.3 to
"RTN","RCRJRBD",8,0)
; ensure line item 528713 - 133N dollars are accrued
"RTN","RCRJRBD",9,0)
;
"RTN","RCRJRBD",10,0)
;
"RTN","RCRJRBD",11,0)
START(DATEEND) ; run bad debt report
"RTN","RCRJRBD",12,0)
; the DATEEND is the last day of the month being run
"RTN","RCRJRBD",13,0)
; from the routine RCRJRCOL which is the data extractor. The
"RTN","RCRJRBD",14,0)
; current receivable dollars is stored in ^TMP($J,"RCRJRBD",SGL)
"RTN","RCRJRBD",15,0)
; where SGL is the standard general ledger 1319, 1338, or 1339.
"RTN","RCRJRBD",16,0)
;
"RTN","RCRJRBD",17,0)
N ACTDATE,ACTUALCA,ACTUALWO,BEGDATE,BILLDA,CATEGORY
"RTN","RCRJRBD",18,0)
N COLLECT,CONTRACT,DR,ENDDATE,FUND,PAY,PAYMENT,PRIN,PRINCPAL
"RTN","RCRJRBD",19,0)
N RCRJFMM,RCRJDATE,SGL,TRANDA,TRANDATE,TRANTYPE,VALUE,WRITEOFF
"RTN","RCRJRBD",20,0)
N RCPRIN,RCTOMCCF,RCVALUE,RSC,MRATYPE,ARACTDT
"RTN","RCRJRBD",21,0)
;
"RTN","RCRJRBD",22,0)
; lock the bad debt file for storing data, lock cannot fail
"RTN","RCRJRBD",23,0)
; this lock can be used to monitor if the report is running
"RTN","RCRJRBD",24,0)
F L +^RC(348.1):$S($G(DILOCKTM)>5:DILOCKTM,1:5) Q:$T
"RTN","RCRJRBD",25,0)
;
"RTN","RCRJRBD",26,0)
; calculate the base percentages from past data
"RTN","RCRJRBD",27,0)
; example: DATEEND=2980331 => BEGDATE=2970300
"RTN","RCRJRBD",28,0)
; => ENDDATE=2980229
"RTN","RCRJRBD",29,0)
; add one day to ending date to go to next month
"RTN","RCRJRBD",30,0)
S BEGDATE=($E(DATEEND,1,3)-1)_$E(DATEEND,4,5)_"00"
"RTN","RCRJRBD",31,0)
S ENDDATE=($$FMADD^XLFDT($E(DATEEND,1,5)_"00",-1))+1
"RTN","RCRJRBD",32,0)
; loop bills activated between these dates
"RTN","RCRJRBD",33,0)
S ACTDATE=BEGDATE
"RTN","RCRJRBD",34,0)
F S ACTDATE=$O(^PRCA(430,"ACTDT",ACTDATE)) Q:'ACTDATE!(ACTDATE>ENDDATE) D
"RTN","RCRJRBD",35,0)
. S BILLDA=0 F S BILLDA=$O(^PRCA(430,"ACTDT",ACTDATE,BILLDA)) Q:'BILLDA D
"RTN","RCRJRBD",36,0)
. . S CATEGORY=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
"RTN","RCRJRBD",37,0)
. . ; do not look at prepayments
"RTN","RCRJRBD",38,0)
. . I 'CATEGORY!(CATEGORY=26) Q
"RTN","RCRJRBD",39,0)
. . ;
"RTN","RCRJRBD",40,0)
. . ; only look at bills with a 0 principal balance
"RTN","RCRJRBD",41,0)
. . I $P($G(^PRCA(430,BILLDA,7)),"^") Q
"RTN","RCRJRBD",42,0)
. . ;
"RTN","RCRJRBD",43,0)
. . ; only report fund 528701,03,04,11 and 4032/528709 bills
"RTN","RCRJRBD",44,0)
. . ;PRCA*4.5*338 - grab existing FUND for bill. Only recalculate if FUND = NULL
"RTN","RCRJRBD",45,0)
. . S FUND=$$GET1^DIQ(430,BILLDA_",",203)
"RTN","RCRJRBD",46,0)
. . I FUND="" S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
"RTN","RCRJRBD",47,0)
. . ;end PRCA*4.5*338
"RTN","RCRJRBD",48,0)
. . I '$$PTACCT^PRCAACC(FUND),$E(FUND,1,4)'=4032 Q
"RTN","RCRJRBD",49,0)
. . ;
"RTN","RCRJRBD",50,0)
. . ; determine MRA type of bill, given bill# and bill active date
"RTN","RCRJRBD",51,0)
. . ; DBIA #4385 activated on 31-Mar-2004
"RTN","RCRJRBD",52,0)
. . S MRATYPE=$$MRATYPE^IBCEMU2(BILLDA,ACTDATE)
"RTN","RCRJRBD",53,0)
. . ;
"RTN","RCRJRBD",54,0)
. . ; derive standard general ledger (SGL) from cat/fund/MRA type
"RTN","RCRJRBD",55,0)
. . S SGL=$$BDRSGL(CATEGORY,FUND,MRATYPE)
"RTN","RCRJRBD",56,0)
. . ;
"RTN","RCRJRBD",57,0)
. . ; determine the original amount of the bill (add increase
"RTN","RCRJRBD",58,0)
. . ; adjustments below)
"RTN","RCRJRBD",59,0)
. . S PRIN=$P($G(^PRCA(430,BILLDA,0)),"^",3)
"RTN","RCRJRBD",60,0)
. . S PAY=0
"RTN","RCRJRBD",61,0)
. . ;
"RTN","RCRJRBD",62,0)
. . ; get the $ transations for bills
"RTN","RCRJRBD",63,0)
. . S TRANDA=0
"RTN","RCRJRBD",64,0)
. . F S TRANDA=$O(^PRCA(433,"C",BILLDA,TRANDA)) Q:'TRANDA D
"RTN","RCRJRBD",65,0)
. . . S TRANTYPE=$P($G(^PRCA(433,TRANDA,1)),"^",2)
"RTN","RCRJRBD",66,0)
. . . I "^1^73^2^34^43^"'[("^"_TRANTYPE_"^") Q ; *340 added 73
"RTN","RCRJRBD",67,0)
. . . S VALUE=$$TRANBAL^RCRJRCOT(TRANDA) I VALUE="" Q
"RTN","RCRJRBD",68,0)
. . . ; increase adjustments or re-establish
"RTN","RCRJRBD",69,0)
. . . I TRANTYPE=1!(TRANTYPE=73)!(TRANTYPE=43) S PRIN=PRIN+$P(VALUE,"^") Q ; *340 added 73
"RTN","RCRJRBD",70,0)
. . . ; payments
"RTN","RCRJRBD",71,0)
. . . I TRANTYPE=2!(TRANTYPE=34) S PAY=PAY+$P(VALUE,"^") Q
"RTN","RCRJRBD",72,0)
. . ;
"RTN","RCRJRBD",73,0)
. . ; payment cannot be greater than principle
"RTN","RCRJRBD",74,0)
. . I PAY>PRIN S PAY=PRIN
"RTN","RCRJRBD",75,0)
. . ;
"RTN","RCRJRBD",76,0)
. . ; store the data
"RTN","RCRJRBD",77,0)
. . S PRINCPAL(SGL)=$G(PRINCPAL(SGL))+PRIN
"RTN","RCRJRBD",78,0)
. . S PAYMENT(SGL)=$G(PAYMENT(SGL))+PAY
"RTN","RCRJRBD",79,0)
. . ;
"RTN","RCRJRBD",80,0)
;
"RTN","RCRJRBD",81,0)
; calculate the writeoffs from 2/0/98
"RTN","RCRJRBD",82,0)
; 2/0/98 is when fms cleared out actual writeoffs and contract adj
"RTN","RCRJRBD",83,0)
K ^XTMP("PRCABDET")
"RTN","RCRJRBD",84,0)
S ^XTMP("PRCABDET",0)=$$FMADD^XLFDT(DT,10)_"^"_DT_"^BAD DEBT REPORT AUDIT"
"RTN","RCRJRBD",85,0)
F TRANTYPE=8,9,10,11,35 D
"RTN","RCRJRBD",86,0)
. S TRANDATE=2980200
"RTN","RCRJRBD",87,0)
. ; do not pick up transactions after the end date
"RTN","RCRJRBD",88,0)
. F S TRANDATE=$O(^PRCA(433,"AT",TRANTYPE,TRANDATE)) Q:'TRANDATE!($P(TRANDATE,".")>DATEEND) D
"RTN","RCRJRBD",89,0)
. . S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AT",TRANTYPE,TRANDATE,TRANDA)) Q:'TRANDA D
"RTN","RCRJRBD",90,0)
. . . ; do not look at decrease adj which are not contract adj
"RTN","RCRJRBD",91,0)
. . . I TRANTYPE=35,'$P($G(^PRCA(433,TRANDA,8)),"^",8) Q
"RTN","RCRJRBD",92,0)
. . . ;
"RTN","RCRJRBD",93,0)
. . . S BILLDA=$P($G(^PRCA(433,TRANDA,0)),"^",2)
"RTN","RCRJRBD",94,0)
. . . I 'BILLDA Q
"RTN","RCRJRBD",95,0)
. . . S CATEGORY=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
"RTN","RCRJRBD",96,0)
. . . ; do not look at prepayments
"RTN","RCRJRBD",97,0)
. . . I 'CATEGORY!(CATEGORY=26) Q
"RTN","RCRJRBD",98,0)
. . . ;
"RTN","RCRJRBD",99,0)
. . . ; only report fund 528701,03,04,11 and 4032/528709 (ltc) bills
"RTN","RCRJRBD",100,0)
. . . ;PRCA*4.5*338 - grab existing FUND for bill. Only recalculate if FUND = NULL
"RTN","RCRJRBD",101,0)
. . . S FUND=$$GET1^DIQ(430,BILLDA_",",203)
"RTN","RCRJRBD",102,0)
. . . I FUND="" S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
"RTN","RCRJRBD",103,0)
. . . ;end PRCA*4.5*338
"RTN","RCRJRBD",104,0)
. . . I '$$PTACCT^PRCAACC(FUND),$E(FUND,1,4)'=4032 Q
"RTN","RCRJRBD",105,0)
. . . ;
"RTN","RCRJRBD",106,0)
. . . ; get bill active date
"RTN","RCRJRBD",107,0)
. . . S ARACTDT=+$P($P($G(^PRCA(430,BILLDA,6)),"^",21),".")
"RTN","RCRJRBD",108,0)
. . . ; determine MRA type of bill, given bill# and bill active date
"RTN","RCRJRBD",109,0)
. . . ; DBIA #4385 activated on 31-Mar-2004
"RTN","RCRJRBD",110,0)
. . . S MRATYPE=$$MRATYPE^IBCEMU2(BILLDA,ARACTDT)
"RTN","RCRJRBD",111,0)
. . . ;
"RTN","RCRJRBD",112,0)
. . . ; derive standard general ledger (SGL) from cat/fund/MRA type
"RTN","RCRJRBD",113,0)
. . . S SGL=$$BDRSGL(CATEGORY,FUND,MRATYPE)
"RTN","RCRJRBD",114,0)
. . . ;
"RTN","RCRJRBD",115,0)
. . . ; get the principal transaction value
"RTN","RCRJRBD",116,0)
. . . S RCVALUE=+$P($$TRANBAL^RCRJRCOT(TRANDA),"^")
"RTN","RCRJRBD",117,0)
. . . ; temp variable for value (used below)
"RTN","RCRJRBD",118,0)
. . . S RCPRIN=RCVALUE
"RTN","RCRJRBD",119,0)
. . . ;
"RTN","RCRJRBD",120,0)
. . . ; add actual writeoff amount for fiscal year
"RTN","RCRJRBD",121,0)
. . . I TRANTYPE'=35 S ACTUALWO(SGL)=$G(ACTUALWO(SGL))+RCVALUE
"RTN","RCRJRBD",122,0)
. . . ; add actual contract adjustments for fiscal year
"RTN","RCRJRBD",123,0)
. . . I TRANTYPE=35 S ACTUALCA(SGL)=$G(ACTUALCA(SGL))+RCVALUE
"RTN","RCRJRBD",124,0)
. . . ;PRCA*4.5*338 - retrieve RSC from Bill. If no RSC in BILL, calculate it.
"RTN","RCRJRBD",125,0)
. . . S RSC=$$GET1^DIQ(430,BILLDA_",",255.1) ;Check for accrued RSC
"RTN","RCRJRBD",126,0)
. . . S:RSC="" RSC=$$GET1^DIQ(430,BILLDA_",",255) ;if no accrued RSC, check for non-accrued.
"RTN","RCRJRBD",127,0)
. . . S:RSC="" RSC=$$CALCRSC^RCXFMSUR(BILLDA) ;if neither present, calculate
"RTN","RCRJRBD",128,0)
. . . ;end PRCA*4.5*338
"RTN","RCRJRBD",129,0)
. . . S ^XTMP("PRCABDET",BILLDA,CATEGORY,FUND,RSC,SGL,TRANDA,TRANDATE,TRANTYPE,RCPRIN,RCVALUE,0,0)=""
"RTN","RCRJRBD",130,0)
;
"RTN","RCRJRBD",131,0)
; remove all the entries from the bad debt file
"RTN","RCRJRBD",132,0)
D DELETALL
"RTN","RCRJRBD",133,0)
;
"RTN","RCRJRBD",134,0)
; calculate percentages and store them
"RTN","RCRJRBD",135,0)
; PRCA*4.5*338 - corrected 133.N3 to 133N.3, also added 1319.7, 1319.8, 1319.9
"RTN","RCRJRBD",136,0)
F SGL=1319,1319.2,1319.3,1319.4,1319.5,1319.6,1319.7,1319.8,1319.9,1338,1338.2,1338.3,1339,1339.1,"133N","133N.2","133N.3" D ;PRCA*4.5*346
"RTN","RCRJRBD",137,0)
. ; collection %
"RTN","RCRJRBD",138,0)
. S COLLECT=0 I $G(PRINCPAL(SGL)) S COLLECT=$J($G(PAYMENT(SGL))/PRINCPAL(SGL)*100,0,2)
"RTN","RCRJRBD",139,0)
. ; patch PRCA*4.5*138: for the first year from when MRA is activated at a site, there is no collection
"RTN","RCRJRBD",140,0)
. ; history for post-MRA non-Medicare bills(SGL 133N). So, to calculate the percentage for SGL 133N, the
"RTN","RCRJRBD",141,0)
. ; payment and the principal for SGL 1339 are used in the first year.
"RTN","RCRJRBD",142,0)
. ; override the collection value for SGL=133N for the first year from MRA activation.
"RTN","RCRJRBD",143,0)
. ;; Re-evaluate the calc. of the percentage for 133N as well as 1339.
"RTN","RCRJRBD",144,0)
. ;;I SGL="133N",$G(PRINCIPAL(1339)) D ;
"RTN","RCRJRBD",145,0)
. ;;. N X1,X2,X,%Y
"RTN","RCRJRBD",146,0)
. ;;. ; X2=MRA Activation Date, X1=Today, X=diff in days, %Y=0 invalid dates
"RTN","RCRJRBD",147,0)
. ;;. ; DBIA #4385 activated on 31-Mar-2004
"RTN","RCRJRBD",148,0)
. ;;. S X2=$$MRADTACT^IBCEMU2,X1=$$DT^XLFDT D ^%DTC
"RTN","RCRJRBD",149,0)
. ;;. I %Y,X'>364.25 S COLLECT=$J($G(PAYMENT(1339))/PRINCPAL(1339)*100,0,2)
"RTN","RCRJRBD",150,0)
. S DR=".02////"_+COLLECT_";"
"RTN","RCRJRBD",151,0)
. ;
"RTN","RCRJRBD",152,0)
. ; current month receivable (this is built in the routine
"RTN","RCRJRBD",153,0)
. ; RCRJRCO1 and is stored in ^TMP($J,"RCRJRBD",SGL))
"RTN","RCRJRBD",154,0)
. S DR=DR_".07////"_+$G(^TMP($J,"RCRJRBD",SGL))_";"
"RTN","RCRJRBD",155,0)
. ;
"RTN","RCRJRBD",156,0)
. ; calculate allowance estimate for 1319 and 1338
"RTN","RCRJRBD",157,0)
. ; .08 allowance estimate = (writeoff % * current receivables)
"RTN","RCRJRBD",158,0)
. ; .09 actual writeoffs fytd
"RTN","RCRJRBD",159,0)
. I SGL=1319!(SGL=1319.2)!(SGL=1319.3)!(SGL=1319.4)!(SGL=1319.5)!(SGL=1319.6)!(SGL=1319.7)!(SGL=1319.8)!(SGL=1319.9)!(SGL=1338)!(SGL=1338.2)!(SGL=1338.3) D
"RTN","RCRJRBD",160,0)
. . S WRITEOFF=100-COLLECT
"RTN","RCRJRBD",161,0)
. . S DR=DR_".03////"_WRITEOFF_";"
"RTN","RCRJRBD",162,0)
. . S DR=DR_".08////"_$J((WRITEOFF/100)*$G(^TMP($J,"RCRJRBD",SGL)),0,2)_";"
"RTN","RCRJRBD",163,0)
. . S DR=DR_".09////"_+$G(ACTUALWO(SGL))_";"
"RTN","RCRJRBD",164,0)
. ; calculate allowance estimate for 1339
"RTN","RCRJRBD",165,0)
. ; .08 allowance estimate = (contract % * current receivables)
"RTN","RCRJRBD",166,0)
. ; .09 actual contract adjustments fytd
"RTN","RCRJRBD",167,0)
. I SGL=1339!(SGL=1339.1)!(SGL="133N")!(SGL="133N.2")!(SGL="133N.3") D
"RTN","RCRJRBD",168,0)
. . S CONTRACT=100-COLLECT
"RTN","RCRJRBD",169,0)
. . S DR=DR_".04////"_CONTRACT_";"
"RTN","RCRJRBD",170,0)
. . S DR=DR_".08////"_$J((CONTRACT/100)*$G(^TMP($J,"RCRJRBD",SGL)),0,2)_";"
"RTN","RCRJRBD",171,0)
. . S DR=DR_".09////"_+$G(ACTUALCA(SGL))_";"
"RTN","RCRJRBD",172,0)
. ;
"RTN","RCRJRBD",173,0)
. ; set changed locally flag to no
"RTN","RCRJRBD",174,0)
. S DR=DR_".1////0;"
"RTN","RCRJRBD",175,0)
. D STORE(SGL,DR)
"RTN","RCRJRBD",176,0)
;
"RTN","RCRJRBD",177,0)
L -^RC(348.1)
"RTN","RCRJRBD",178,0)
;
"RTN","RCRJRBD",179,0)
; ; put the report in a mail message (rcrjfmm=1)
"RTN","RCRJRBD",180,0)
; S RCRJFMM=1
"RTN","RCRJRBD",181,0)
; S RCRJDATE=DATEEND
"RTN","RCRJRBD",182,0)
; D DQ^RCRJRBDR
"RTN","RCRJRBD",183,0)
;
"RTN","RCRJRBD",184,0)
; transmit the allowances to FMS, and then generate the report.
"RTN","RCRJRBD",185,0)
D BADDEBT^RCXFMSSV(DATEEND)
"RTN","RCRJRBD",186,0)
Q
"RTN","RCRJRBD",187,0)
;
"RTN","RCRJRBD",188,0)
;
"RTN","RCRJRBD",189,0)
STORE(SGL,DR) ; store data for Standard Ledger Account
"RTN","RCRJRBD",190,0)
N D0,DA,DD,DI,DIC,DIE,DINUM,DO,DQ,X,Y
"RTN","RCRJRBD",191,0)
S DIC="^RC(348.1,",DIC(0)="L",X=SGL,DIC("DR")=DR
"RTN","RCRJRBD",192,0)
D FILE^DICN
"RTN","RCRJRBD",193,0)
Q
"RTN","RCRJRBD",194,0)
;
"RTN","RCRJRBD",195,0)
;
"RTN","RCRJRBD",196,0)
DELETALL ; delete all the entries from the bad debt file
"RTN","RCRJRBD",197,0)
N %,DA,DIC,DIK,X,Y
"RTN","RCRJRBD",198,0)
S DIK="^RC(348.1,"
"RTN","RCRJRBD",199,0)
S DA=0 F S DA=$O(^RC(348.1,DA)) Q:'DA D ^DIK
"RTN","RCRJRBD",200,0)
Q
"RTN","RCRJRBD",201,0)
;
"RTN","RCRJRBD",202,0)
;
"RTN","RCRJRBD",203,0)
WD3() ; return the third work day of the month
"RTN","RCRJRBD",204,0)
N J,P,V,X
"RTN","RCRJRBD",205,0)
S J=0 F P=$E(DT,1,5)_"01":1 S V=$$DOW^XLFDT(P,1) I V,V<6,'$D(^HOLIDAY("B",P)) S J=J+1 Q:J=3
"RTN","RCRJRBD",206,0)
S X=+$E(P,6,7)
"RTN","RCRJRBD",207,0)
Q X
"RTN","RCRJRBD",208,0)
;
"RTN","RCRJRBD",209,0)
;
"RTN","RCRJRBD",210,0)
PREVMONT(FORDATE) ; return the previous month's date
"RTN","RCRJRBD",211,0)
N PREVDATE
"RTN","RCRJRBD",212,0)
S PREVDATE=$E(FORDATE,1,5)-1
"RTN","RCRJRBD",213,0)
I $E(PREVDATE,4,5)="00" S PREVDATE=($E(PREVDATE,1,3)-1)_12
"RTN","RCRJRBD",214,0)
Q PREVDATE_"00"
"RTN","RCRJRBD",215,0)
;
"RTN","RCRJRBD",216,0)
; derive standard general ledger (SGL) from category and fund
"RTN","RCRJRBD",217,0)
SGL(CATEGORY,FUND) ;
"RTN","RCRJRBD",218,0)
I $G(FUND)=528709 Q 1319.2 ;new long term care fund
"RTN","RCRJRBD",219,0)
I $E($G(FUND),1,4)=4032 Q 1319.2 ; breakout long term care as a subset
"RTN","RCRJRBD",220,0)
I $G(FUND)=528711&(CAT=6)!(CAT=7) Q 1319.5 ; breakout pharmacy
"RTN","RCRJRBD",221,0)
I $G(FUND)=528711&(CAT=9) Q "133N.2" ; pharmacy reimburs health ins
"RTN","RCRJRBD",222,0)
I $G(FUND)=528711&(CAT=10) Q 1338.2 ; pharmacy tort feasor
"RTN","RCRJRBD",223,0)
I CATEGORY=8 Q 1339 ; crime or per. vio.
"RTN","RCRJRBD",224,0)
I CATEGORY=9 Q 1339 ; reimbursable health insurance
"RTN","RCRJRBD",225,0)
I CATEGORY=46 Q 1339 ; EMER/HUMAN REIMB INS ;315
"RTN","RCRJRBD",226,0)
I CATEGORY=10 Q 1338 ; tort feasor
"RTN","RCRJRBD",227,0)
I CATEGORY=21 Q 1339 ; medicare
"RTN","RCRJRBD",228,0)
I CATEGORY=45 Q 1339.1 ; Fee Basis
"RTN","RCRJRBD",229,0)
Q 1319
"RTN","RCRJRBD",230,0)
;
"RTN","RCRJRBD",231,0)
;
"RTN","RCRJRBD",232,0)
BDRSGL(CAT,FUND,MRATYPE) ; Calculate SGLs for the BDR process
"RTN","RCRJRBD",233,0)
;PRCA*4.5*310/DRF Added fund 528713, Non-VA Reimbursable Insurance
"RTN","RCRJRBD",234,0)
;
"RTN","RCRJRBD",235,0)
; This API will be used by both the ARDC (routine RCRJRCOC)
"RTN","RCRJRBD",236,0)
; and the BDR estimate calculator to associate receivables
"RTN","RCRJRBD",237,0)
; with the correct standard general ledger account (SGL).
"RTN","RCRJRBD",238,0)
; The following table will be implemented:
"RTN","RCRJRBD",239,0)
;
"RTN","RCRJRBD",240,0)
; Receivable Type (Category) Fund SGL
"RTN","RCRJRBD",241,0)
;==================================================
"RTN","RCRJRBD",242,0)
; Medical Care Co-payments 528703 1319
"RTN","RCRJRBD",243,0)
; (plus Inelig, Emerg./Hum. rec.)
"RTN","RCRJRBD",244,0)
; Long Term Care Co-payments 528709 1319.2
"RTN","RCRJRBD",245,0)
; Medication Co-payments 528701 1319.3
"RTN","RCRJRBD",246,0)
; Crimes of Personal Violence (8), 528704 1319.4
"RTN","RCRJRBD",247,0)
; Medicare (21), No-Fault Auto
"RTN","RCRJRBD",248,0)
; (7), Workman's Comp (6)
"RTN","RCRJRBD",249,0)
; Tort Feasor (10) 528704 1338
"RTN","RCRJRBD",250,0)
; RHI (9), pre-MRA 528704 1339
"RTN","RCRJRBD",251,0)
; RHI (9), post-MRA, MRA rec. 528704 133H
"RTN","RCRJRBD",252,0)
; RHI (9), post-MRA, non-MRA rec. 528704 133N
"RTN","RCRJRBD",253,0)
; Non-VA RHI Tort Feasor 528713 1338.3
"RTN","RCRJRBD",254,0)
; Non-VA RHI (45), pre-MRA 528713 1339.1
"RTN","RCRJRBD",255,0)
; Non-VA RHI (45), post-MRA, MRA rec. 528713 133H.2
"RTN","RCRJRBD",256,0)
; Non-VA RHI (45), post-MRA, non-MRA rec. 528713 133N.3
"RTN","RCRJRBD",257,0)
; Crimes of Personal Violence (8), 528713 1319.6
"RTN","RCRJRBD",258,0)
; Medicare (21), No-Fault Auto
"RTN","RCRJRBD",259,0)
; Inpat./Outpat. Community Care copayments 528714 1319.7
"RTN","RCRJRBD",260,0)
; RX Community Care copayments 528714 1319.8
"RTN","RCRJRBD",261,0)
; LTC Community Care copayments 528714 1319.9
"RTN","RCRJRBD",262,0)
; (7), Workman's Comp (6)
"RTN","RCRJRBD",263,0)
; Pharmacy No Fault Auto(7), 528711 1319.5
"RTN","RCRJRBD",264,0)
; Pharmacy Workman's Comp(6)
"RTN","RCRJRBD",265,0)
; Pharmacy RHI, non MRA (9) 528711 133N.2
"RTN","RCRJRBD",266,0)
; Pharmacy Tort Feasor (10) 528711 1338.2
"RTN","RCRJRBD",267,0)
;
"RTN","RCRJRBD",268,0)
; Input: CAT -- Pointer to the receivable category in file 430.2
"RTN","RCRJRBD",269,0)
; FUND -- Receivable fund calculated by routine RCXFMSUF
"RTN","RCRJRBD",270,0)
; MRATYPE -- Indicator of an MRA (2) or non-MRA (3) receivable
"RTN","RCRJRBD",271,0)
;
"RTN","RCRJRBD",272,0)
;
"RTN","RCRJRBD",273,0)
I $G(FUND)=528709 Q 1319.2
"RTN","RCRJRBD",274,0)
I $E($G(FUND),1,4)=4032 Q 1319.2
"RTN","RCRJRBD",275,0)
I $G(FUND)=528701 Q 1319.3
"RTN","RCRJRBD",276,0)
I $G(FUND)=528711&((CAT=6)!(CAT=7)) Q 1319.5
"RTN","RCRJRBD",277,0)
I $G(FUND)=528711&(CAT=9) Q "133N.2"
"RTN","RCRJRBD",278,0)
I $G(FUND)=528711&(CAT=10) Q 1338.2
"RTN","RCRJRBD",279,0)
;PRCA*4.5*338 - Add new Community Care Categories
"RTN","RCRJRBD",280,0)
; THIRD PARTY =528713 new code begins
"RTN","RCRJRBD",281,0)
I $G(FUND)=528713&(CAT=10!(CAT=53)!(CAT=56)!(CAT=59)) Q 1338.3 ;patch 338 Add Comm Care Tort Feasor
"RTN","RCRJRBD",282,0)
I $G(FUND)=528713&(CAT=8!(CAT=21)!(CAT=6)!(CAT=7)!(CAT=52)!(CAT=54)!(CAT=55)!(CAT=57)!(CAT=59)!(CAT=60)) Q 1319.6 ;patch 338 Added Comm Care No Fault and Workers Comp
"RTN","RCRJRBD",283,0)
I ((CAT>47)&(CAT<52)) Q $S(MRATYPE=2:"133H.2",MRATYPE=3:"133N.3",1:1339.1) ;patch 338 Comm Care Reimb ins types.
"RTN","RCRJRBD",284,0)
; FIRST PARTY = 528714 - Community Care Copays
"RTN","RCRJRBD",285,0)
I $G(FUND)=528714&(CAT=61!(CAT=81)!(CAT=63)!(CAT=82)!(CAT=65)!(CAT=83)!(CAT=67)!(CAT=84)) Q 1319.7 ;INP/OPT copays
"RTN","RCRJRBD",286,0)
I $G(FUND)=528714&(CAT=62!(CAT=64)!(CAT=66)!(CAT=68)) Q 1319.8 ;rx copays
"RTN","RCRJRBD",287,0)
I $G(FUND)=528714&(CAT>68)&(CAT<75) Q 1319.9 ;LTC copays
"RTN","RCRJRBD",288,0)
;end PRCA*4.5*338
"RTN","RCRJRBD",289,0)
I CAT=8!(CAT=21)!(CAT=7)!(CAT=6) Q 1319.4
"RTN","RCRJRBD",290,0)
I CAT=10 Q 1338
"RTN","RCRJRBD",291,0)
I CAT=9 Q $S(MRATYPE=2:"133H",MRATYPE=3:"133N",1:1339)
"RTN","RCRJRBD",292,0)
I CAT=46 Q $S(MRATYPE=2:"133H",MRATYPE=3:"133N",1:1339) ;315
"RTN","RCRJRBD",293,0)
I CAT=45 Q $S(MRATYPE=2:"133H.2",MRATYPE=3:"133N.3",1:1339.1)
"RTN","RCRJRBD",294,0)
Q 1319
"RTN","RCRJRCOR")
0^11^B71863366
"RTN","RCRJRCOR",1,0)
RCRJRCOR ;WISC/RFJ-ar data collector summary report ;1 Mar 97
"RTN","RCRJRCOR",2,0)
;;4.5;Accounts Receivable;**68,96,139,103,156,170,174,191,220,138,239,320,338,351**;Mar 20, 1995;Build 14
"RTN","RCRJRCOR",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","RCRJRCOR",4,0)
Q
"RTN","RCRJRCOR",5,0)
;
"RTN","RCRJRCOR",6,0)
;
"RTN","RCRJRCOR",7,0)
SEND ; send data to ndb and data to FMS
"RTN","RCRJRCOR",8,0)
N %,AMOUNT,DATEMOYR,FUND,LINE,RSC,SPACE,TOTAL,TOTALFUN,TOTALTYP,TYPE,X,XMY,Y
"RTN","RCRJRCOR",9,0)
;
"RTN","RCRJRCOR",10,0)
; ---------- send to ndb ----------
"RTN","RCRJRCOR",11,0)
; data stored in tmp($j,rcrjrcolndb)
"RTN","RCRJRCOR",12,0)
I '$G(RCRJFAR1) D NDB(PRCASITE,DATEBEG,DATEEND)
"RTN","RCRJRCOR",13,0)
;
"RTN","RCRJRCOR",14,0)
;
"RTN","RCRJRCOR",15,0)
; ---------- send sv to fms ----------
"RTN","RCRJRCOR",16,0)
; data stored in tmp($j,rcrjrcolsv)
"RTN","RCRJRCOR",17,0)
; rcrjfsv is a flag set in the routine rcrjrco for retransmission
"RTN","RCRJRCOR",18,0)
; to prevent accepted fms documents from being resent
"RTN","RCRJRCOR",19,0)
I '$G(RCRJFSV) D STARTSV^RCXFMSSV(DATEEND)
"RTN","RCRJRCOR",20,0)
;
"RTN","RCRJRCOR",21,0)
;
"RTN","RCRJRCOR",22,0)
; ---------- send wr to fms ----------
"RTN","RCRJRCOR",23,0)
; data stored in tmp($j,rcrjrcolwr)
"RTN","RCRJRCOR",24,0)
; rcrjfwr is a flag set in the routine rcrjrco for retransmission
"RTN","RCRJRCOR",25,0)
; to prevent accepted fms documents from being resent
"RTN","RCRJRCOR",26,0)
I '$G(RCRJFWR) D STARTWR^RCXFMSWR(DATEEND)
"RTN","RCRJRCOR",27,0)
;
"RTN","RCRJRCOR",28,0)
; ---------- send tr to fms ----------
"RTN","RCRJRCOR",29,0)
N RCTRANS
"RTN","RCRJRCOR",30,0)
; this call returns rctrans array (see rcxfmstx for description)
"RTN","RCRJRCOR",31,0)
; rcrjftr is a flag set in the routine rcrjrco for retransmission
"RTN","RCRJRCOR",32,0)
; to prevent accepted fms documents from being resent
"RTN","RCRJRCOR",33,0)
I '$G(RCRJFTR) D STARTTR^RCXFMSTX(DATEEND)
"RTN","RCRJRCOR",34,0)
;
"RTN","RCRJRCOR",35,0)
; ---------- send oig extract ----------
"RTN","RCRJRCOR",36,0)
; data stored in tmp(j,rcrjroig)
"RTN","RCRJRCOR",37,0)
; get non-mccf bills for extract and user report
"RTN","RCRJRCOR",38,0)
D NONMCCF^RCRJROIG(DATEEND)
"RTN","RCRJRCOR",39,0)
; rcrjfoig is a flag set in the routine rcrjrco for retransmission
"RTN","RCRJRCOR",40,0)
; to prevent the oig extract from being resent
"RTN","RCRJRCOR",41,0)
I '$G(RCRJFOIG) D OIG^RCRJROIG(DATEEND)
"RTN","RCRJRCOR",42,0)
;
"RTN","RCRJRCOR",43,0)
; generate a mailman message to the group showing the data
"RTN","RCRJRCOR",44,0)
K ^TMP($J,"RCRJRCORMM")
"RTN","RCRJRCOR",45,0)
S Y=$E(DATEEND,1,5)_"00" D DD^%DT S DATEMOYR=Y
"RTN","RCRJRCOR",46,0)
S LINE=0,SPACE="",$P(SPACE," ",80)=""
"RTN","RCRJRCOR",47,0)
D SET("Data has been collected for the month "_DATEMOYR_". The data has been")
"RTN","RCRJRCOR",48,0)
D SET("transmitted to the following systems:")
"RTN","RCRJRCOR",49,0)
D SET(" ")
"RTN","RCRJRCOR",50,0)
;
"RTN","RCRJRCOR",51,0)
I '$G(RCRJFAR1) D
"RTN","RCRJRCOR",52,0)
. D SET("NATIONAL DATABASE DATA")
"RTN","RCRJRCOR",53,0)
. D SET("----------------------")
"RTN","RCRJRCOR",54,0)
. D SET("The data has been sent to the National Database. For a detail list")
"RTN","RCRJRCOR",55,0)
. D SET("of the data sent, please review the Return Reports which are sent")
"RTN","RCRJRCOR",56,0)
. D SET("from the National Database.")
"RTN","RCRJRCOR",57,0)
. D SET(" ")
"RTN","RCRJRCOR",58,0)
;
"RTN","RCRJRCOR",59,0)
I '$G(RCRJFSV) D
"RTN","RCRJRCOR",60,0)
. D SET("FMS, STANDARD VOUCHER (SV) DOCUMENT")
"RTN","RCRJRCOR",61,0)
. D SET("-----------------------------------")
"RTN","RCRJRCOR",62,0)
. D SET("The following data has been transmitted to FMS in the SV document:")
"RTN","RCRJRCOR",63,0)
. D SET(" Revenue Source Code Type Amount")
"RTN","RCRJRCOR",64,0)
. D SET(" ------------------- ---- ------")
"RTN","RCRJRCOR",65,0)
. S TOTAL=0
"RTN","RCRJRCOR",66,0)
. S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLSV",TYPE)) Q:TYPE="" D
"RTN","RCRJRCOR",67,0)
. . I TYPE=17!(TYPE=18) Q ; display the Medicare totals later
"RTN","RCRJRCOR",68,0)
. . S TOTALTYP=0
"RTN","RCRJRCOR",69,0)
. . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND)) Q:FUND="" D
"RTN","RCRJRCOR",70,0)
. . . S TOTALFUN=0
"RTN","RCRJRCOR",71,0)
. . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC)) Q:RSC="" S AMOUNT=^(RSC) D
"RTN","RCRJRCOR",72,0)
. . . . D SET(" "_RSC_" "_$E($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$J(AMOUNT,13,2))
"RTN","RCRJRCOR",73,0)
. . . . S TOTALFUN=TOTALFUN+AMOUNT
"RTN","RCRJRCOR",74,0)
. . . . S TOTALTYP=TOTALTYP+AMOUNT
"RTN","RCRJRCOR",75,0)
. . . . S TOTAL=TOTAL+AMOUNT
"RTN","RCRJRCOR",76,0)
. . . ;
"RTN","RCRJRCOR",77,0)
. . . ;N RCFUND S RCFUND=$S($E(DATEEND,2,5)<"0410":$E(FUND,1,4)_"."_$E(FUND,6),1:$E(FUND,1,4)_"0"_$E(FUND,6))
"RTN","RCRJRCOR",78,0)
. . . N RCFUND S RCFUND=$S($L(FUND)<6:FUND,$E(DATEEND,2,5)<"0410":$E(FUND,1,4)_"."_$E(FUND,6),FUND>528700:FUND,1:$E(FUND,1,4)_"0"_$E(FUND,6)) ;PRCA*4.5*338,351
"RTN","RCRJRCOR",79,0)
. . . ;I TYPE=21 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
"RTN","RCRJRCOR",80,0)
. . . D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
"RTN","RCRJRCOR",81,0)
. . ;
"RTN","RCRJRCOR",82,0)
. . D SET(" ----------")
"RTN","RCRJRCOR",83,0)
. . D SET(" TOTAL TYPE "_TYPE_$J(TOTALTYP,13,2))
"RTN","RCRJRCOR",84,0)
. . D SET(" ")
"RTN","RCRJRCOR",85,0)
. ;
"RTN","RCRJRCOR",86,0)
. ; Display Medicare totals and update the SV total
"RTN","RCRJRCOR",87,0)
. S AMOUNT=+$G(^TMP($J,"RCRJRCOLSV",17)),TOTAL=TOTAL+AMOUNT
"RTN","RCRJRCOR",88,0)
. D SET(" Medicare Contractual Adjustment TOTAL TYPE 17"_$J(AMOUNT,13,2))
"RTN","RCRJRCOR",89,0)
. S AMOUNT=+$G(^TMP($J,"RCRJRCOLSV",18)),TOTAL=TOTAL+AMOUNT
"RTN","RCRJRCOR",90,0)
. D SET(" Unreimbursable Medicare Expense TOTAL TYPE 18"_$J(AMOUNT,13,2))
"RTN","RCRJRCOR",91,0)
. D SET(" ")
"RTN","RCRJRCOR",92,0)
. ;
"RTN","RCRJRCOR",93,0)
. D SET(" ----------")
"RTN","RCRJRCOR",94,0)
. D SET(" TOTAL SV"_$J(TOTAL,13,2))
"RTN","RCRJRCOR",95,0)
. D SET(" ")
"RTN","RCRJRCOR",96,0)
;
"RTN","RCRJRCOR",97,0)
I '$G(RCRJFWR) D
"RTN","RCRJRCOR",98,0)
. D SET("FMS, WRITEOFFS/CONTRACT ADJUSTMENTS (WR) DOCUMENT")
"RTN","RCRJRCOR",99,0)
. D SET("-------------------------------------------------")
"RTN","RCRJRCOR",100,0)
. D SET("The following data has been transmitted to FMS in the WR document:")
"RTN","RCRJRCOR",101,0)
. D SET(" Revenue Source Code Type Amount")
"RTN","RCRJRCOR",102,0)
. D SET(" ------------------- ---- ------")
"RTN","RCRJRCOR",103,0)
. S TOTAL=0
"RTN","RCRJRCOR",104,0)
. S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLWR",TYPE)) Q:TYPE="" D
"RTN","RCRJRCOR",105,0)
. . S TOTALTYP=0
"RTN","RCRJRCOR",106,0)
. . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND)) Q:FUND="" D
"RTN","RCRJRCOR",107,0)
. . . S TOTALFUN=0
"RTN","RCRJRCOR",108,0)
. . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC)) Q:RSC="" S AMOUNT=^(RSC) D
"RTN","RCRJRCOR",109,0)
. . . . D SET(" "_RSC_" "_$E($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$J(AMOUNT,13,2))
"RTN","RCRJRCOR",110,0)
. . . . S TOTALFUN=TOTALFUN+AMOUNT
"RTN","RCRJRCOR",111,0)
. . . . S TOTALTYP=TOTALTYP+AMOUNT
"RTN","RCRJRCOR",112,0)
. . . . S TOTAL=TOTAL+AMOUNT
"RTN","RCRJRCOR",113,0)
. . . ;
"RTN","RCRJRCOR",114,0)
. . . N RCFUND S RCFUND=$S($L(FUND)<6:FUND,$E(DATEEND,2,5)<"0410":$E(FUND,1,4)_"."_$E(FUND,6),FUND>528700:FUND,1:$E(FUND,1,4)_"0"_$E(FUND,6)) ;PRCA*4.5*338,351
"RTN","RCRJRCOR",115,0)
. . . ;I TYPE=37 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
"RTN","RCRJRCOR",116,0)
. . . D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
"RTN","RCRJRCOR",117,0)
. . ;
"RTN","RCRJRCOR",118,0)
. . D SET(" ----------")
"RTN","RCRJRCOR",119,0)
. . D SET(" TOTAL TYPE "_TYPE_$J(TOTALTYP,13,2))
"RTN","RCRJRCOR",120,0)
. . D SET(" ")
"RTN","RCRJRCOR",121,0)
. D SET(" ----------")
"RTN","RCRJRCOR",122,0)
. D SET(" TOTAL WR"_$J(TOTAL,13,2))
"RTN","RCRJRCOR",123,0)
. D SET(" ")
"RTN","RCRJRCOR",124,0)
;
"RTN","RCRJRCOR",125,0)
I '$G(RCRJFTR) D
"RTN","RCRJRCOR",126,0)
. D SET("FMS, TRANSFER FROM MCCF TO HSIF (TR) DOCUMENT")
"RTN","RCRJRCOR",127,0)
. D SET("-------------------------------------------------")
"RTN","RCRJRCOR",128,0)
. D SET("The following data has been transmitted to FMS in the TR document:")
"RTN","RCRJRCOR",129,0)
. D SET(" From Fund From RSC To Fund To RSC Amount")
"RTN","RCRJRCOR",130,0)
. D SET(" --------- -------- ------- ------ ----------")
"RTN","RCRJRCOR",131,0)
. I $O(RCTRANS(""))="" D SET(" No Dollars to Transfer.") Q
"RTN","RCRJRCOR",132,0)
. ;
"RTN","RCRJRCOR",133,0)
. S FUND="" F S FUND=$O(RCTRANS(FUND)) Q:FUND="" D
"RTN","RCRJRCOR",134,0)
. . S RSC="" F S RSC=$O(RCTRANS(FUND,RSC)) Q:RSC="" D
"RTN","RCRJRCOR",135,0)
. . . ; rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount
"RTN","RCRJRCOR",136,0)
. . . S AMOUNT=RCTRANS(FUND,RSC)
"RTN","RCRJRCOR",137,0)
. . . D SET($J(FUND,11)_$J(RSC,12)_$J($P(AMOUNT,"^"),14)_$J($P(AMOUNT,"^",2),10)_$J($P(AMOUNT,"^",3),31,2))
"RTN","RCRJRCOR",138,0)
;
"RTN","RCRJRCOR",139,0)
S XMY("G.RC AR DATA COLLECTOR")=""
"RTN","RCRJRCOR",140,0)
S %=$$SENDMSG("AR Data Collector for "_DATEMOYR_" Station "_PRCASITE,.XMY)
"RTN","RCRJRCOR",141,0)
K ^TMP($J,"RCRJRCORMM")
"RTN","RCRJRCOR",142,0)
;
"RTN","RCRJRCOR",143,0)
; send users detail report
"RTN","RCRJRCOR",144,0)
;D USERREPT^RCRJRCOU(DATEMOYR) ;removed from backround job p315 (FY16 HAPE RRE PRCA*4.5*320)
"RTN","RCRJRCOR",145,0)
Q
"RTN","RCRJRCOR",146,0)
;
"RTN","RCRJRCOR",147,0)
;
"RTN","RCRJRCOR",148,0)
NDB(PRCASITE,DATEBEG,DATEEND) ; send data to the national database
"RTN","RCRJRCOR",149,0)
N %,BATCNAME,COUNT,CRITERIA,DATA,LINE,XMY,X,Y
"RTN","RCRJRCOR",150,0)
K ^TMP($J,"RCRJRCORMM")
"RTN","RCRJRCOR",151,0)
S LINE=2,DATA="D$ "
"RTN","RCRJRCOR",152,0)
S CRITERIA="" F COUNT=1:1 S CRITERIA=$O(^TMP($J,"RCRJRCOLNDB",CRITERIA)) Q:CRITERIA="" D
"RTN","RCRJRCOR",153,0)
. S DATA=DATA_":"_COUNT_"/"_CRITERIA_"/"_^TMP($J,"RCRJRCOLNDB",CRITERIA)
"RTN","RCRJRCOR",154,0)
. I $L(DATA)>200 D SET(DATA) S DATA="D$ "
"RTN","RCRJRCOR",155,0)
I DATA'="D$ " D SET(DATA)
"RTN","RCRJRCOR",156,0)
;
"RTN","RCRJRCOR",157,0)
; build the first two control lines in mail message
"RTN","RCRJRCOR",158,0)
S Y=DATEBEG D DD^%DT
"RTN","RCRJRCOR",159,0)
S BATCNAME="AR1-"_$E(Y,1,3)_$E(DATEBEG,6,7)_$TR($P(Y,",",2)," ")
"RTN","RCRJRCOR",160,0)
S Y=DATEEND D DD^%DT
"RTN","RCRJRCOR",161,0)
S BATCNAME=BATCNAME_"-"_$E(Y,1,3)_$E(DATEEND,6,7)_$TR($P(Y,",",2)," ")
"RTN","RCRJRCOR",162,0)
S ^TMP($J,"RCRJRCORMM",1)="T$ "_PRCASITE_"$"_BATCNAME_"$$$$$*"
"RTN","RCRJRCOR",163,0)
; get end time (in %)
"RTN","RCRJRCOR",164,0)
D NOW^%DTC
"RTN","RCRJRCOR",165,0)
S ^TMP($J,"RCRJRCORMM",2)="S$ "_STRTTIME_"^"_%_"$0$"_(COUNT-1)
"RTN","RCRJRCOR",166,0)
;
"RTN","RCRJRCOR",167,0)
S XMY("S.PRQN DATA COLLECTION
DNS.URL ")=""
"RTN","RCRJRCOR",168,0)
S %=$$SENDMSG("AR1 "_$E(DATEEND,4,5)_"/"_$E(DATEEND,2,3)_" NDB DATA FOR SITE "_PRCASITE,.XMY)
"RTN","RCRJRCOR",169,0)
K ^TMP($J,"RCRJRCORMM")
"RTN","RCRJRCOR",170,0)
Q
"RTN","RCRJRCOR",171,0)
;
"RTN","RCRJRCOR",172,0)
;
"RTN","RCRJRCOR",173,0)
SUMMARY ; print summary report in mailman bulletin
"RTN","RCRJRCOR",174,0)
N %,BILLDA,CRITER2,CRITERIA,DATA0,DFN,LINE,STAT,TOTAL,VA,XMY
"RTN","RCRJRCOR",175,0)
K ^TMP($J,"RCRJRCOR") ; used to identify test patients
"RTN","RCRJRCOR",176,0)
K ^TMP($J,"RCRJRCORMM") ; used to build mailman message
"RTN","RCRJRCOR",177,0)
;
"RTN","RCRJRCOR",178,0)
; print any test patient bills which have not been closed
"RTN","RCRJRCOR",179,0)
S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJRCOL","CRIT2",1,BILLDA)) Q:'BILLDA I $D(^(BILLDA,1)) D
"RTN","RCRJRCOR",180,0)
. S DATA0=$G(^PRCA(430,BILLDA,0)),STAT=$P(DATA0,"^",8)
"RTN","RCRJRCOR",181,0)
. I STAT'=16,STAT='42 Q ; bill not currently open
"RTN","RCRJRCOR",182,0)
. S DFN=+$P(DATA0,"^",7) I 'DFN Q
"RTN","RCRJRCOR",183,0)
. D PID^VADPT
"RTN","RCRJRCOR",184,0)
. I $E($TR($G(VA("PID")),"-"),1,5)="00000" S ^TMP($J,"RCRJRCOR","TEST",BILLDA)=""
"RTN","RCRJRCOR",185,0)
;
"RTN","RCRJRCOR",186,0)
I '$D(^TMP($J,"RCRJRCOR","TEST")) Q
"RTN","RCRJRCOR",187,0)
;
"RTN","RCRJRCOR",188,0)
; print data
"RTN","RCRJRCOR",189,0)
S LINE=0
"RTN","RCRJRCOR",190,0)
D SET(" ")
"RTN","RCRJRCOR",191,0)
D SET("The following bills are active and linked to test patients:")
"RTN","RCRJRCOR",192,0)
S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJRCOR","TEST",BILLDA)) Q:'BILLDA D SET(" "_$P($G(^PRCA(430,BILLDA,0)),"^")_" (#",BILLDA_")")
"RTN","RCRJRCOR",193,0)
;
"RTN","RCRJRCOR",194,0)
S XMY("G.RC AR DATA COLLECTOR")=""
"RTN","RCRJRCOR",195,0)
S %=$$SENDMSG("MCCR DATA COLLECTOR INFORMATION",.XMY)
"RTN","RCRJRCOR",196,0)
K ^TMP($J,"RCRJRCOR")
"RTN","RCRJRCOR",197,0)
K ^TMP($J,"RCRJRCORMM")
"RTN","RCRJRCOR",198,0)
Q
"RTN","RCRJRCOR",199,0)
;
"RTN","RCRJRCOR",200,0)
;
"RTN","RCRJRCOR",201,0)
SET(DATA) ; store report
"RTN","RCRJRCOR",202,0)
S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
"RTN","RCRJRCOR",203,0)
Q
"RTN","RCRJRCOR",204,0)
;
"RTN","RCRJRCOR",205,0)
;
"RTN","RCRJRCOR",206,0)
SENDMSG(XMSUB,XMY) ; send message with subject and recipients
"RTN","RCRJRCOR",207,0)
N %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
"RTN","RCRJRCOR",208,0)
S XMDUZ="AR PACKAGE",XMTEXT="^TMP($J,""RCRJRCORMM"","
"RTN","RCRJRCOR",209,0)
D ^XMD
"RTN","RCRJRCOR",210,0)
Q +$G(XMZ)
"RTN","RCRJRCOU")
0^10^B143024308
"RTN","RCRJRCOU",1,0)
RCRJRCOU ;WISC/RFJ-ar data collector summary report ;1 Mar 97
"RTN","RCRJRCOU",2,0)
;;4.5;Accounts Receivable;**103,320,335,338,351**;Mar 20, 1995;Build 14
"RTN","RCRJRCOU",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","RCRJRCOU",4,0)
Q
"RTN","RCRJRCOU",5,0)
; IA - 4398 FIRST^VAUTOMA
"RTN","RCRJRCOU",6,0)
; 4385 $$MRATYPE^IBCEMU2
"RTN","RCRJRCOU",7,0)
;
"RTN","RCRJRCOU",8,0)
;
"RTN","RCRJRCOU",9,0)
;ARDC detailed report - Modified to print directly as per PRCA*4.5*320 (HAPE FY16 RRE)
"RTN","RCRJRCOU",10,0)
; a MailMan message is no longer generated by this routine !
"RTN","RCRJRCOU",11,0)
; Called by VistA Option - PRCA ARDC REPORT (ARDC Detail Report)
"RTN","RCRJRCOU",12,0)
;
"RTN","RCRJRCOU",13,0)
START ; Entry point from the Option
"RTN","RCRJRCOU",14,0)
N VAUTSTR,VAUTNI,DIC,Y,SCREEN,EXCEL,VAUTC,QUIT,DTFRMTO,BGDT,RCSTDT
"RTN","RCRJRCOU",15,0)
;
"RTN","RCRJRCOU",16,0)
S QUIT=0
"RTN","RCRJRCOU",17,0)
N TXT,MSG F TXT=1:1:12 S MSG=$T(MENU+TXT) W !,?5,$P(MSG,";;",2)
"RTN","RCRJRCOU",18,0)
S SCREEN="^16^18^32^33^40^42^",DIC="^PRCA(430.3,",VAUTNI=2,VAUTSTR="Status",VAUTVB="VAUTC",DIC("S")="I SCREEN[(U_Y_U)" D FIRST^VAUTOMA
"RTN","RCRJRCOU",19,0)
I VAUTC=1 F I=2:1:7 S VAUTC($P(SCREEN,U,I))=$P(^PRCA(430.3,$P(SCREEN,U,I),0),U) ;set array equal to the screen if ALL was selected
"RTN","RCRJRCOU",20,0)
Q:'$D(VAUTC)!(Y=-1)
"RTN","RCRJRCOU",21,0)
N TXT,MSG W ! F TXT=1:1:12 S MSG=$T(DESCTEXT+TXT) W !,?3,$P(MSG,";;",2)
"RTN","RCRJRCOU",22,0)
W !!,?10,"<< Checking available dates. Please wait >>"
"RTN","RCRJRCOU",23,0)
D FIRST ;Get earliest date for selected Status
"RTN","RCRJRCOU",24,0)
W !!,"The earliest date on file for selected status is: ",$G(BGDT)
"RTN","RCRJRCOU",25,0)
S DTFRMTO=$$DTFRMTO Q:'DTFRMTO ;Get date range for report
"RTN","RCRJRCOU",26,0)
S EXCEL=0,PROMPT="CAPTURE Report data to an Excel Document?",DIR(0)="Y",DIR("?")="^D HEXC^RCRJRCOU"
"RTN","RCRJRCOU",27,0)
S EXCEL=$$SELECT^RCTCSJR(PROMPT,"NO") I "01"'[EXCEL Q
"RTN","RCRJRCOU",28,0)
I EXCEL=1 D EXCMSG^RCTCSJR ; Display Excel display message
"RTN","RCRJRCOU",29,0)
I 'EXCEL W !!,"This report requires 132 characters",!
"RTN","RCRJRCOU",30,0)
K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="" D ^%ZIS Q:POP
"RTN","RCRJRCOU",31,0)
I $D(IO("Q")) D Q
"RTN","RCRJRCOU",32,0)
.S ZTDESC="ARDC Detail Report",ZTRTN="DQ^RCRJRCOU"
"RTN","RCRJRCOU",33,0)
.S ZTSAVE("VAUTC*")="",ZTSAVE("RCRET")="",ZTSAVE("DTFRMTO")="",ZTSAVE("ZTREQ")="@",ZTSAVE("EXCEL")=""
"RTN","RCRJRCOU",34,0)
.D ^%ZTLOAD,HOME^%ZIS S QUIT=1
"RTN","RCRJRCOU",35,0)
W !!,"<*> please wait <*>"
"RTN","RCRJRCOU",36,0)
;
"RTN","RCRJRCOU",37,0)
DQ ; generate user detailed report
"RTN","RCRJRCOU",38,0)
N DATEEND,RCDATE,BILLDA,DATA,RCLINE,REPTDATA,Y,RCBILLN,RCDTAC,RCCAT,RCSTAT,TRANTYP,RCTOT,RCPRIN,RCRSC,PRCASITE,VAUTVB,XMNOW
"RTN","RCRJRCOU",39,0)
N STAT,BILLDA,RCRSC,RECORD,RCBAL,ARACTDT,DATEMOYR,MRATYPE,POP,RCFUND,RCOTHER,TYPE,RCOUT,CURDT,DTFRM,DTFROM,DTTO,RCRET,LIST,ERR
"RTN","RCRJRCOU",40,0)
N RCACCRD,RCRHITYP
"RTN","RCRJRCOU",41,0)
;
"RTN","RCRJRCOU",42,0)
S (RCDATE,DTFRM)=$$FMADD^XLFDT(+$P(DTFRMTO,U,2)),DTTO=$P(DTFRMTO,U,3),CURDT=0
"RTN","RCRJRCOU",43,0)
S XMNOW=$$NOW^XLFDT ;Capture the date and time the report was started for the header
"RTN","RCRJRCOU",44,0)
S DATEEND=$$LDATE^RCRJR(DT),DATEMOYR=$E(DATEEND,1,5)_"00"
"RTN","RCRJRCOU",45,0)
S PRCASITE=$$SITE^RCMSITE
"RTN","RCRJRCOU",46,0)
S RCRET=$NA(^TMP($J,"RCRJRCOU")) K @RCRET
"RTN","RCRJRCOU",47,0)
;
"RTN","RCRJRCOU",48,0)
S (RCLINE,STAT)=0 F S STAT=$O(VAUTC(STAT)) Q:'STAT S RCDATE=DTFRM D
"RTN","RCRJRCOU",49,0)
. S BILLDA=0 F S BILLDA=$O(^PRCA(430,"AC",STAT,BILLDA)) Q:'BILLDA D
"RTN","RCRJRCOU",50,0)
..Q:$P(^PRCA(430,BILLDA,0),U,10)=""
"RTN","RCRJRCOU",51,0)
..Q:$P(^PRCA(430,BILLDA,0),U,8)'=STAT ;Quit if the Current Status from the xref is incorrect
"RTN","RCRJRCOU",52,0)
..S RCDATE=$P(^PRCA(430,BILLDA,0),U,10)
"RTN","RCRJRCOU",53,0)
..Q:RCDATE<DTFRM!(RCDATE>DTTO)
"RTN","RCRJRCOU",54,0)
.. ;As per email from the VA - We need to see all bills, not just accrued bills.
"RTN","RCRJRCOU",55,0)
.. ;I $$ACCK^PRCAACC(BILLDA),$P($G(^PRCA(430,BILLDA,0)),"^",2)'=26 D ;from CURRENT^RCRJRCOC
"RTN","RCRJRCOU",56,0)
.. ;
"RTN","RCRJRCOU",57,0)
.. I $P($G(^PRCA(430,BILLDA,0)),"^",2)'=26 D ;from CURRENT^RCRJRCOC
"RTN","RCRJRCOU",58,0)
... S DATA=$G(^PRCA(430,BILLDA,0)) Q:'DATA
"RTN","RCRJRCOU",59,0)
... S (TYPE,TRANTYP,RCRSC,RCFUND,RCPRIN)="",RCBAL=0
"RTN","RCRJRCOU",60,0)
... ; bill number
"RTN","RCRJRCOU",61,0)
... ;S RCBILLN=$P($P(DATA,"^"),"-",2)
"RTN","RCRJRCOU",62,0)
... S RCBILLN=$P(DATA,"^")
"RTN","RCRJRCOU",63,0)
... ; date activated
"RTN","RCRJRCOU",64,0)
... S RCDTAC=$$FMTE^XLFDT(RCDATE,"2Z")
"RTN","RCRJRCOU",65,0)
... ; category
"RTN","RCRJRCOU",66,0)
... S RCCAT=$P($G(^PRCA(430.2,+$P(DATA,"^",2),0)),"^")
"RTN","RCRJRCOU",67,0)
... S RCACCRD=$$GET1^DIQ(430.2,+$P(DATA,"^",2)_",",12,"I")
"RTN","RCRJRCOU",68,0)
... ; status
"RTN","RCRJRCOU",69,0)
... S RCSTAT=$P($G(^PRCA(430.3,+$P(DATA,"^",8),0)),"^")
"RTN","RCRJRCOU",70,0)
... ;PRCA*4.5*338 - re-wrote section to correctly retrieve RSCs, properly ID TRICARE, CHAMPVA BD doc types, and TORT/MRA SV doc types
"RTN","RCRJRCOU",71,0)
... ; - grab fund and RSC from Bill instead of recalculating. Recalculate only if they are NULL
"RTN","RCRJRCOU",72,0)
... S RCRSC=$$GET1^DIQ(430,BILLDA_",",255,"I")
"RTN","RCRJRCOU",73,0)
... S:RCRSC="" RCRSC=$$GET1^DIQ(430,BILLDA_",",255.1)
"RTN","RCRJRCOU",74,0)
... I $$ACCK^PRCAACC(BILLDA) S:RCRSC="" RCRSC=$$CALCRSC^RCXFMSUR(BILLDA) ; (as per CURRENT^RCRJRCOC)
"RTN","RCRJRCOU",75,0)
... ;Fund
"RTN","RCRJRCOU",76,0)
... S RCFUND=$$GET1^DIQ(430,BILLDA_",",203)
"RTN","RCRJRCOU",77,0)
... I RCFUND="" S RCFUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
"RTN","RCRJRCOU",78,0)
... S TYPE="SV21" ; Default the doc type.
"RTN","RCRJRCOU",79,0)
... ; special type for tort feasor
"RTN","RCRJRCOU",80,0)
... I RCCAT["TORT" S TYPE="2A" ;Using the category name to look for TORTs
"RTN","RCRJRCOU",81,0)
... ; Get AR Date Active for bill
"RTN","RCRJRCOU",82,0)
... S ARACTDT=+$P($P($G(^PRCA(430,BILLDA,6)),"^",21),".") ; (as per START^RCRJRBD)
"RTN","RCRJRCOU",83,0)
... ; determine Receivable Type: 1=pre-MRA, 2=post-MRA Medicre, 3=post-MRA non-Medicare
"RTN","RCRJRCOU",84,0)
... ; fms report type - TRANTYP variable
"RTN","RCRJRCOU",85,0)
... S MRATYPE=$$MRATYPE^IBCEMU2(BILLDA,ARACTDT) ; (as per CURRENT^RCRJRCOC)
"RTN","RCRJRCOU",86,0)
... ; Set TYPE to 2F for post-MRA Medicare bills or to 2L for post-MRA non-Medicare bills (for RHI receivables only)
"RTN","RCRJRCOU",87,0)
... ; Moved TYPE set for RHI to function call to ensure Community Care RSCs are captured correctly.
"RTN","RCRJRCOU",88,0)
... S RCRHITYP=$$RHITYPE^RCRJRCOC(RCRSC,MRATYPE,RCCAT) S:+RCRHITYP TYPE=$P(RCRHITYP,U,2)
"RTN","RCRJRCOU",89,0)
... I 'RCACCRD S TYPE="BD" ; Non accrued have BD FMS doc types.
"RTN","RCRJRCOU",90,0)
... S TRANTYP=$G(TYPE),REPTDATA=""
"RTN","RCRJRCOU",91,0)
... K LIST D FIND^DIC(430,,"@;71;11;IX","M","`"_BILLDA,,,,,"LIST","ERR")
"RTN","RCRJRCOU",92,0)
... S RCPRIN=$G(LIST("DILIST","ID",1,71)),RCBAL=$G(LIST("DILIST","ID",1,11))
"RTN","RCRJRCOU",93,0)
... I RCBAL'>0 Q ;Don't show if current balance not greater than $0
"RTN","RCRJRCOU",94,0)
... S RCPRIN=$J(RCPRIN,9,2),RCBAL=$J(RCBAL,10,2)
"RTN","RCRJRCOU",95,0)
... S RCLINE=RCLINE+1 ;(record counter)
"RTN","RCRJRCOU",96,0)
... S @RCRET@(RCLINE)=RCBILLN_U_RCDTAC_U_RCCAT_U_RCSTAT_U_TRANTYP_U_RCFUND_U_RCRSC_U_RCPRIN_U_RCBAL
"RTN","RCRJRCOU",97,0)
; end of gathering data
"RTN","RCRJRCOU",98,0)
;
"RTN","RCRJRCOU",99,0)
I RCLINE=0 W !!,"***The report found no receivables that match your selection***",!! G EXIT
"RTN","RCRJRCOU",100,0)
;
"RTN","RCRJRCOU",101,0)
D PRINT
"RTN","RCRJRCOU",102,0)
;
"RTN","RCRJRCOU",103,0)
EXIT ;commom exit point
"RTN","RCRJRCOU",104,0)
D ^%ZISC
"RTN","RCRJRCOU",105,0)
K ^TMP($J,"RCRJRCOU")
"RTN","RCRJRCOU",106,0)
Q
"RTN","RCRJRCOU",107,0)
;
"RTN","RCRJRCOU",108,0)
HDR ;Set the header
"RTN","RCRJRCOU",109,0)
;
"RTN","RCRJRCOU",110,0)
S PAGE=PAGE+1 U IO W @IOF
"RTN","RCRJRCOU",111,0)
I 'EXCEL W ?14,"ARDC Detailed Report",?50,"Run Date: ",$$FMTE^XLFDT(XMNOW,"2Z"),?107,"Page:",PAGE,!
"RTN","RCRJRCOU",112,0)
I EXCEL W U_"ARDC Detailed Report"_U_U_"Run Date: "_$$FMTE^XLFDT(XMNOW,"2Z")_U_U_U_U_"Page:"_PAGE,!
"RTN","RCRJRCOU",113,0)
N I F I=1:1:120 W "-"
"RTN","RCRJRCOU",114,0)
I 'EXCEL W !,"Bill#",?14,"Create",?26,"AR Category",?50,"Bill",?68,"FMS",?75,"Fund",?84,"RSC",?93,"Principal",?107,"Current"
"RTN","RCRJRCOU",115,0)
I 'EXCEL W !,?14,"Date",?50,"Status",?75,"Type",?96,"Amount",?107,"Balance",!
"RTN","RCRJRCOU",116,0)
I EXCEL W !,"Bill#"_U_"Create"_U_"AR Category"_U_"Bill"_U_"FMS"_U_"Fund"_U_"RSC"_U_"Principal"_U_"Current"
"RTN","RCRJRCOU",117,0)
I EXCEL W !,U_"Date"_U_U_"Status"_U_U_"Type"_U_U_"Amount"_U_"Balance",!
"RTN","RCRJRCOU",118,0)
N I F I=1:1:120 W "-"
"RTN","RCRJRCOU",119,0)
Q
"RTN","RCRJRCOU",120,0)
;
"RTN","RCRJRCOU",121,0)
PRINT ; print records to screen or printer
"RTN","RCRJRCOU",122,0)
N PAGE S (RCOUT,PAGE)=0,RECORD=0
"RTN","RCRJRCOU",123,0)
F S RECORD=$O(@RCRET@(RECORD)) Q:'RECORD!(RCOUT) D
"RTN","RCRJRCOU",124,0)
. I RECORD=1 D HDR
"RTN","RCRJRCOU",125,0)
. I 'EXCEL,$Y+3>IOSL I ($E(IOST,1,2)="C-")&(IO=IO(0)) S DIR(0)="E" D ^DIR K DIR D
"RTN","RCRJRCOU",126,0)
.. I $D(DTOUT)!($D(DUOUT)) S RCOUT=1 G EXIT
"RTN","RCRJRCOU",127,0)
.. D HDR
"RTN","RCRJRCOU",128,0)
. Q:RCOUT
"RTN","RCRJRCOU",129,0)
. I 'EXCEL W !,$P(@RCRET@(RECORD),U),?14,$P(@RCRET@(RECORD),U,2),?26,$E($P(@RCRET@(RECORD),U,3),1,20),?50,$E($P(@RCRET@(RECORD),U,4),1,15),?68,$P(@RCRET@(RECORD),U,5)
"RTN","RCRJRCOU",130,0)
. I 'EXCEL W ?75,$P(@RCRET@(RECORD),U,6),?84,$P(@RCRET@(RECORD),U,7),?92,$P(@RCRET@(RECORD),U,8),?104,$P(@RCRET@(RECORD),U,9)
"RTN","RCRJRCOU",131,0)
. I EXCEL W !,$P(@RCRET@(RECORD),U)_U_$P(@RCRET@(RECORD),U,2)_U_$P(@RCRET@(RECORD),U,3)_U_$P(@RCRET@(RECORD),U,4)_U_$P(@RCRET@(RECORD),U,5)
"RTN","RCRJRCOU",132,0)
. I EXCEL W U_$P(@RCRET@(RECORD),U,6)_U_$P(@RCRET@(RECORD),U,7)_U_$P(@RCRET@(RECORD),U,8)_U_$P(@RCRET@(RECORD),U,9)
"RTN","RCRJRCOU",133,0)
I 'EXCEL,$E(IOST,1,2)="C-" R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
"RTN","RCRJRCOU",134,0)
Q
"RTN","RCRJRCOU",135,0)
;
"RTN","RCRJRCOU",136,0)
DTFRMTO(PROMPT) ;Get from and to dates (added as per PRCA*4.5*320 to be able to sort by dates for reports)
"RTN","RCRJRCOU",137,0)
N %DT,Y,X,BEGDT,ENDDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT,STATUS,BDT,STDT,STATUS
"RTN","RCRJRCOU",138,0)
;INPUT ; PROMPT - Message to display prior to prompting for dates
"RTN","RCRJRCOU",139,0)
;OUTPUT: 1^BEGDT^ENDDT - Data found
"RTN","RCRJRCOU",140,0)
; 0 - User up arrowed or timed out
"RTN","RCRJRCOU",141,0)
;If they want to show first available date for that set of Status, use this sub
"RTN","RCRJRCOU",142,0)
S OUT=0
"RTN","RCRJRCOU",143,0)
;W !,$G(PROMPT)
"RTN","RCRJRCOU",144,0)
S %DT="AEX",%DT("A")="Date Range: FROM: " ;Enter Beginning Date: "
"RTN","RCRJRCOU",145,0)
W ! D ^%DT K %DT
"RTN","RCRJRCOU",146,0)
I Y<0 W !!,"No Date selected, quitting. ",!! Q OUT ;Quit if user time out or didn't enter valid date
"RTN","RCRJRCOU",147,0)
S DTFROM=+Y,%DT="AEX",%DT("A")=" TO: ",%DT("B")="T" ;"TODAY"
"RTN","RCRJRCOU",148,0)
D ^%DT
"RTN","RCRJRCOU",149,0)
K %DT
"RTN","RCRJRCOU",150,0)
;Quit if user time out or didn't enter valid date
"RTN","RCRJRCOU",151,0)
I Y<0 W !!,"No Date selected, quitting. ",!! Q OUT
"RTN","RCRJRCOU",152,0)
S DTTO=+Y,OUT=1_U_DTFROM_U_DTTO
"RTN","RCRJRCOU",153,0)
;Switch dates if Begin Date is more recent than End Date
"RTN","RCRJRCOU",154,0)
S:DTFROM>DTTO OUT=1_U_DTTO_U_DTFROM
"RTN","RCRJRCOU",155,0)
Q OUT
"RTN","RCRJRCOU",156,0)
;
"RTN","RCRJRCOU",157,0)
HEXC ; - 'Do you want to capture data to EXCEL' prompt
"RTN","RCRJRCOU",158,0)
W !!," Enter: 'Y' - To capture detail report data to transfer"
"RTN","RCRJRCOU",159,0)
W !," to an Excel document"
"RTN","RCRJRCOU",160,0)
W !," '<CR>' - To skip this option"
"RTN","RCRJRCOU",161,0)
W !," '^' - To quit this option"
"RTN","RCRJRCOU",162,0)
Q
"RTN","RCRJRCOU",163,0)
FIRST ; Get 1st available date for selected status
"RTN","RCRJRCOU",164,0)
N RCBILL
"RTN","RCRJRCOU",165,0)
S STATUS=0,(RCBILL,BDT)="" F S STATUS=$O(VAUTC(STATUS)) Q:STATUS="" D
"RTN","RCRJRCOU",166,0)
. S RCBILL=0 F S RCBILL=$O(^PRCA(430,"AC",STATUS,RCBILL)) Q:'RCBILL D
"RTN","RCRJRCOU",167,0)
.. Q:$P($G(^PRCA(430,RCBILL,0)),U,10)=""
"RTN","RCRJRCOU",168,0)
.. S RCSTDT=$P($G(^PRCA(430,RCBILL,0)),U,10)
"RTN","RCRJRCOU",169,0)
.. I $G(BDT)="" S BDT=RCSTDT Q
"RTN","RCRJRCOU",170,0)
.. I RCSTDT<+BDT S BDT=RCSTDT_U_STATUS ;Use earliest available date
"RTN","RCRJRCOU",171,0)
;
"RTN","RCRJRCOU",172,0)
S BGDT=$S(BDT'="":$$FMTE^XLFDT(+BDT,"Z2"),1:"No records on file")
"RTN","RCRJRCOU",173,0)
Q
"RTN","RCRJRCOU",174,0)
MENU ; Selection menu
"RTN","RCRJRCOU",175,0)
;;
"RTN","RCRJRCOU",176,0)
;;
"RTN","RCRJRCOU",177,0)
;;ARDC Detail Report, please select the status desired below:
"RTN","RCRJRCOU",178,0)
;;
"RTN","RCRJRCOU",179,0)
;; AC - ACTIVE(16)
"RTN","RCRJRCOU",180,0)
;; N - NEW BILL(18)
"RTN","RCRJRCOU",181,0)
;; R - RETURNED FOR AMENDMENT(32)
"RTN","RCRJRCOU",182,0)
;; AM - AMENDED BILL(33)
"RTN","RCRJRCOU",183,0)
;; S - SUSPENDED(40)
"RTN","RCRJRCOU",184,0)
;; O - OPEN(42)
"RTN","RCRJRCOU",185,0)
;; ALL of the above (Default, press enter)
"RTN","RCRJRCOU",186,0)
;;
"RTN","RCRJRCOU",187,0)
Q
"RTN","RCRJRCOU",188,0)
DESCTEXT ;
"RTN","RCRJRCOU",189,0)
;; This report was originally generated from the monthly background
"RTN","RCRJRCOU",190,0)
;; process and generated a MailMan message. It can now only be run
"RTN","RCRJRCOU",191,0)
;; manually through this option. The new data does not contain bills
"RTN","RCRJRCOU",192,0)
;; that have been previously closed out. Note that when running the
"RTN","RCRJRCOU",193,0)
;; new report, only specific AR current status are available.
"RTN","RCRJRCOU",194,0)
;; There will be a note that displays the oldest bill in VistA
"RTN","RCRJRCOU",195,0)
;; associated with these statuses for users to know which date
"RTN","RCRJRCOU",196,0)
;; MUST be entered into the "FROM:" prompt for monthly
"RTN","RCRJRCOU",197,0)
;; reconciliation reporting.
"RTN","RCRJRCOU",198,0)
;; Different dates can be entered for other types of audits.
"RTN","RCRJRCOU",199,0)
;;
"RTN","RCRJRCOU",200,0)
;; Please run after hours when possible.
"RTN","RCRJRCOU",201,0)
;;
"RTN","RCRJRCOU",202,0)
Q
"RTN","RCRJRCOU",203,0)
;
"RTN","RCRJRCOU",204,0)
STORE(BILLDA,DATEBEG,DATEEND,ARACTDT,CATEGORY,TYPE,RCFUND,RCRSC,RCVALUE,SCREEN) ;
"RTN","RCRJRCOU",205,0)
;called by ^RCRJRCOC to store the bills in the AR DEBT COLLECTOR DATA (430.7) file.
"RTN","RCRJRCOU",206,0)
; BILLDA - IEN of 430
"RTN","RCRJRCOU",207,0)
; DATEBEG - Beginning date of accounting month
"RTN","RCRJRCOU",208,0)
; DATEEND - Ending date of accouting month
"RTN","RCRJRCOU",209,0)
; ARACTDT - Date account activitated
"RTN","RCRJRCOU",210,0)
; CATEGORY - Category of bill (pointer)
"RTN","RCRJRCOU",211,0)
; TYPE - FMS Document Type (include SV or whatever)
"RTN","RCRJRCOU",212,0)
; RCFUND - Fund
"RTN","RCRJRCOU",213,0)
; RCRSC - Revenue Source Code
"RTN","RCRJRCOU",214,0)
; RCVALUE - value of bill prin ^ int ^ admin ^ mf ^ cc
"RTN","RCRJRCOU",215,0)
; SCREEN - data from OIG routine needs to be screened
"RTN","RCRJRCOU",216,0)
;
"RTN","RCRJRCOU",217,0)
N RCREPORT,RCDR,RCZERO,RCLIST,DIE,DR,DA,X,Y,RCDA,RCSTAT
"RTN","RCRJRCOU",218,0)
;
"RTN","RCRJRCOU",219,0)
Q:'$G(DATEBEG)!('$G(DATEEND))!('$G(BILLDA))
"RTN","RCRJRCOU",220,0)
S RCSTAT=$P(^PRCA(430,BILLDA,0),"^",8)
"RTN","RCRJRCOU",221,0)
I $G(SCREEN) Q:RCSTAT'=16&(RCSTAT'=40) ; only active and suspended
"RTN","RCRJRCOU",222,0)
;
"RTN","RCRJRCOU",223,0)
; Add .01 top file level entry if it doesn't exist
"RTN","RCRJRCOU",224,0)
S RCREPORT=$O(^PRCA(430.7,"B",$E(DATEEND,1,5)_"00",0)) I 'RCREPORT D
"RTN","RCRJRCOU",225,0)
. N DO,DIC,X,Y,RCKEEP,RCPURGE
"RTN","RCRJRCOU",226,0)
. S DIC="^PRCA(430.7,",DIC(0)="",X=$E(DATEEND,1,5)_"00"
"RTN","RCRJRCOU",227,0)
. S DIC("DR")=.02_"////"_DATEBEG_";.03////"_DATEEND
"RTN","RCRJRCOU",228,0)
. D FILE^DICN
"RTN","RCRJRCOU",229,0)
. S RCREPORT=+Y
"RTN","RCRJRCOU",230,0)
. ; purge any reports more than 3 months old
"RTN","RCRJRCOU",231,0)
. S RCKEEP=$E($$FMADD^XLFDT(DATEEND,-65),1,5)_"00",RCPURGE=0
"RTN","RCRJRCOU",232,0)
. F S RCPURGE=$O(^PRCA(430.7,"B",RCPURGE)) Q:'RCPURGE!(RCPURGE'<RCKEEP) D
"RTN","RCRJRCOU",233,0)
.. N DIK,DA
"RTN","RCRJRCOU",234,0)
.. S DIK="^PRCA(430.7,",DA=$O(^PRCA(430.7,"B",RCPURGE,0))
"RTN","RCRJRCOU",235,0)
.. D ^DIK
"RTN","RCRJRCOU",236,0)
; update last date
"RTN","RCRJRCOU",237,0)
S DIE="^PRCA(430.7,",DA=RCREPORT,DR=".04////"_$$NOW^XLFDT D ^DIE
"RTN","RCRJRCOU",238,0)
;
"RTN","RCRJRCOU",239,0)
; determine data for the bill
"RTN","RCRJRCOU",240,0)
S RCDR(.02)=ARACTDT ; date bill activitated
"RTN","RCRJRCOU",241,0)
S RCDR(.03)=CATEGORY ; AR Cateogry
"RTN","RCRJRCOU",242,0)
S RCDR(.04)=RCSTAT ; AR Status
"RTN","RCRJRCOU",243,0)
S:TYPE'="" RCDR(.05)=TYPE ; fms type
"RTN","RCRJRCOU",244,0)
S RCDR(.06)=RCFUND ; Fund Type
"RTN","RCRJRCOU",245,0)
S RCDR(.07)=RCRSC ; Revenue Source Code
"RTN","RCRJRCOU",246,0)
S RCDR(.08)=+RCVALUE ; Principal Amount
"RTN","RCRJRCOU",247,0)
S RCDR(.09)=RCVALUE+$P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5) ; Current Balance
"RTN","RCRJRCOU",248,0)
;
"RTN","RCRJRCOU",249,0)
; Check for new or update entry
"RTN","RCRJRCOU",250,0)
S RCDA=$O(^PRCA(430.7,RCREPORT,1,"B",BILLDA,0))
"RTN","RCRJRCOU",251,0)
I 'RCDA D Q
"RTN","RCRJRCOU",252,0)
. ; add new entry
"RTN","RCRJRCOU",253,0)
. N DO,DIC,X,Y,DA
"RTN","RCRJRCOU",254,0)
. S DIC="^PRCA(430.7,"_RCREPORT_",1,",DIC(0)="",DA(1)=RCREPORT,X=BILLDA
"RTN","RCRJRCOU",255,0)
. S DIC("DR")="",X=0
"RTN","RCRJRCOU",256,0)
. F S X=$O(RCDR(X)) Q:'X S DIC("DR")=DIC("DR")_X_"////"_RCDR(X)_";"
"RTN","RCRJRCOU",257,0)
. S DIC("DR")=$E(DIC("DR"),1,$L(DIC("DR"))-1)
"RTN","RCRJRCOU",258,0)
. S X=BILLDA
"RTN","RCRJRCOU",259,0)
. D FILE^DICN
"RTN","RCRJRCOU",260,0)
;
"RTN","RCRJRCOU",261,0)
; update entry (if it already exited)
"RTN","RCRJRCOU",262,0)
S DIE="^PRCA(430.7,"_RCREPORT_",1,",DA=RCDA,DA(1)=RCREPORT
"RTN","RCRJRCOU",263,0)
S DR="",X=0
"RTN","RCRJRCOU",264,0)
F S X=$O(RCDR(X)) Q:'X S DR=DR_X_"////"_RCDR(X)_";"
"RTN","RCRJRCOU",265,0)
S DR=$E(DR,1,$L(DR)-1) D:'$G(SCREEN) ^DIE
"RTN","RCRJRCOU",266,0)
Q
"RTN","RCRJRCOU",267,0)
;
"RTN","RCRJRCOU",268,0)
EN ; option entry point to run the report
"RTN","RCRJRCOU",269,0)
N RCREPORT,EXCEL,RCPROMPT,X,Y,DTOUT,DUOUT,DIR,ZTDESC,ZTSAVE,ZTRTN,ZTSK
"RTN","RCRJRCOU",270,0)
;
"RTN","RCRJRCOU",271,0)
W !,"Select which accounting month/year for the ARDC Report"
"RTN","RCRJRCOU",272,0)
S DIC="^PRCA(430.7,",DIC(0)="AEMNQ" D ^DIC Q:Y<1
"RTN","RCRJRCOU",273,0)
S RCREPORT=+Y
"RTN","RCRJRCOU",274,0)
S EXCEL=0,RCPROMPT="CAPTURE Report data to an Excel Document?",DIR(0)="Y",DIR("?")="^D HEXC^RCRJRCOU"
"RTN","RCRJRCOU",275,0)
S EXCEL=$$SELECT^RCTCSJR(RCPROMPT,"NO") I "01"'[EXCEL Q
"RTN","RCRJRCOU",276,0)
I EXCEL=1 D EXCMSG^RCTCSJR ; Display Excel display message
"RTN","RCRJRCOU",277,0)
I 'EXCEL W !!,"This report requires 132 characters",!
"RTN","RCRJRCOU",278,0)
K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="" D ^%ZIS Q:POP
"RTN","RCRJRCOU",279,0)
I $D(IO("Q")) D Q
"RTN","RCRJRCOU",280,0)
.S ZTDESC="ARDC Detail Report",ZTRTN="DQQ^RCRJRCOU"
"RTN","RCRJRCOU",281,0)
.S (ZTSAVE("RC*"),ZTSAVE("EXCEL"))="",ZTSAVE("ZTREQ")="@"
"RTN","RCRJRCOU",282,0)
.D ^%ZTLOAD,HOME^%ZIS S QUIT=1
"RTN","RCRJRCOU",283,0)
;
"RTN","RCRJRCOU",284,0)
DQQ ; Print the report
"RTN","RCRJRCOU",285,0)
N XMNOW,PAGE,RCOUT,RCREC,RCSP
"RTN","RCRJRCOU",286,0)
S XMNOW=$$NOW^XLFDT ;Capture the date and time the report was started for the header
"RTN","RCRJRCOU",287,0)
S (RCOUT,PAGE)=0
"RTN","RCRJRCOU",288,0)
S RCREC=0 F S RCREC=$O(^PRCA(430.7,RCREPORT,1,RCREC)) Q:'RCREC!(RCOUT) D
"RTN","RCRJRCOU",289,0)
. N RCARRAY
"RTN","RCRJRCOU",290,0)
. I PAGE<1 D HDR
"RTN","RCRJRCOU",291,0)
. I 'EXCEL,$Y+3>IOSL I ($E(IOST,1,2)="C-")&(IO=IO(0)) S DIR(0)="E" D ^DIR K DIR D
"RTN","RCRJRCOU",292,0)
.. I $D(DTOUT)!($D(DUOUT)) S RCOUT=1 G EXIT
"RTN","RCRJRCOU",293,0)
.. D HDR
"RTN","RCRJRCOU",294,0)
. Q:RCOUT
"RTN","RCRJRCOU",295,0)
. ; extract data from file in external form
"RTN","RCRJRCOU",296,0)
. D GETS^DIQ(430.71,RCREC_","_RCREPORT_",","*","","RCARRAY")
"RTN","RCRJRCOU",297,0)
. S RCSP="0^14^26^50^68^75^84^92^104"
"RTN","RCRJRCOU",298,0)
. W ! F X=.01:.01:.09 D
"RTN","RCRJRCOU",299,0)
.. W:'EXCEL @("?"_$P(RCSP,"^",X*100))
"RTN","RCRJRCOU",300,0)
.. S Y=$S(X=.03:20,X=.04:15,1:999)
"RTN","RCRJRCOU",301,0)
.. W $E($G(RCARRAY(430.71,RCREC_","_RCREPORT_",",X)),1,Y)
"RTN","RCRJRCOU",302,0)
.. I EXCEL,X'=.09 W "^"
"RTN","RCRJRCOU",303,0)
;
"RTN","RCRJRCOU",304,0)
Q
"RTN","RCRJRCOU",305,0)
;
"RTN","RCRJRDEP")
0^4^B68618854
"RTN","RCRJRDEP",1,0)
RCRJRDEP ;WISC/RFJ-Deposit Reconciliation Report ;9/7/10 8:19am
"RTN","RCRJRDEP",2,0)
;;4.5;Accounts Receivable;**101,114,203,220,273,310,338,351**;Mar 20, 1995;Build 14
"RTN","RCRJRDEP",3,0)
;Per VA Directive 6402, this routine should not be modified.
"RTN","RCRJRDEP",4,0)
;
"RTN","RCRJRDEP",5,0)
W !!,"This option will print the Deposit Reconciliation Report. The report will"
"RTN","RCRJRDEP",6,0)
W !,"display the data on the code sheets sent to FMS on the CR document. Only"
"RTN","RCRJRDEP",7,0)
W !,"deposits processed after patch PRCA*4.5*90 was installed can be displayed."
"RTN","RCRJRDEP",8,0)
W !,"Select the starting and ending FMS Document Number without the station"
"RTN","RCRJRDEP",9,0)
W !,"number, example: K8A0346."
"RTN","RCRJRDEP",10,0)
;
"RTN","RCRJRDEP",11,0)
N DEFAULT,RCRJEND,RCRJFXIT,RCRJSTRT,RCRJSUMM,X
"RTN","RCRJRDEP",12,0)
N %,%H,%I,CATEGORY,CHAMPVA,DA,DEPOSDA,DOCTOTAL,FEE,FMSDOCID,FUND,FUNDTOTL,GECSDATA,IO,IOF
"RTN","RCRJRDEP",13,0)
;
"RTN","RCRJRDEP",14,0)
F D Q:$G(RCRJFXIT)
"RTN","RCRJRDEP",15,0)
. R !!,"START WITH CR DOCUMENT: FIRST// ",X:DTIME
"RTN","RCRJRDEP",16,0)
. I X["^" S RCRJFXIT=2 Q
"RTN","RCRJRDEP",17,0)
. I $L(X),$L(X)'=7 W !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)." Q
"RTN","RCRJRDEP",18,0)
. S RCRJSTRT=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","RCRJRDEP",19,0)
. ;
"RTN","RCRJRDEP",20,0)
. S DEFAULT=$S(RCRJSTRT="":" LAST",1:RCRJSTRT)
"RTN","RCRJRDEP",21,0)
. W !," END WITH CR DOCUMENT: ",DEFAULT,"// " R X:DTIME
"RTN","RCRJRDEP",22,0)
. I X["^" S RCRJFXIT=2 Q
"RTN","RCRJRDEP",23,0)
. S RCRJEND=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","RCRJRDEP",24,0)
. I X="LAST" S (RCRJEND,X)="zzzzzzz"
"RTN","RCRJRDEP",25,0)
. I $L(X),$L(X)'=7 W !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)." Q
"RTN","RCRJRDEP",26,0)
. I X="" S RCRJEND=$S(DEFAULT=" LAST":"zzzzzzz",1:DEFAULT)
"RTN","RCRJRDEP",27,0)
. I RCRJEND'=RCRJSTRT,RCRJEND']RCRJSTRT W !?5,"The END CR DOCUMENT should be after (in sequence) the start document." Q
"RTN","RCRJRDEP",28,0)
. S RCRJFXIT=1
"RTN","RCRJRDEP",29,0)
I RCRJFXIT=2 Q
"RTN","RCRJRDEP",30,0)
;
"RTN","RCRJRDEP",31,0)
S RCRJSUMM=$$SUMMARY^RCRJRTRA I 'RCRJSUMM Q
"RTN","RCRJRDEP",32,0)
;
"RTN","RCRJRDEP",33,0)
; select device
"RTN","RCRJRDEP",34,0)
W ! S %ZIS="Q" D ^%ZIS Q:POP
"RTN","RCRJRDEP",35,0)
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
"RTN","RCRJRDEP",36,0)
. S ZTDESC="Deposit Reconciliation Report",ZTRTN="DQ^RCRJRDEP"
"RTN","RCRJRDEP",37,0)
. S ZTSAVE("RCRJ*")="",ZTSAVE("ZTREQ")="@"
"RTN","RCRJRDEP",38,0)
W !!,"<*> please wait <*>"
"RTN","RCRJRDEP",39,0)
;
"RTN","RCRJRDEP",40,0)
DQ ; report (queue) starts here
"RTN","RCRJRDEP",41,0)
N %,%H,%I,CHAMPVA,DA,DEPOSDA,DIQ2,DOCTOTAL,FEE,FMSDOCID,FUND,FUNDTOTL,GECSDATA,LINEDA,LINEDATA,NOW,PAGE,RCDATA,RCRJLAST,RCRJLINE,RCRJFLAG,RECEIPDA,RSC,RSCTOTL,SCREEN,SITE,TOTAL,X,Y
"RTN","RCRJRDEP",42,0)
K ^TMP($J,"RCRJRDEP")
"RTN","RCRJRDEP",43,0)
;
"RTN","RCRJRDEP",44,0)
; build list of fms documents
"RTN","RCRJRDEP",45,0)
S SITE=$$SITE^RCMSITE
"RTN","RCRJRDEP",46,0)
S RCRJLAST="CR-"_SITE_RCRJEND_" "
"RTN","RCRJRDEP",47,0)
;
"RTN","RCRJRDEP",48,0)
; the fms document was previously stored in the deposit file 344.1
"RTN","RCRJRDEP",49,0)
; this code can be removed later on
"RTN","RCRJRDEP",50,0)
; this is the starting document, use 31 to start with select doc first
"RTN","RCRJRDEP",51,0)
S FMSDOCID="CR-"_SITE_RCRJSTRT_$C(31)
"RTN","RCRJRDEP",52,0)
F S FMSDOCID=$O(^RCY(344.1,"ADOC",FMSDOCID)) Q:FMSDOCID=""!(FMSDOCID]RCRJLAST) D
"RTN","RCRJRDEP",53,0)
. S DEPOSDA=+$O(^RCY(344.1,"ADOC",FMSDOCID,0))
"RTN","RCRJRDEP",54,0)
. ; compute deposit (all receipts) total for comparison
"RTN","RCRJRDEP",55,0)
. S TOTAL=0,CHAMPVA=0,FEE=0
"RTN","RCRJRDEP",56,0)
. S RECEIPDA=0 F S RECEIPDA=$O(^RCY(344,"AD",DEPOSDA,RECEIPDA)) Q:'RECEIPDA D
"RTN","RCRJRDEP",57,0)
. . S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA S TOTAL=TOTAL+$P(^(DA,0),"^",5)
"RTN","RCRJRDEP",58,0)
. . S CHAMPVA=CHAMPVA+$$CHAMPVA(RECEIPDA)
"RTN","RCRJRDEP",59,0)
. . S FEE=FEE+$$FEE(RECEIPDA)
"RTN","RCRJRDEP",60,0)
. ; tmp=deposit ^ depositda ^ depositdate ^ ^ ^ ^ deposittotal ^ champvatotal ^ feetotal
"RTN","RCRJRDEP",61,0)
. S ^TMP($J,"RCRJRDEP",FMSDOCID)=$P($G(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$P($G(^RCY(344.1,DEPOSDA,0)),"^",9)_"^^^^"_TOTAL_"^"_CHAMPVA_"^"_FEE
"RTN","RCRJRDEP",62,0)
;
"RTN","RCRJRDEP",63,0)
; the fms document is now stored in the receipt file 344
"RTN","RCRJRDEP",64,0)
S FMSDOCID="CR-"_SITE_RCRJSTRT_$C(31)
"RTN","RCRJRDEP",65,0)
F S FMSDOCID=$O(^RCY(344,"ADOC",FMSDOCID)) Q:FMSDOCID=""!(FMSDOCID]RCRJLAST) D
"RTN","RCRJRDEP",66,0)
. S RECEIPDA=+$O(^RCY(344,"ADOC",FMSDOCID,0))
"RTN","RCRJRDEP",67,0)
. ; compute deposit (all receipts) total for comparison
"RTN","RCRJRDEP",68,0)
. S TOTAL=0
"RTN","RCRJRDEP",69,0)
. ; use the payment amount to pick up suspense deposits
"RTN","RCRJRDEP",70,0)
. S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA S TOTAL=TOTAL+$P(^(DA,0),"^",4)
"RTN","RCRJRDEP",71,0)
. S CHAMPVA=$$CHAMPVA(RECEIPDA)
"RTN","RCRJRDEP",72,0)
. S FEE=$$FEE(RECEIPDA)
"RTN","RCRJRDEP",73,0)
. S DEPOSDA=+$P($G(^RCY(344,RECEIPDA,0)),"^",6)
"RTN","RCRJRDEP",74,0)
. ; tmp=deposit ^ depositda ^ depositdate ^ receipt ^receiptda ^ receipt date ^ receipttotal ^ champvatotal ^ feetotal
"RTN","RCRJRDEP",75,0)
. S ^TMP($J,"RCRJRDEP",FMSDOCID)=$P($G(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$P($G(^RCY(344.1,DEPOSDA,0)),"^",11)_"^"_$P($G(^RCY(344,RECEIPDA,0)),"^")_"^"_RECEIPDA_"^"_$P($G(^RCY(344,RECEIPDA,0)),"^",8)_"^"_TOTAL_"^"_CHAMPVA_"^"_FEE
"RTN","RCRJRDEP",76,0)
;
"RTN","RCRJRDEP",77,0)
; print report
"RTN","RCRJRDEP",78,0)
S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
"RTN","RCRJRDEP",79,0)
S RCRJLINE="",$P(RCRJLINE,"-",81)=""
"RTN","RCRJRDEP",80,0)
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1
"RTN","RCRJRDEP",81,0)
U IO I $G(RCRJSUMM)'=1 D H
"RTN","RCRJRDEP",82,0)
;
"RTN","RCRJRDEP",83,0)
S FMSDOCID="" F S FMSDOCID=$O(^TMP($J,"RCRJRDEP",FMSDOCID)) Q:FMSDOCID=""!($G(RCRJFLAG)) D
"RTN","RCRJRDEP",84,0)
. S RCDATA=^TMP($J,"RCRJRDEP",FMSDOCID)
"RTN","RCRJRDEP",85,0)
. K GECSDATA
"RTN","RCRJRDEP",86,0)
. D DATA^GECSSGET(FMSDOCID,1)
"RTN","RCRJRDEP",87,0)
. I $G(RCRJSUMM)'=1 D Q:$G(RCRJFLAG)
"RTN","RCRJRDEP",88,0)
. . I $Y>(IOSL-7) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
"RTN","RCRJRDEP",89,0)
. . S Y=$P($P(RCDATA,"^",3),".") I Y D DD^%DT
"RTN","RCRJRDEP",90,0)
. . W !,"FMS DOCUMENT: ",FMSDOCID,?34,"DEPOSIT TICKET: ",$P(RCDATA,"^"),?62,"DATE: ",Y
"RTN","RCRJRDEP",91,0)
. . I $P(RCDATA,"^",4)'="" W !?41,"RECEIPT: ",$P(RCDATA,"^",4) S Y=$P($P(RCDATA,"^",6),".") I Y D DD^%DT W ?62,"DATE: ",Y
"RTN","RCRJRDEP",92,0)
. . D H1
"RTN","RCRJRDEP",93,0)
. S DOCTOTAL=0
"RTN","RCRJRDEP",94,0)
. I $D(GECSDATA) S LINEDA=0 F S LINEDA=$O(GECSDATA(2100.1,GECSDATA,10,LINEDA)) Q:'LINEDA!($G(RCRJFLAG)) D
"RTN","RCRJRDEP",95,0)
. . S LINEDATA=GECSDATA(2100.1,GECSDATA,10,LINEDA)
"RTN","RCRJRDEP",96,0)
. . I $E(LINEDATA,1,4)="CR2^" S DOCTOTAL=$P(LINEDATA,"^",15)
"RTN","RCRJRDEP",97,0)
. . I $E(LINEDATA,1,9)'="LIN^~CRA^" Q
"RTN","RCRJRDEP",98,0)
. . I $G(RCRJSUMM)'=1 D
"RTN","RCRJRDEP",99,0)
. . . I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H,H1
"RTN","RCRJRDEP",100,0)
. . . W !?1,$P(LINEDATA,"^",3),?6,$P(LINEDATA,"^",4),?11,$P(LINEDATA,"^",6),?19,$P(LINEDATA,"^",10)
"RTN","RCRJRDEP",101,0)
. . . W ?30,$J($P(LINEDATA,"^",18),8),?40,$E($P(LINEDATA,"^",25),4,10),?50,$J($P(LINEDATA,"^",20),10,2),?64,$J($P(LINEDATA,"^",23),9)
"RTN","RCRJRDEP",102,0)
. . ; totals by fund
"RTN","RCRJRDEP",103,0)
. . S FUND=$P(LINEDATA,"^",6)
"RTN","RCRJRDEP",104,0)
. . I FUND="" S FUND="0160"
"RTN","RCRJRDEP",105,0)
. . S FUNDTOTL(FUND)=$G(FUNDTOTL(FUND))+$P(LINEDATA,"^",20)
"RTN","RCRJRDEP",106,0)
. . ; totals by rsc for the accrued 5287 funds (01,03,04,09,11,13,14)
"RTN","RCRJRDEP",107,0)
. . S RSC=$P(LINEDATA,"^",10)
"RTN","RCRJRDEP",108,0)
. . I RSC'="",($$PTACCT^PRCAACC(FUND)!(FUND=4032)) S RSCTOTL(RSC)=$G(RSCTOTL(RSC))+$P(LINEDATA,"^",20)
"RTN","RCRJRDEP",109,0)
. I $G(RCRJSUMM)=1 Q
"RTN","RCRJRDEP",110,0)
. I $G(RCRJFLAG) Q
"RTN","RCRJRDEP",111,0)
. I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
"RTN","RCRJRDEP",112,0)
. W !?23,"LINE TOTAL/DOCUMENT TOTAL: ",$J(DOCTOTAL,10,2)
"RTN","RCRJRDEP",113,0)
. ; compute receipt total for comparison
"RTN","RCRJRDEP",114,0)
. S TOTAL=$P(RCDATA,"^",7)
"RTN","RCRJRDEP",115,0)
. S CHAMPVA=$P(RCDATA,"^",8)
"RTN","RCRJRDEP",116,0)
. S FEE=$P(RCDATA,"^",9)
"RTN","RCRJRDEP",117,0)
. I CHAMPVA W !?35,"CHAMPVA TOTAL: ",$J(CHAMPVA,10,2)
"RTN","RCRJRDEP",118,0)
. I FEE W !?25,"NON-VA PORTION OF TOTAL: ",$J(FEE,10,2)
"RTN","RCRJRDEP",119,0)
. W !?35,"DEPOSIT TOTAL: ",$J(TOTAL,10,2)
"RTN","RCRJRDEP",120,0)
. ;I (DOCTOTAL+CHAMPVA+FEE)'=TOTAL W !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: **********"
"RTN","RCRJRDEP",121,0)
. I (DOCTOTAL+CHAMPVA)'=TOTAL W !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: **********"
"RTN","RCRJRDEP",122,0)
. W !
"RTN","RCRJRDEP",123,0)
;
"RTN","RCRJRDEP",124,0)
I $G(RCRJFLAG) D Q Q
"RTN","RCRJRDEP",125,0)
I $G(RCRJSUMM)'=1 D:SCREEN PAUSE^RCRJRTR1 I $G(RCRJFLAG) D Q Q
"RTN","RCRJRDEP",126,0)
D H
"RTN","RCRJRDEP",127,0)
; print totals by fund/rsc
"RTN","RCRJRDEP",128,0)
W !!,"TOTAL DEPOSITS BY FUND:"
"RTN","RCRJRDEP",129,0)
S FUND="" F S FUND=$O(FUNDTOTL(FUND)) Q:FUND=""!($G(RCRJFLAG)) D
"RTN","RCRJRDEP",130,0)
. I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !!,"TOTAL DEPOSITS BY FUND:"
"RTN","RCRJRDEP",131,0)
. W !?5,"FUND: ",FUND,?20,$J(FUNDTOTL(FUND),10,2)
"RTN","RCRJRDEP",132,0)
I $G(RCRJFLAG) D Q Q
"RTN","RCRJRDEP",133,0)
I DT<$$ADDPTEDT^PRCAACC() W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 5287.1,5287.3,5287.4:"
"RTN","RCRJRDEP",134,0)
I DT'<$$ADDPTEDT^PRCAACC() W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 528701,528703,528704,528711,528713,528714:"
"RTN","RCRJRDEP",135,0)
S RSC="" F S RSC=$O(RSCTOTL(RSC)) Q:RSC="" D Q:$G(RCRJFLAG)
"RTN","RCRJRDEP",136,0)
. I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF ACCRUED 5287 FUNDS "_$S(DT<$$ADDPTEDT^PRCAACC():"(.1,.3,.4,.9):",1:"(01,03,04,09,11):")
"RTN","RCRJRDEP",137,0)
. W !?5,"RSC: ",RSC,?17,$$GETDESC^RCXFMSPR(RSC),?70,$J(RSCTOTL(RSC),10,2)
"RTN","RCRJRDEP",138,0)
I $G(RCRJFLAG) D Q Q
"RTN","RCRJRDEP",139,0)
I SCREEN R !,"Press RETURN to continue:",X:DTIME
"RTN","RCRJRDEP",140,0)
;
"RTN","RCRJRDEP",141,0)
Q D ^%ZISC
"RTN","RCRJRDEP",142,0)
K ^TMP($J,"RCRJRDEP")
"RTN","RCRJRDEP",143,0)
Q
"RTN","RCRJRDEP",144,0)
;
"RTN","RCRJRDEP",145,0)
;
"RTN","RCRJRDEP",146,0)
H ; report heading
"RTN","RCRJRDEP",147,0)
I PAGE'=1!(SCREEN) W @IOF
"RTN","RCRJRDEP",148,0)
S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1
"RTN","RCRJRDEP",149,0)
W $C(13),"DEPOSIT RECONCILIATION REPORT",?(80-$L(%)),%
"RTN","RCRJRDEP",150,0)
W !," START WITH DEPOSIT: ",$S(RCRJSTRT="":"**FIRST**",1:RCRJSTRT)," END WITH DEPOSIT: ",$S(RCRJEND="zzzzzzz":"**LAST**",1:RCRJEND),?65,$J("TYPE: "_$S(RCRJSUMM=1:"SUMMARY",1:"DETAILED"),15)
"RTN","RCRJRDEP",151,0)
W !,RCRJLINE
"RTN","RCRJRDEP",152,0)
Q
"RTN","RCRJRDEP",153,0)
;
"RTN","RCRJRDEP",154,0)
;
"RTN","RCRJRDEP",155,0)
H1 ; print line heading
"RTN","RCRJRDEP",156,0)
W !,"LINE",?5,"BFY",?11,"FUND",?20,"RSC",?30,"PROVIDER",?43,"BILL",?54,"AMOUNT",?64,"TRAN TYPE"
"RTN","RCRJRDEP",157,0)
Q
"RTN","RCRJRDEP",158,0)
;
"RTN","RCRJRDEP",159,0)
;
"RTN","RCRJRDEP",160,0)
CHAMPVA(RECEIPDA) ; return dollars for champva
"RTN","RCRJRDEP",161,0)
N %,CATEGORY,RECEIPT,TOTAL,TRAN3,TRANDA
"RTN","RCRJRDEP",162,0)
S RECEIPT=$P($G(^RCY(344,RECEIPDA,0)),"^")
"RTN","RCRJRDEP",163,0)
I RECEIPT="" Q 0
"RTN","RCRJRDEP",164,0)
;
"RTN","RCRJRDEP",165,0)
S TOTAL=0
"RTN","RCRJRDEP",166,0)
S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
"RTN","RCRJRDEP",167,0)
. S CATEGORY=$P($G(^PRCA(430,+$P($G(^PRCA(433,TRANDA,0)),"^",2),0)),"^",2)
"RTN","RCRJRDEP",168,0)
. I CATEGORY'=29 Q
"RTN","RCRJRDEP",169,0)
. S TRAN3=$G(^PRCA(433,TRANDA,3))
"RTN","RCRJRDEP",170,0)
. F %=1:1:5 S TOTAL=TOTAL+$P(TRAN3,"^",%)
"RTN","RCRJRDEP",171,0)
Q TOTAL
"RTN","RCRJRDEP",172,0)
;
"RTN","RCRJRDEP",173,0)
;
"RTN","RCRJRDEP",174,0)
FEE(RECEIPDA) ; return dollars for Fee Basis PRCA*4.5*310/DRF 12/9/2015
"RTN","RCRJRDEP",175,0)
N %,CATEGORY,RECEIPT,TOTAL,TRAN3,TRANDA
"RTN","RCRJRDEP",176,0)
S RECEIPT=$P($G(^RCY(344,RECEIPDA,0)),"^")
"RTN","RCRJRDEP",177,0)
I RECEIPT="" Q 0
"RTN","RCRJRDEP",178,0)
S TOTAL=0
"RTN","RCRJRDEP",179,0)
S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
"RTN","RCRJRDEP",180,0)
. S CATEGORY=$P($G(^PRCA(430,+$P($G(^PRCA(433,TRANDA,0)),"^",2),0)),"^",2)
"RTN","RCRJRDEP",181,0)
. I '$$CHKIEN(CATEGORY) Q ; verify category is Non-VA care (PRCA*4.5*338)
"RTN","RCRJRDEP",182,0)
. S TRAN3=$G(^PRCA(433,TRANDA,3))
"RTN","RCRJRDEP",183,0)
. F %=1:1:5 S TOTAL=TOTAL+$P(TRAN3,"^",%)
"RTN","RCRJRDEP",184,0)
Q TOTAL
"RTN","RCRJRDEP",185,0)
;
"RTN","RCRJRDEP",186,0)
CHKIEN(RCCAT) ; return true if AR CATEGORIES are Non-VA Care (PRCA*4.5*338)
"RTN","RCRJRDEP",187,0)
I RCCAT=45 Q 1
"RTN","RCRJRDEP",188,0)
;PRCA*4.5*351 - Added Community Care to Non-VA check
"RTN","RCRJRDEP",189,0)
I RCCAT>47&(RCCAT<75) Q 1
"RTN","RCRJRDEP",190,0)
I RCCAT>80&(RCCAT<85) Q 1
"RTN","RCRJRDEP",191,0)
Q 0
"RTN","RCTCSPD")
0^2^B171015277
"RTN","RCTCSPD",1,0)
RCTCSPD ;ALBANY/BDB-CROSS-SERVICING TRANSMISSION ;03/15/14 3:34 PM
"RTN","RCTCSPD",2,0)
;;4.5;Accounts Receivable;**301,327,315,336,338,351**;Mar 20, 1995;Build 14
"RTN","RCTCSPD",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","RCTCSPD",4,0)
;
"RTN","RCTCSPD",5,0)
;PRCA*4.5*327 a. Add check to insure debtor exists to prevent
"RTN","RCTCSPD",6,0)
; undefined error and set in XTMP work global to
"RTN","RCTCSPD",7,0)
; be reported via 'TCSP' mailgroup.
"RTN","RCTCSPD",8,0)
; b. Added process controls throughout entire batch
"RTN","RCTCSPD",9,0)
; run and message to mail group 'TCSP' batch run
"RTN","RCTCSPD",10,0)
; is complete
"RTN","RCTCSPD",11,0)
; c. Move SETUP/FINISH to new routine RCTCSPD0
"RTN","RCTCSPD",12,0)
; due to SACC size constraints
"RTN","RCTCSPD",13,0)
; d. Move REC2C tag/code to RCTCSP7 to create space
"RTN","RCTCSPD",14,0)
; for debtor undefined logic
"RTN","RCTCSPD",15,0)
;
"RTN","RCTCSPD",16,0)
;PRCA*4.5*336 a. Shift code to handle 5B transactions ahead
"RTN","RCTCSPD",17,0)
; of other processing that could cause a 5B
"RTN","RCTCSPD",18,0)
; record to not be sent in batch run at tag
"RTN","RCTCSPD",19,0)
; $$UPDCHK(BILL), EXCEPT FOR RECALL CHECK.
"RTN","RCTCSPD",20,0)
; b. Ensure address calls to RCTCSP1 include flag
"RTN","RCTCSPD",21,0)
; to handle missing debtor node 1 correctly when
"RTN","RCTCSPD",22,0)
; building address for CS transactions
"RTN","RCTCSPD",23,0)
;
"RTN","RCTCSPD",24,0)
ENTER ; Entry point from nightly process PRCABJ
"RTN","RCTCSPD",25,0)
N DEBTOR,P150DT,PRIN,INT,ADMIN,TDEB,TFIL,RCDFN,CNTR,SITE,LN,FN,MN,SITE,F60DT,VADM,PHONE,QUIT,TOTAL,ZIPCODE,FULLNM,RCNT,REPAY,X1,X2,ERROR,ADDR,CAT,BILLDT,CURRTOT,SITECD
"RTN","RCTCSPD",26,0)
N SEQ,CNTLID,PREPDT,X1,X2,X,DELDT,ACTDT
"RTN","RCTCSPD",27,0)
D SETUP^RCTCSPD0
"RTN","RCTCSPD",28,0)
S (DEBTOR,RCNT)=0,SEQ=0
"RTN","RCTCSPD",29,0)
RSDEBTOR ;
"RTN","RCTCSPD",30,0)
F S DEBTOR=$O(^PRCA(430,"C",DEBTOR)) Q:DEBTOR'?1N.N D
"RTN","RCTCSPD",31,0)
.D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZBDEBTOR")=%_U_DEBTOR
"RTN","RCTCSPD",32,0)
.N X,RCDFN,DEMCS,DOB,GNDR,DEBTOR0,DEBTOR1,DEBTOR3,DEBTOR7,BILL
"RTN","RCTCSPD",33,0)
.I '$D(^RCD(340,DEBTOR,0)) S ^XTMP("RCTCSPD",$J,"ZZUNDEF",DEBTOR)="" Q
"RTN","RCTCSPD",34,0)
.S DEBTOR0=^RCD(340,DEBTOR,0),DEBTOR1=$G(^(1)),DEBTOR3=$G(^(3)),DEBTOR7=$G(^(7))
"RTN","RCTCSPD",35,0)
.S RCDFN=+DEBTOR0
"RTN","RCTCSPD",36,0)
.S DEMCS=$$DEM^RCTCSP1(RCDFN)
"RTN","RCTCSPD",37,0)
.S DOB=$P(DEMCS,U,2)
"RTN","RCTCSPD",38,0)
.S GNDR=$P(DEMCS,U,1) S:"MF"'[GNDR GNDR="U"
"RTN","RCTCSPD",39,0)
.I $P(DEBTOR7,U,2) I '+$P(DEBTOR7,U,3) D ;send type 2 recall record
"RTN","RCTCSPD",40,0)
..N ACTION,B0,B15,BILL
"RTN","RCTCSPD",41,0)
..S ACTION="L"
"RTN","RCTCSPD",42,0)
..S B0="",B15="",BILL=0
"RTN","RCTCSPD",43,0)
..; The code below is designed to get ONLY one bill #. It is not a bug! As per VA SME contacts.
"RTN","RCTCSPD",44,0)
..F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N I $D(^PRCA(430,"TCSP",BILL)) I $P(^PRCA(430,BILL,15),U,7)'=1 S B0=$G(^PRCA(430,BILL,0)),B15=$G(^(15)) Q ;get one bill
"RTN","RCTCSPD",45,0)
..I BILL="" S BILL=0 S $P(^RCD(340,DEBTOR,7),U,2,4)="^^",$P(DEBTOR7,U,2,4)="^^" Q ;cs debtor with no cs bill, clear the debtor recall flag, quit
"RTN","RCTCSPD",46,0)
..D REC2
"RTN","RCTCSPD",47,0)
..S $P(^RCD(340,DEBTOR,7),U,3)=DT
"RTN","RCTCSPD",48,0)
..S DEBTOR7=^RCD(340,DEBTOR,7)
"RTN","RCTCSPD",49,0)
..S BILL=0 ;set debtor cross-serviced bills as recalled
"RTN","RCTCSPD",50,0)
..F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
"RTN","RCTCSPD",51,0)
...D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZCRBILL")=%_U_BILL
"RTN","RCTCSPD",52,0)
...I $D(^PRCA(430,"TCSP",BILL)) D Q ;bill previously sent to TCSP
"RTN","RCTCSPD",53,0)
....S $P(^PRCA(430,BILL,15),U,1)="" ;clear the date referred
"RTN","RCTCSPD",54,0)
....S $P(^PRCA(430,BILL,15),U,2)=1 ;set the recall flag
"RTN","RCTCSPD",55,0)
....S $P(^PRCA(430,BILL,15),U,3)=DT ;set the recall date
"RTN","RCTCSPD",56,0)
....S $P(^PRCA(430,BILL,15),U,4)=$P(DEBTOR7,U,4) ;set the recall reason
"RTN","RCTCSPD",57,0)
....S $P(^PRCA(430,BILL,15),U,5)=$$GET1^DIQ(430,BILL,11) ;set the recall amount to the current amount
"RTN","RCTCSPD",58,0)
....K ^PRCA(430,"TCSP",BILL) ;kill the cross-servicing cross reference
"RTN","RCTCSPD",59,0)
....D RCRSD^RCTCSPD4 ; set debtor recall non-financial transaction PRCA*4.5*315
"RTN","RCTCSPD",60,0)
.S (BILL,TOTAL,REPAY)=0
"RTN","RCTCSPD",61,0)
RSBILL .F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
"RTN","RCTCSPD",62,0)
..D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZCTRACKER")=%_U_DEBTOR_U_BILL
"RTN","RCTCSPD",63,0)
..N B0,B4,B6,B7,B9,B12,B121,B14,B15,B16,B19,B20,ACTION
"RTN","RCTCSPD",64,0)
..S B0=$G(^PRCA(430,BILL,0)),B4=$G(^(4)),B6=$G(^(6)),B7=$G(^(7)),B9=$G(^(9)),B12=$G(^(12)),B121=$G(^(12.1)),B14=$G(^(14)),B15=$G(^(15)),B16=$G(^(16)),B19=$G(^(19)),B20=$G(^(20))
"RTN","RCTCSPD",65,0)
..Q:($P(B6,U,21)\1)<ACTDT ;cs activation date cutoff
"RTN","RCTCSPD",66,0)
..I $D(^PRCA(430,"TCSP",BILL)),$$RCLLCHK^RCTCSP2(BILL) Q ;bill previously sent to TCSP
"RTN","RCTCSPD",67,0)
..I $$UPDCHK(BILL) Q
"RTN","RCTCSPD",68,0)
..Q:B4 ;repayment plan
"RTN","RCTCSPD",69,0)
..Q:+$P(B15,U,7) ;quit if bill is stopped
"RTN","RCTCSPD",70,0)
..Q:+$P(B14,U,1) ;bill referred to TOP
"RTN","RCTCSPD",71,0)
..Q:$P(DEBTOR1,"^",9)=1 ;quit if debtor address marked unknown
"RTN","RCTCSPD",72,0)
..Q:$E($P(DEMCS,U,3),1,5)="00000" ;quit if the ssn is not valid
"RTN","RCTCSPD",73,0)
..I +$P(B12,U,1) Q ;check date bill sent to dmc
"RTN","RCTCSPD",74,0)
..Q:($P(B121,U,1)="N")!($P(B121,U,1)="P") ;dmc debt valid
"RTN","RCTCSPD",75,0)
..I $P(B6,U,4),($P(B6,U,5)="DOJ") Q
"RTN","RCTCSPD",76,0)
..Q:+$P(DEMCS,U,4) ;deceased patient
"RTN","RCTCSPD",77,0)
..Q:'$P(B0,U,2) ;no category
"RTN","RCTCSPD",78,0)
..S CAT=$P($G(^PRCA(430.2,$P(B0,U,2),0)),U,7)
"RTN","RCTCSPD",79,0)
..Q:'CAT
"RTN","RCTCSPD",80,0)
..;PRCA*4.5*338 - Use RFCHK^RCTOPD to determine if the Category can be referred
"RTN","RCTCSPD",81,0)
..; using the new date based algorithm.
"RTN","RCTCSPD",82,0)
..Q:'$$RFCHK^RCTOPD(CAT,"N",1.03,$P(B6,U,21))
"RTN","RCTCSPD",83,0)
..;end PRCA*4.5*338
"RTN","RCTCSPD",84,0)
..;dpn checks
"RTN","RCTCSPD",85,0)
..I $P(B20,U,3)=1,(10000+$G(^RC(342,1,"CS")))>DT,'$P(B20,U,4) D DUEPROC^RCTCSP3 Q ;check to send dpn file to aitc
"RTN","RCTCSPD",86,0)
..I $P(B20,U,3)=1,(10000+$G(^RC(342,1,"CS")))>DT,$P(B20,U,4),'$P(B20,U,5) Q ;check for print letter date
"RTN","RCTCSPD",87,0)
..I $P(B20,U,3)=1,(10000+$G(^RC(342,1,"CS")))>DT,$P(B20,U,4),$P(B20,U,5) D I X<60 Q ;check for 60 day wait from print letter date
"RTN","RCTCSPD",88,0)
...N X1,X2
"RTN","RCTCSPD",89,0)
...S X1=DT,X2=$P(B20,U,5) D ^%DTC
"RTN","RCTCSPD",90,0)
...I X'<60 S $P(B20,U,6)=DT,^PRCA(430,BILL,20)=B20 ;set the bill referral date to the current date
"RTN","RCTCSPD",91,0)
..S BILLDT=$P(B6,U,21),PREPDT=$P(B0,U,10)
"RTN","RCTCSPD",92,0)
..I BILLDT>P150DT Q ;150 day old check
"RTN","RCTCSPD",93,0)
..I ($P(B0,U,8)=16),('$P(B6,U,3)) D Q
"RTN","RCTCSPD",94,0)
...;no 3rd letter being sent
"RTN","RCTCSPD",95,0)
...N DNM
"RTN","RCTCSPD",96,0)
...S DNM=$$NAMEFF(+DEBTOR0),^XTMP("RCTCSPD",$J,"THIRD",DNM,$P(B0,U))=""
"RTN","RCTCSPD",97,0)
..I $P(B0,U,8)=16 I $$ADDCHKND(BILL) Q
"RTN","RCTCSPD",98,0)
..I $P(B0,U,8)=16 I $$ADDCHKNB(BILL) Q
"RTN","RCTCSPD",99,0)
..Q
"RTN","RCTCSPD",100,0)
.Q
"RTN","RCTCSPD",101,0)
;
"RTN","RCTCSPD",102,0)
D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZDEND")=%
"RTN","RCTCSPD",103,0)
D THIRD^RCTCSP2
"RTN","RCTCSPD",104,0)
D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZETRANSMIT CS RECS")=%
"RTN","RCTCSPD",105,0)
D COMPILE^RCTCSP2 ;compile cross-serviced records
"RTN","RCTCSPD",106,0)
D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZFTRANSMIT DPN")=%
"RTN","RCTCSPD",107,0)
D COMPILED^RCTCSP3 ;compile the aitc due process notification records
"RTN","RCTCSPD",108,0)
D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZGTRANSMIT FINISHED")=%
"RTN","RCTCSPD",109,0)
D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZHCOMPLETE")=%
"RTN","RCTCSPD",110,0)
D FINISH^RCTCSPD0
"RTN","RCTCSPD",111,0)
Q
"RTN","RCTCSPD",112,0)
;
"RTN","RCTCSPD",113,0)
ADDCHKND(BILL) ;add a new bill referral, new debtor
"RTN","RCTCSPD",114,0)
N TOTAL,ACTION,X
"RTN","RCTCSPD",115,0)
S ACTION="A"
"RTN","RCTCSPD",116,0)
I $D(^RCD(340,"TCSP",DEBTOR)) Q 0 ;check debtor previously referred
"RTN","RCTCSPD",117,0)
I $P(B15,U,2) Q 0 ;check tcsp bill recall flag
"RTN","RCTCSPD",118,0)
I $P(DEBTOR7,U,2) Q 0 ;check debtor recall
"RTN","RCTCSPD",119,0)
I $P(B15,U,7) Q 0 ;check stop tcsp referral flag
"RTN","RCTCSPD",120,0)
I $D(^PRCA(430,"TCSP",BILL)) Q 0 ;bill previously sent to TCSP
"RTN","RCTCSPD",121,0)
S TOTAL=$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
"RTN","RCTCSPD",122,0)
I TOTAL<25 Q 1 ;no adds for bills less than $25
"RTN","RCTCSPD",123,0)
D REC1,REC2,REC2A
"RTN","RCTCSPD",124,0)
S $P(^PRCA(430,BILL,16),U,13)=DOB,B16=^(16)
"RTN","RCTCSPD",125,0)
S $P(^PRCA(430,BILL,15),U,14)=GNDR,B15=^(15)
"RTN","RCTCSPD",126,0)
D REC2C^RCTCSP7 ;PRCA*4.5*327
"RTN","RCTCSPD",127,0)
S ADDRCS=$$ADDR^RCTCSP1(RCDFN,1) ;PRCA*4.5*336
"RTN","RCTCSPD",128,0)
S $P(^PRCA(430,BILL,16),U,4,8)=$P(ADDRCS,U,1,5),$P(^(16),U,11)=$P(ADDRCS,U,6),$P(^(16),U,12)=$P(ADDRCS,U,7)
"RTN","RCTCSPD",129,0)
S B16=^PRCA(430,BILL,16)
"RTN","RCTCSPD",130,0)
D REC3^RCTCSP2
"RTN","RCTCSPD",131,0)
S TAXID=$$TAXID(DEBTOR)
"RTN","RCTCSPD",132,0)
S NAME=$$NAME(+DEBTOR0),NAME=$P(NAME,U)
"RTN","RCTCSPD",133,0)
S $P(^PRCA(430,BILL,15),U,1)=DT,$P(^(16),U,1)=TAXID,$P(^(16),U,2)=NAME
"RTN","RCTCSPD",134,0)
S X1=BILLDT,X2=+30 D C^%DTC S DELDT=X
"RTN","RCTCSPD",135,0)
S $P(^PRCA(430,BILL,16),U,3)=DELDT,^PRCA(430,"TCSP",BILL)=""
"RTN","RCTCSPD",136,0)
I $P($G(^PRCA(430,BILL,21)),U)="" S $P(^PRCA(430,BILL,21),U)=DT ;PRCA*4.5*336
"RTN","RCTCSPD",137,0)
I '$D(^RCD(340,"TCSP",DEBTOR)) S $P(^RCD(340,DEBTOR,7),U,5)=DT,^RCD(340,"TCSP",DEBTOR)=""
"RTN","RCTCSPD",138,0)
D NEWDEBTR^RCTCSPD4 ; set CS new debtor new bill non-financial transaction PRCA*4.5*315
"RTN","RCTCSPD",139,0)
Q 1
"RTN","RCTCSPD",140,0)
;
"RTN","RCTCSPD",141,0)
ADDCHKNB(BILL) ;add a new bill referral, existing debtor
"RTN","RCTCSPD",142,0)
N TOTAL,ACTION,TAXID,NAME,ADDRCS,X
"RTN","RCTCSPD",143,0)
I '$D(^RCD(340,"TCSP",DEBTOR)) Q 0 ;check debtor previously referred
"RTN","RCTCSPD",144,0)
I $P(B15,U,2) Q 0 ;check tcsp bill recall flag
"RTN","RCTCSPD",145,0)
I $P(B15,U,7) Q 0 ;check stop tcsp referral flag
"RTN","RCTCSPD",146,0)
I $D(^PRCA(430,"TCSP",BILL)) Q 0 ;bill previously sent to TCSP
"RTN","RCTCSPD",147,0)
S TOTAL=$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
"RTN","RCTCSPD",148,0)
I TOTAL<25 Q 0 ;no adds for bills less than $25
"RTN","RCTCSPD",149,0)
S ACTION="A" D REC1
"RTN","RCTCSPD",150,0)
S ACTION="B" D REC2
"RTN","RCTCSPD",151,0)
S ACTION="A" D REC3^RCTCSP2
"RTN","RCTCSPD",152,0)
S TAXID=$$TAXID(DEBTOR)
"RTN","RCTCSPD",153,0)
S NAME=$$NAME(+DEBTOR0),NAME=$P(NAME,U)
"RTN","RCTCSPD",154,0)
S $P(^PRCA(430,BILL,15),U,1)=DT,$P(^(16),U,1)=TAXID,$P(^(16),U,2)=NAME,$P(^(16),U,3)=BILLDT,^PRCA(430,"TCSP",BILL)=""
"RTN","RCTCSPD",155,0)
I $P($G(^PRCA(430,BILL,21)),U)="" S $P(^PRCA(430,BILL,21),U)=DT ;PRCA*4.5*336
"RTN","RCTCSPD",156,0)
S ADDRCS=$$ADDR^RCTCSP1(RCDFN,1) ;PRCA*4.5*336
"RTN","RCTCSPD",157,0)
S $P(^PRCA(430,BILL,16),U,4,8)=$P(ADDRCS,U,1,5),$P(^(16),U,11)=$P(ADDRCS,U,6),$P(^(16),U,12)=$P(ADDRCS,U,7)
"RTN","RCTCSPD",158,0)
S $P(^PRCA(430,BILL,16),U,13)=DOB,B16=^(16)
"RTN","RCTCSPD",159,0)
S $P(^PRCA(430,BILL,15),U,14)=GNDR,B15=^(15)
"RTN","RCTCSPD",160,0)
I '$D(^RCD(340,"TCSP",DEBTOR)) S $P(^RCD(340,DEBTOR,7),U,5)=DT,^RCD(340,"TCSP",DEBTOR)=""
"RTN","RCTCSPD",161,0)
D DEBTOR^RCTCSPD4 ; set CS debtor new bill non-financial transaction PRCA*4.5*315
"RTN","RCTCSPD",162,0)
Q 1
"RTN","RCTCSPD",163,0)
;
"RTN","RCTCSPD",164,0)
UPDCHK(BILL) ;update 5b or existing bill
"RTN","RCTCSPD",165,0)
I $P(B15,U,2) Q 0 ;check tcsp bill recall flag
"RTN","RCTCSPD",166,0)
N TOTAL,TAXID,OTAXID,NAME,ONAME,ADDR,OADDR,ADDRCS,COUNTRY,OCOUNTRY,OPHONE,ODOB,OGNDR,TRNIDX,TRN1,TRN8,TRNAMT,TRNNUM,TRNFLG,FIVBFLG
"RTN","RCTCSPD",167,0)
;5b check
"RTN","RCTCSPD",168,0)
S FIVBFLG=0
"RTN","RCTCSPD",169,0)
S TRNIDX=0 F S TRNIDX=$O(^PRCA(430,BILL,17,TRNIDX)) Q:+TRNIDX=0 D
"RTN","RCTCSPD",170,0)
.S TRNNUM=$P($G(^PRCA(430,BILL,17,TRNIDX,0)),U,1),TRNFLG=$P($G(^PRCA(430,BILL,17,TRNIDX,0)),U,2)
"RTN","RCTCSPD",171,0)
.Q:+TRNFLG=0
"RTN","RCTCSPD",172,0)
.S TRN1=$G(^PRCA(433,TRNNUM,1)),TRNAMT=$P(TRN1,U,5) S:TRNAMT<0 TRNAMT=-TRNAMT
"RTN","RCTCSPD",173,0)
.S TRN8=$G(^PRCA(433,TRNNUM,8))
"RTN","RCTCSPD",174,0)
.S ACTION="U"
"RTN","RCTCSPD",175,0)
.D REC5B^RCTCSP1
"RTN","RCTCSPD",176,0)
.S $P(^PRCA(430,BILL,17,TRNIDX,0),U,2)=""
"RTN","RCTCSPD",177,0)
.S FIVBFLG=1
"RTN","RCTCSPD",178,0)
I '$D(^PRCA(430,BILL,16)) Q 0 ;quit null node 16 old address ;PRCA*4.5*336
"RTN","RCTCSPD",179,0)
I $P(B15,U,7) Q 0 ;check stop tcsp referral flag ;PRCA*4.5*336
"RTN","RCTCSPD",180,0)
S TOTAL=$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
"RTN","RCTCSPD",181,0)
I FIVBFLG,(TOTAL=0) S DR="151///@",DIE="^PRCA(430,",DA=BILL D ^DIE K DR,DIE,DA
"RTN","RCTCSPD",182,0)
I $P(B19,U,1)=1 S ACTION="U" D REC1 S $P(B19,U,1)="" S $P(^PRCA(430,BILL,19),U,1)=""
"RTN","RCTCSPD",183,0)
I $P(B19,U,2)=1 S ACTION="U" D REC2 S $P(B19,U,2)="" S $P(^PRCA(430,BILL,19),U,2)=""
"RTN","RCTCSPD",184,0)
I $P(B19,U,3)=1 S ACTION="U" D REC2A S $P(B19,U,3)="" S $P(^PRCA(430,BILL,19),U,3)=""
"RTN","RCTCSPD",185,0)
I $P(B19,U,4)=1 S ACTION="A" D REC2C^RCTCSP7 S $P(B19,U,4)="" S $P(^PRCA(430,BILL,19),U,4)="" ;PRCA*4.5*327
"RTN","RCTCSPD",186,0)
I FIVBFLG=1 Q 1 ;if 5b sent, then do not continue to referral check
"RTN","RCTCSPD",187,0)
I '$D(^PRCA(430,"TCSP",BILL)) Q 0 ;if not cross-serviced, then continue referral check
"RTN","RCTCSPD",188,0)
S TAXID=$$TAXID(DEBTOR)
"RTN","RCTCSPD",189,0)
S OTAXID=$P(B16,U,1)
"RTN","RCTCSPD",190,0)
S NAME=$$NAME(+DEBTOR0),NAME=$P(NAME,U)
"RTN","RCTCSPD",191,0)
S ONAME=$P(B16,U,2)
"RTN","RCTCSPD",192,0)
I $P(B0,U,8)=16,$D(^PRCA(430,"TCSP",BILL)) I (NAME'=ONAME)!(TAXID'=OTAXID) D
"RTN","RCTCSPD",193,0)
.S ACTION="U"
"RTN","RCTCSPD",194,0)
.D REC2
"RTN","RCTCSPD",195,0)
.S $P(^PRCA(430,BILL,16),U,1)=TAXID,$P(^(16),U,2)=NAME,$P(^(19),U,2)="",$P(B19,U,2)=""
"RTN","RCTCSPD",196,0)
S OADDR=$P(^PRCA(430,BILL,16),U,4,8),OPHONE=$P(^(16),U,11),OCOUNTRY=$P(^(16),U,12)
"RTN","RCTCSPD",197,0)
S ADDRCS=$$ADDR^RCTCSP1(RCDFN,1),PHONE=$P(ADDRCS,U,6),COUNTRY=$P(ADDRCS,U,7) ;PRCA*4.5*336
"RTN","RCTCSPD",198,0)
I $P(DEBTOR1,"^",9)'=1 D ;if debtor address is not marked unknown, then check address
"RTN","RCTCSPD",199,0)
.I $P(B0,U,8)=16,$D(^PRCA(430,"TCSP",BILL)) I ($P(ADDRCS,U,1,5)'=$P(OADDR,U,1,5))!(PHONE'=OPHONE)!(COUNTRY'=OCOUNTRY) D
"RTN","RCTCSPD",200,0)
..S ACTION="A" ;2c records have action code 'a'
"RTN","RCTCSPD",201,0)
..D REC2C^RCTCSP7
"RTN","RCTCSPD",202,0)
..S $P(B19,U,4)=""
"RTN","RCTCSPD",203,0)
..S $P(^PRCA(430,BILL,16),U,4,8)=$P(ADDRCS,U,1,5),$P(^(16),U,11)=PHONE,$P(^(16),U,12)=$P(ADDRCS,U,7)
"RTN","RCTCSPD",204,0)
S B16=^PRCA(430,BILL,16)
"RTN","RCTCSPD",205,0)
S ODOB=$P(^PRCA(430,BILL,16),U,13)
"RTN","RCTCSPD",206,0)
S OGNDR=$P(^PRCA(430,BILL,15),U,14)
"RTN","RCTCSPD",207,0)
I $P(B0,U,8)=16,$D(^PRCA(430,"TCSP",BILL)) I (DOB'=ODOB)!(GNDR'=OGNDR) D
"RTN","RCTCSPD",208,0)
.S ACTION="U"
"RTN","RCTCSPD",209,0)
.D REC2A
"RTN","RCTCSPD",210,0)
.S $P(^PRCA(430,BILL,16),U,13)=DOB,B16=^(16)
"RTN","RCTCSPD",211,0)
.S $P(^PRCA(430,BILL,15),U,14)=GNDR,B15=^(15)
"RTN","RCTCSPD",212,0)
.Q
"RTN","RCTCSPD",213,0)
Q 1 ;bill is cross-serviced so do not continue referral check
"RTN","RCTCSPD",214,0)
;
"RTN","RCTCSPD",215,0)
REC1 ;record type 1
"RTN","RCTCSPD",216,0)
N REC,KNUM,DEBTNR,AMTORIG,AMTPBAL,AMTIBAL,AMTABAL,AMTFBAL,AMTCBAL,AMTRFRRD,AMOUNT,DELDT,X,X1,X2,BILLDT,PREPDT
"RTN","RCTCSPD",217,0)
S REC="C1 "_ACTION_"3636001200"_"DM1D "
"RTN","RCTCSPD",218,0)
S KNUM=$P($P(B0,U,1),"-",2)
"RTN","RCTCSPD",219,0)
S DEBTNR=$E(SITE,1,3)_$$LJZF(KNUM,7)_$TR($J(BILL,20)," ",0),REC=REC_DEBTNR_" "
"RTN","RCTCSPD",220,0)
S REC=REC_"I A MSCC"
"RTN","RCTCSPD",221,0)
S BILLDT=$P(B6,U,21),PREPDT=$P(B0,U,10)
"RTN","RCTCSPD",222,0)
S REC=REC_$$DATE8(PREPDT)
"RTN","RCTCSPD",223,0)
S X1=BILLDT,X2=+30 D C^%DTC S DELDT=X
"RTN","RCTCSPD",224,0)
S REC=REC_$$DATE8(DELDT)
"RTN","RCTCSPD",225,0)
S AMTPBAL=$P(B7,U,1) ;principle balance
"RTN","RCTCSPD",226,0)
S AMTIBAL=$P(B7,U,2) ;interest balance
"RTN","RCTCSPD",227,0)
S AMTABAL=$P(B7,U,3) ;administrative balance
"RTN","RCTCSPD",228,0)
S AMTFBAL=$P(B7,U,4) ;marshal fee
"RTN","RCTCSPD",229,0)
S AMTCBAL=$P(B7,U,5) ;court cost
"RTN","RCTCSPD",230,0)
S AMTRFRRD=AMTPBAL+AMTIBAL+AMTABAL+AMTFBAL+AMTCBAL
"RTN","RCTCSPD",231,0)
S AMTORIG=$P(B0,U,3)
"RTN","RCTCSPD",232,0)
D ;
"RTN","RCTCSPD",233,0)
.I ACTION="A" S REC=REC_$$AMOUNT(AMTRFRRD)_$$AMOUNT(AMTRFRRD) Q
"RTN","RCTCSPD",234,0)
.I ACTION="L" S AMTRFRRD=0 S REC=REC_$$AMOUNT(AMTRFRRD)_$$AMOUNT(AMTRFRRD) Q
"RTN","RCTCSPD",235,0)
.S REC=REC_$$BLANK(28)
"RTN","RCTCSPD",236,0)
S REC=REC_" N "
"RTN","RCTCSPD",237,0)
S AMOUNT=$$AMOUNT(AMTPBAL)_$$AMOUNT(AMTIBAL)_$$AMOUNT(AMTABAL)_$$AMOUNT(AMTFBAL+AMTCBAL)
"RTN","RCTCSPD",238,0)
I ACTION="L" S AMOUNT=$$AMOUNT(0)_$$AMOUNT(0)_$$AMOUNT(0)_$$AMOUNT(0) ;by iai spec
"RTN","RCTCSPD",239,0)
I ACTION="U" S AMOUNT=$$BLANK(56) ;by iai spec
"RTN","RCTCSPD",240,0)
S REC=REC_AMOUNT
"RTN","RCTCSPD",241,0)
I ACTION="L" D
"RTN","RCTCSPD",242,0)
.S REC=REC_$$BLANK(252-$L(REC))
"RTN","RCTCSPD",243,0)
.S RCD=$P(B15,U,4)
"RTN","RCTCSPD",244,0)
.S REC=REC_$S(RCD="01":"01",RCD="07":"07",RCD="08":"08",RCD="15":"01",RCD="03":"01",RCD="05":"01",RCD="06":"01",1:"01")
"RTN","RCTCSPD",245,0)
S REC=REC_$$BLANK(450-$L(REC))
"RTN","RCTCSPD",246,0)
I ACTION="A" S $P(^PRCA(430,BILL,16),U,9)=AMTRFRRD,$P(^(16),U,10)=AMTRFRRD
"RTN","RCTCSPD",247,0)
I ACTION="L" S $P(^PRCA(430,BILL,16),U,9)="",$P(^(16),U,10)=""
"RTN","RCTCSPD",248,0)
S ^XTMP("RCTCSPD",$J,BILL,ACTION,1)=REC
"RTN","RCTCSPD",249,0)
S ^XTMP("RCTCSPD",$J,"BILL",ACTION,BILL)=$$TAXID(DEBTOR)_"^"_+$E(REC,91,102)_"."_$E(REC,103,104) ;sends mailman message of documents sent to user
"RTN","RCTCSPD",250,0)
D CLR19(BILL,1)
"RTN","RCTCSPD",251,0)
Q
"RTN","RCTCSPD",252,0)
;
"RTN","RCTCSPD",253,0)
REC2 ;
"RTN","RCTCSPD",254,0)
N REC,KNUM,DEBTNR,DEBTORNB,TAXID,NAME,RCD
"RTN","RCTCSPD",255,0)
S REC="C2 "_ACTION_"3636001200"_"DM1D "
"RTN","RCTCSPD",256,0)
S KNUM=$P($P(B0,U,1),"-",2)
"RTN","RCTCSPD",257,0)
S DEBTNR=$E(SITE,1,3)_$$LJZF(KNUM,7)_$TR($J(BILL,20)," ",0),REC=REC_DEBTNR
"RTN","RCTCSPD",258,0)
S DEBTORNB=$E(SITE,1,3)_$TR($J(DEBTOR,12)," ",0)
"RTN","RCTCSPD",259,0)
S REC=REC_DEBTORNB
"RTN","RCTCSPD",260,0)
S TAXID=$$TAXID(DEBTOR)
"RTN","RCTCSPD",261,0)
S REC=REC_TAXID_"SSN"
"RTN","RCTCSPD",262,0)
S NAME=$$NAME(+DEBTOR0),NAME=$P(NAME,U)
"RTN","RCTCSPD",263,0)
S REC=REC_NAME_$$BLANK(5)_"I"
"RTN","RCTCSPD",264,0)
I ACTION="L" D
"RTN","RCTCSPD",265,0)
.S REC=REC_$$BLANK(232-$L(REC))
"RTN","RCTCSPD",266,0)
.S RCD=$P(B15,U,4)
"RTN","RCTCSPD",267,0)
.S REC=REC_$S(RCD="01":"12",RCD="07":"12",RCD="08":"12",RCD="15":"12",RCD="03":"03",RCD="05":"05",RCD="06":"06",1:"12")
"RTN","RCTCSPD",268,0)
S REC=REC_$$BLANK(450-$L(REC))
"RTN","RCTCSPD",269,0)
S ^XTMP("RCTCSPD",$J,BILL,ACTION,2)=REC
"RTN","RCTCSPD",270,0)
S $P(^XTMP("RCTCSPD",$J,"BILL",ACTION,BILL),U,1)=$$TAXID(DEBTOR)
"RTN","RCTCSPD",271,0)
D CLR19(BILL,2)
"RTN","RCTCSPD",272,0)
Q
"RTN","RCTCSPD",273,0)
;
"RTN","RCTCSPD",274,0)
REC2A ;
"RTN","RCTCSPD",275,0)
N REC,KNUM,DEBTNR,DEBTORNB
"RTN","RCTCSPD",276,0)
S REC="C2A"_ACTION_"3636001200"_"DM1D "
"RTN","RCTCSPD",277,0)
S KNUM=$P($P(B0,U,1),"-",2)
"RTN","RCTCSPD",278,0)
S DEBTNR=$E(SITE,1,3)_$$LJZF(KNUM,7)_$TR($J(BILL,20)," ",0),REC=REC_DEBTNR
"RTN","RCTCSPD",279,0)
S DEBTORNB=$E(SITE,1,3)_$TR($J(DEBTOR,12)," ",0)
"RTN","RCTCSPD",280,0)
S REC=REC_DEBTORNB
"RTN","RCTCSPD",281,0)
S REC=REC_$$BLANK(3)
"RTN","RCTCSPD",282,0)
S REC=REC_GNDR
"RTN","RCTCSPD",283,0)
S REC=REC_$$DATE8($P(DEMCS,U,2))
"RTN","RCTCSPD",284,0)
S REC=REC_$$BLANK(450-$L(REC))
"RTN","RCTCSPD",285,0)
S ^XTMP("RCTCSPD",$J,BILL,ACTION,"2A")=REC
"RTN","RCTCSPD",286,0)
S $P(^XTMP("RCTCSPD",$J,"BILL",ACTION,BILL),U,1)=$$TAXID(DEBTOR)
"RTN","RCTCSPD",287,0)
D CLR19(BILL,3)
"RTN","RCTCSPD",288,0)
Q
"RTN","RCTCSPD",289,0)
;
"RTN","RCTCSPD",290,0)
DATE8(X) ;changes fileman date into 8 digit date yyyymmdd
"RTN","RCTCSPD",291,0)
I +X S X=X+17000000
"RTN","RCTCSPD",292,0)
S X=$E(X,1,8)
"RTN","RCTCSPD",293,0)
Q X
"RTN","RCTCSPD",294,0)
;
"RTN","RCTCSPD",295,0)
AMOUNT(X) ;changes amount to zero filled, right justified
"RTN","RCTCSPD",296,0)
S:X<0 X=-X
"RTN","RCTCSPD",297,0)
S X=$TR($J(X,0,2),".")
"RTN","RCTCSPD",298,0)
S X=$E("000000000000",1,14-$L(X))_X
"RTN","RCTCSPD",299,0)
Q X
"RTN","RCTCSPD",300,0)
;
"RTN","RCTCSPD",301,0)
NAME(DFN) ;returns name for document and name in file
"RTN","RCTCSPD",302,0)
N FN,LN,MN,NM,DOCNM,VA,VADM
"RTN","RCTCSPD",303,0)
S NM=""
"RTN","RCTCSPD",304,0)
D DEM^VADPT
"RTN","RCTCSPD",305,0)
I $D(VADM) S NM=VADM(1)
"RTN","RCTCSPD",306,0)
S LN=$TR($P(NM,",")," .'-"),MN=$P($P(NM,",",2)," ",2)
"RTN","RCTCSPD",307,0)
I ($E(MN,1,2)="SR")!($E(MN,1,2)="JR")!(MN?2.3"I")!(MN?0.1"I"1"V"1.3"I") S MN=""
"RTN","RCTCSPD",308,0)
S FN=$P($P(NM,",",2)," ")
"RTN","RCTCSPD",309,0)
S DOCNM=$$LJ^XLFSTR($E(LN,1,35),35)_$$LJ^XLFSTR($E(FN,1,35),35)_$$LJ^XLFSTR($E(MN,1,35),35)
"RTN","RCTCSPD",310,0)
Q DOCNM
"RTN","RCTCSPD",311,0)
;
"RTN","RCTCSPD",312,0)
NAMEFF(DFN) ;returns name for document and name in file
"RTN","RCTCSPD",313,0)
N FN,LN,MN,NM,DOCNM,VA,VADM
"RTN","RCTCSPD",314,0)
S NM=""
"RTN","RCTCSPD",315,0)
D DEM^VADPT
"RTN","RCTCSPD",316,0)
I $D(VADM) S NM=VADM(1)
"RTN","RCTCSPD",317,0)
S LN=$TR($P(NM,",")," .'-"),MN=$P($P(NM,",",2)," ",2)
"RTN","RCTCSPD",318,0)
I ($E(MN,1,2)="SR")!($E(MN,1,2)="JR")!(MN?2.3"I")!(MN?0.1"I"1"V"1.3"I") S MN=""
"RTN","RCTCSPD",319,0)
S FN=$P($P(NM,",",2)," ")
"RTN","RCTCSPD",320,0)
S DOCNM=LN_" "_FN_" "_MN
"RTN","RCTCSPD",321,0)
Q DOCNM
"RTN","RCTCSPD",322,0)
;
"RTN","RCTCSPD",323,0)
BLANK(X) ;returns 'x' blank spaces
"RTN","RCTCSPD",324,0)
N BLANK
"RTN","RCTCSPD",325,0)
S BLANK="",$P(BLANK," ",X+1)=""
"RTN","RCTCSPD",326,0)
Q BLANK
"RTN","RCTCSPD",327,0)
;
"RTN","RCTCSPD",328,0)
NOW() ;compiles current date,time
"RTN","RCTCSPD",329,0)
N X,Y,%,%H
"RTN","RCTCSPD",330,0)
S %H=$H D YX^%DTC
"RTN","RCTCSPD",331,0)
Q Y
"RTN","RCTCSPD",332,0)
;
"RTN","RCTCSPD",333,0)
RJZF(X,Y) ;right justify zero fill width Y
"RTN","RCTCSPD",334,0)
S X=$E("000000000000",1,Y-$L(X))_X
"RTN","RCTCSPD",335,0)
Q X
"RTN","RCTCSPD",336,0)
;
"RTN","RCTCSPD",337,0)
TAXID(DEBTOR) ;computes TAXID to place on documents
"RTN","RCTCSPD",338,0)
N TAXID,DIC,DA,DR,DIQ
"RTN","RCTCSPD",339,0)
S TAXID=$$SSN^RCFN01(DEBTOR)
"RTN","RCTCSPD",340,0)
S TAXID=$$LJSF(TAXID,9)
"RTN","RCTCSPD",341,0)
Q TAXID
"RTN","RCTCSPD",342,0)
;
"RTN","RCTCSPD",343,0)
LJSF(X,Y) ;x left justified, y space filled
"RTN","RCTCSPD",344,0)
S X=$E(X,1,Y)
"RTN","RCTCSPD",345,0)
S X=X_$$BLANK(Y-$L(X))
"RTN","RCTCSPD",346,0)
Q X
"RTN","RCTCSPD",347,0)
;
"RTN","RCTCSPD",348,0)
LJZF(X,Y) ;x left justified, y zero filled
"RTN","RCTCSPD",349,0)
S X=X_"0000000000"
"RTN","RCTCSPD",350,0)
S X=$E(X,X,Y)
"RTN","RCTCSPD",351,0)
Q X
"RTN","RCTCSPD",352,0)
;
"RTN","RCTCSPD",353,0)
RECALL(BILL) ; set the recall flag
"RTN","RCTCSPD",354,0)
S $P(^PRCA(430,BILL,15),U,2)=1
"RTN","RCTCSPD",355,0)
Q
"RTN","RCTCSPD",356,0)
;
"RTN","RCTCSPD",357,0)
CLR19(BILL,X) ; clear the send flag
"RTN","RCTCSPD",358,0)
S $P(^PRCA(430,BILL,19),U,X)=""
"RTN","RCTCSPD",359,0)
;
"RTN","RCXFMSPR")
0^7^B59053655
"RTN","RCXFMSPR",1,0)
RCXFMSPR ;WISC/RFJ-print revenue source codes ;8/31/10 11:34am
"RTN","RCXFMSPR",2,0)
;;4.5;Accounts Receivable;**90,96,101,156,170,203,273,310,315,338,351**;Mar 20, 1995;Build 14
"RTN","RCXFMSPR",3,0)
;Per VA Directive 6402, this routine should not be modified.
"RTN","RCXFMSPR",4,0)
W !,"This option will print out a list of the revenue source codes sent from"
"RTN","RCXFMSPR",5,0)
W !,"the VISTA system to FMS."
"RTN","RCXFMSPR",6,0)
;
"RTN","RCXFMSPR",7,0)
; select device
"RTN","RCXFMSPR",8,0)
W ! S %ZIS="Q" D ^%ZIS Q:POP
"RTN","RCXFMSPR",9,0)
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
"RTN","RCXFMSPR",10,0)
. S ZTDESC="Revenue Source Code Report",ZTRTN="DQ^RCXFMSPR"
"RTN","RCXFMSPR",11,0)
. S ZTSAVE("ZTREQ")="@"
"RTN","RCXFMSPR",12,0)
W !!,"<*> please wait <*>"
"RTN","RCXFMSPR",13,0)
;
"RTN","RCXFMSPR",14,0)
DQ ; queue starts here
"RTN","RCXFMSPR",15,0)
N %,%I,BINARY,COL2DESC,COL3DESC,COLUMN1,COLUMN2,COLUMN3,COLUMN4
"RTN","RCXFMSPR",16,0)
N DECIMAL,DESCRIP,NOW,PAGE,RCSTFLAG,SCREEN,X,Y
"RTN","RCXFMSPR",17,0)
D NOW^%DTC S Y=% D DD^%DT S NOW=Y
"RTN","RCXFMSPR",18,0)
S PAGE=1,SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
"RTN","RCXFMSPR",19,0)
U IO D H
"RTN","RCXFMSPR",20,0)
;
"RTN","RCXFMSPR",21,0)
S COLUMN1="A",COLUMN2="R",COLUMN3="R",COLUMN4="V",DESCRIP="Miscellaneous"
"RTN","RCXFMSPR",22,0)
D WRITEIT
"RTN","RCXFMSPR",23,0)
;
"RTN","RCXFMSPR",24,0)
; for now, column 1 is always 8 and column 4 is always Z
"RTN","RCXFMSPR",25,0)
S COLUMN1=8,COLUMN4="Z"
"RTN","RCXFMSPR",26,0)
F COLUMN2=1:1:9,"A","B","C","D","E","F","G","H","I","J","K","L","M","Q","R","S","T" D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",27,0)
. S COL2DESC=$P($T(@("A"_COLUMN2)),";",3)
"RTN","RCXFMSPR",28,0)
. ;
"RTN","RCXFMSPR",29,0)
. S COLUMN3=$S(COLUMN2=5:"*",1:"Z")
"RTN","RCXFMSPR",30,0)
. S DESCRIP=COL2DESC D WRITEIT
"RTN","RCXFMSPR",31,0)
. ;
"RTN","RCXFMSPR",32,0)
. I $G(RCSTFLAG) Q
"RTN","RCXFMSPR",33,0)
. ;
"RTN","RCXFMSPR",34,0)
. ; show hsif - disabled by patch 203
"RTN","RCXFMSPR",35,0)
. ;I COLUMN2="B"!(COLUMN2="C") S DESCRIP=DESCRIP_" HSIF",COLUMN3=1 D WRITEIT
"RTN","RCXFMSPR",36,0)
;
"RTN","RCXFMSPR",37,0)
I $G(RCSTFLAG) D Q Q
"RTN","RCXFMSPR",38,0)
;
"RTN","RCXFMSPR",39,0)
; print reimbursable health insurance rsc's
"RTN","RCXFMSPR",40,0)
S COLUMN2=5
"RTN","RCXFMSPR",41,0)
W !!?6,"For REIMBURSABLE HEALTH INSURANCE [85*Z]:"
"RTN","RCXFMSPR",42,0)
F DECIMAL=0:1:31 D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",43,0)
. I DECIMAL<10 S COLUMN3=DECIMAL
"RTN","RCXFMSPR",44,0)
. E S COLUMN3=$C(65+DECIMAL-10)
"RTN","RCXFMSPR",45,0)
. ;
"RTN","RCXFMSPR",46,0)
. ; convert decimal to binary (ex: 10011) so it can be
"RTN","RCXFMSPR",47,0)
. ; parsed in rsc to get the description
"RTN","RCXFMSPR",48,0)
. S BINARY=$$CONVERT(DECIMAL)
"RTN","RCXFMSPR",49,0)
. S COL3DESC=$P($T(@("B"_$E(BINARY,1,2))),";",3)
"RTN","RCXFMSPR",50,0)
. S COL3DESC=COL3DESC_", "_$P($T(@("C"_$E(BINARY,3))),";",3)
"RTN","RCXFMSPR",51,0)
. S COL3DESC=COL3DESC_", "_$P($T(@("D"_$E(BINARY,4))),";",3)
"RTN","RCXFMSPR",52,0)
. S COL3DESC=COL3DESC_", "_$P($T(@("E"_$E(BINARY,5))),";",3)
"RTN","RCXFMSPR",53,0)
. S DESCRIP=COL3DESC
"RTN","RCXFMSPR",54,0)
. D WRITEIT
"RTN","RCXFMSPR",55,0)
;
"RTN","RCXFMSPR",56,0)
; print fee basis reimbursable health insurance rsc's (PRCA*4.5*310/DRF)
"RTN","RCXFMSPR",57,0)
S COLUMN2="F"
"RTN","RCXFMSPR",58,0)
W !!?6,"For FEE REIMBURSABLE HEALTH INSURANCE [8F*Z]:"
"RTN","RCXFMSPR",59,0)
F DECIMAL=1:1:2 D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",60,0)
. S DESCRIP="FEE BASIS, NSC VET, MT CAT A, "_$S(DECIMAL=1:"INPATIENT",DECIMAL=2:"OUTPATIENT",1:"")
"RTN","RCXFMSPR",61,0)
. S COLUMN3=DECIMAL
"RTN","RCXFMSPR",62,0)
. D WRITEIT
"RTN","RCXFMSPR",63,0)
;
"RTN","RCXFMSPR",64,0)
; print EMERGENCY/HUMANITARIAN REIMB. PRCA*4.5*315
"RTN","RCXFMSPR",65,0)
; 8VZZ;HUMAN 3RD-PRTY OUTPATIENT
"RTN","RCXFMSPR",66,0)
; 8UZZ;HUMAN 3RD-PRTY INPATIENT
"RTN","RCXFMSPR",67,0)
S COLUMN3="Z"
"RTN","RCXFMSPR",68,0)
W !!?6,"For EMERGENCY/HUMANITARIAN REIMBURSABLE HEALTH INSURANCE [8*ZZ]:"
"RTN","RCXFMSPR",69,0)
F DECIMAL="U","V" D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",70,0)
. S DESCRIP="EMERGENCY/HUMANITARIAN REIMB. INS., "_$S(DECIMAL="U":"INPATIENT",DECIMAL="V":"OUTPATIENT",1:"")
"RTN","RCXFMSPR",71,0)
. S COLUMN2=DECIMAL
"RTN","RCXFMSPR",72,0)
. D WRITEIT
"RTN","RCXFMSPR",73,0)
;
"RTN","RCXFMSPR",74,0)
Q D ^%ZISC
"RTN","RCXFMSPR",75,0)
; print CCAD rsc's (PRCA*4.5*338)
"RTN","RCXFMSPR",76,0)
N DATA,LOOP
"RTN","RCXFMSPR",77,0)
S (COLUMN2,COLUMN3,COLUMN4)="" ;Clear other columns
"RTN","RCXFMSPR",78,0)
W !!?6,"For COMMUNITY CARE:"
"RTN","RCXFMSPR",79,0)
F LOOP=1:1 S DATA=$T(CCADRSC+LOOP) Q:(DATA="")!($P(DATA,";",3)="END") D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",80,0)
. S COLUMN1=$P(DATA,";",3),DESCRIP=$P(DATA,";",4)
"RTN","RCXFMSPR",81,0)
. D WRITEIT
"RTN","RCXFMSPR",82,0)
Q
"RTN","RCXFMSPR",83,0)
;
"RTN","RCXFMSPR",84,0)
;
"RTN","RCXFMSPR",85,0)
GETDESC(RSC) ; return the description for the revenue source code
"RTN","RCXFMSPR",86,0)
N BINARY,COL3DESC,COLUMN2,COLUMN3,DESC,RCARY
"RTN","RCXFMSPR",87,0)
;new resource codes for emergency/humanitarian reimb. PRCA*4.5*315
"RTN","RCXFMSPR",88,0)
I RSC="8UZZ" Q "Emergency/Humanitarian Reimb. Ins., Inpatient"
"RTN","RCXFMSPR",89,0)
I RSC="8VZZ" Q "Emergency/Humanitarian Reimb. Ins., Outpatient"
"RTN","RCXFMSPR",90,0)
I RSC="ARRV" Q "Miscellaneous"
"RTN","RCXFMSPR",91,0)
I RSC=8046 Q "Administrative"
"RTN","RCXFMSPR",92,0)
I RSC=8047 Q "Interest"
"RTN","RCXFMSPR",93,0)
I RSC=8048 Q "Marshal Fee and Court Cost"
"RTN","RCXFMSPR",94,0)
;PRCA*4.5*338 - check to see if RSC is a Community Care RSC and add RSCs missing a description.
"RTN","RCXFMSPR",95,0)
I RSC=8000 Q "Non Medical Reimbursements"
"RTN","RCXFMSPR",96,0)
I RSC=8023 Q "Compensated Work Therapy"
"RTN","RCXFMSPR",97,0)
I RSC=8024 Q "Tort Feasor"
"RTN","RCXFMSPR",98,0)
I RSC=8041 Q "FED OWCP"
"RTN","RCXFMSPR",99,0)
F LOOP=1:1 S DATA=$T(CCADRSC+LOOP) Q:(DATA="")!($P(DATA,";",3)="END") D
"RTN","RCXFMSPR",100,0)
. S RCARY($P(DATA,";",3))=$P(DATA,";",4)
"RTN","RCXFMSPR",101,0)
I $G(RCARY(RSC))'="" Q $G(RCARY(RSC))
"RTN","RCXFMSPR",102,0)
;end PRCA*4.5*338
"RTN","RCXFMSPR",103,0)
S DESC="UNKNOWN"
"RTN","RCXFMSPR",104,0)
S COLUMN2=$E(RSC,2)
"RTN","RCXFMSPR",105,0)
I "123456789ABCDEFGHIJKLMQRST"[COLUMN2 S DESC=$P($T(@("A"_COLUMN2)),";",3)
"RTN","RCXFMSPR",106,0)
; HSIF reference disabled by patch 203
"RTN","RCXFMSPR",107,0)
; I RSC="8B1Z"!(RSC="8C1Z") S DESC=DESC_" (HSIF)"
"RTN","RCXFMSPR",108,0)
I COLUMN2'=5 Q DESC
"RTN","RCXFMSPR",109,0)
;
"RTN","RCXFMSPR",110,0)
S COLUMN3=$E(RSC,3)
"RTN","RCXFMSPR",111,0)
; convert alpha letters to decimal
"RTN","RCXFMSPR",112,0)
I "0123456789"'[COLUMN3 S COLUMN3=$A(COLUMN3)-55
"RTN","RCXFMSPR",113,0)
S BINARY=$$CONVERT(COLUMN3)
"RTN","RCXFMSPR",114,0)
S COL3DESC=$P($T(@("B"_$E(BINARY,1,2))),";",3)
"RTN","RCXFMSPR",115,0)
S COL3DESC=COL3DESC_", "_$P($T(@("C"_$E(BINARY,3))),";",3)
"RTN","RCXFMSPR",116,0)
S COL3DESC=COL3DESC_", "_$P($T(@("D"_$E(BINARY,4))),";",3)
"RTN","RCXFMSPR",117,0)
S COL3DESC=COL3DESC_", "_$P($T(@("E"_$E(BINARY,5))),";",3)
"RTN","RCXFMSPR",118,0)
Q "RHI, "_COL3DESC
"RTN","RCXFMSPR",119,0)
;
"RTN","RCXFMSPR",120,0)
;
"RTN","RCXFMSPR",121,0)
CONVERT(DECIMAL) ; convert decimal number to binary (5 digits)
"RTN","RCXFMSPR",122,0)
N Y
"RTN","RCXFMSPR",123,0)
S Y=""
"RTN","RCXFMSPR",124,0)
F S Y=$E("0123456789ABCDEF",DECIMAL#2+1)_Y,DECIMAL=DECIMAL\2 Q:DECIMAL<1
"RTN","RCXFMSPR",125,0)
S Y=$E("00000",0,5-$L(Y))_Y
"RTN","RCXFMSPR",126,0)
Q Y
"RTN","RCXFMSPR",127,0)
;
"RTN","RCXFMSPR",128,0)
;
"RTN","RCXFMSPR",129,0)
WRITEIT ; display the rsc
"RTN","RCXFMSPR",130,0)
W !,COLUMN1,COLUMN2,COLUMN3,COLUMN4,?6,DESCRIP
"RTN","RCXFMSPR",131,0)
I $Y>(IOSL-5) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
"RTN","RCXFMSPR",132,0)
Q
"RTN","RCXFMSPR",133,0)
;
"RTN","RCXFMSPR",134,0)
;
"RTN","RCXFMSPR",135,0)
PAUSE ; pause at end of page
"RTN","RCXFMSPR",136,0)
N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" RCSTFLAG=1 U IO
"RTN","RCXFMSPR",137,0)
Q
"RTN","RCXFMSPR",138,0)
;
"RTN","RCXFMSPR",139,0)
;
"RTN","RCXFMSPR",140,0)
H ; header
"RTN","RCXFMSPR",141,0)
S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
"RTN","RCXFMSPR",142,0)
W $C(13),"REVENUE SOURCE CODE REPORT (VISTA TO FMS)",?(80-$L(%)),%
"RTN","RCXFMSPR",143,0)
W !,"RSC",?6,"Description"
"RTN","RCXFMSPR",144,0)
S %="",$P(%,"-",81)=""
"RTN","RCXFMSPR",145,0)
W !,%
"RTN","RCXFMSPR",146,0)
Q
"RTN","RCXFMSPR",147,0)
;
"RTN","RCXFMSPR",148,0)
;
"RTN","RCXFMSPR",149,0)
; this is a listing of all column2 values with a description
"RTN","RCXFMSPR",150,0)
A1 ;;Hospital Care (NSC)
"RTN","RCXFMSPR",151,0)
A2 ;;Outpatient Care (NSC)
"RTN","RCXFMSPR",152,0)
A3 ;;Nursing Home Care (NSC)
"RTN","RCXFMSPR",153,0)
A4 ;;Ineligible Hospitalization
"RTN","RCXFMSPR",154,0)
A5 ;;Reimbursable Health Insurance
"RTN","RCXFMSPR",155,0)
A6 ;;Tort Feasor
"RTN","RCXFMSPR",156,0)
A7 ;;Workmans Compensation (Non-Federal)
"RTN","RCXFMSPR",157,0)
A8 ;;C (Means Test)
"RTN","RCXFMSPR",158,0)
A9 ;;Emergency/Humanitarian
"RTN","RCXFMSPR",159,0)
AA ;;No Fault Auto Accident
"RTN","RCXFMSPR",160,0)
AB ;;Pharmacy Co-Pay (SC Vet)
"RTN","RCXFMSPR",161,0)
AC ;;Pharmacy Co-Pay (NSC Vet)
"RTN","RCXFMSPR",162,0)
AD ;;Nursing Home Care Per Diem
"RTN","RCXFMSPR",163,0)
AE ;;Hospital Care Per Diem
"RTN","RCXFMSPR",164,0)
AF ;;Medicare
"RTN","RCXFMSPR",165,0)
AG ;;Adult Day Health Care (LTC)
"RTN","RCXFMSPR",166,0)
AH ;;Domiciliary (LTC)
"RTN","RCXFMSPR",167,0)
AI ;;Respite Care-Institutional (LTC)
"RTN","RCXFMSPR",168,0)
AJ ;;Respite Care-Non-Institutional (LTC)
"RTN","RCXFMSPR",169,0)
AK ;;Geriatric Eval-Institutional (LTC)
"RTN","RCXFMSPR",170,0)
AL ;;Geriatric Eval-Non-Institutional (LTC)
"RTN","RCXFMSPR",171,0)
AM ;;Nursing Home Care-Long Term Care (LTC)
"RTN","RCXFMSPR",172,0)
AQ ;;Pharmacy No Fault Auto Acc
"RTN","RCXFMSPR",173,0)
AR ;;Pharmacy Reimburs Health Ins
"RTN","RCXFMSPR",174,0)
AS ;;Pharmacy Tort Feasor
"RTN","RCXFMSPR",175,0)
AT ;;Pharmacy Workman's Comp
"RTN","RCXFMSPR",176,0)
;
"RTN","RCXFMSPR",177,0)
;
"RTN","RCXFMSPR",178,0)
; this is a listing for the type of care, first 2 binary digits
"RTN","RCXFMSPR",179,0)
; if column2 is reimbursable health insurance
"RTN","RCXFMSPR",180,0)
B00 ;;Inpatient (Hosp)
"RTN","RCXFMSPR",181,0)
B01 ;;Outpatient
"RTN","RCXFMSPR",182,0)
B10 ;;Nursing Home
"RTN","RCXFMSPR",183,0)
B11 ;;Other
"RTN","RCXFMSPR",184,0)
;
"RTN","RCXFMSPR",185,0)
;
"RTN","RCXFMSPR",186,0)
; this is a listing for the service connected, binary digit 3
"RTN","RCXFMSPR",187,0)
C0 ;;SC for NSC
"RTN","RCXFMSPR",188,0)
C1 ;;NSC Vet
"RTN","RCXFMSPR",189,0)
;
"RTN","RCXFMSPR",190,0)
;
"RTN","RCXFMSPR",191,0)
; this is a listing for means test, binary digit 4
"RTN","RCXFMSPR",192,0)
D0 ;;MT Cat A
"RTN","RCXFMSPR",193,0)
D1 ;;MT Cat C
"RTN","RCXFMSPR",194,0)
;
"RTN","RCXFMSPR",195,0)
;
"RTN","RCXFMSPR",196,0)
; this is a listing for age group, binary digit 5
"RTN","RCXFMSPR",197,0)
E0 ;;Age <65
"RTN","RCXFMSPR",198,0)
E1 ;;Age 65+
"RTN","RCXFMSPR",199,0)
;
"RTN","RCXFMSPR",200,0)
;
"RTN","RCXFMSPR",201,0)
; Community Care RSC listing PRCA*4.5*338
"RTN","RCXFMSPR",202,0)
CCADRSC ;;
"RTN","RCXFMSPR",203,0)
;;8C6C;CC 3rd-Pty Workers' Comp
"RTN","RCXFMSPR",204,0)
;;8C5C;CC 3rd-Pty Tort Feasor
"RTN","RCXFMSPR",205,0)
;;8C4C;CC 3rd-Pty No-Fault Auto
"RTN","RCXFMSPR",206,0)
;;8C1C;CC 3rd-Pty Inpatient
"RTN","RCXFMSPR",207,0)
;;8C2C;CC 3rd-Pty Outpatient
"RTN","RCXFMSPR",208,0)
;;8C3C;CC 3rd-Pty RX
"RTN","RCXFMSPR",209,0)
;;86CC;CC Choice 3rd-Pty Workers' Comp
"RTN","RCXFMSPR",210,0)
;;85CC;CC Choice 3rd-Pty Tort Feasor
"RTN","RCXFMSPR",211,0)
;;84CC;CC Choice 3rd-Pty No-Fault Auto
"RTN","RCXFMSPR",212,0)
;;81CC;CC Choice 3rd-Pty Inpatient
"RTN","RCXFMSPR",213,0)
;;82CC;CC Choice 3rd-Pty Outpatient
"RTN","RCXFMSPR",214,0)
;;83CC;CC Choice 3rd-Pty RX
"RTN","RCXFMSPR",215,0)
;;8CD4;CC DOD 3rd-Pty Inpatient
"RTN","RCXFMSPR",216,0)
;;8CD5;CC DOD 3rd-Pty Outpatient
"RTN","RCXFMSPR",217,0)
;;8CD6;CC DOD 3rd-Pty RX
"RTN","RCXFMSPR",218,0)
;;8CNW;CCN 3rd-Pty Workers' Comp
"RTN","RCXFMSPR",219,0)
;;8CN9;CCN 3rd-Pty Tort Feasor
"RTN","RCXFMSPR",220,0)
;;8CN8;CCN 3rd-Pty No-Fault Auto
"RTN","RCXFMSPR",221,0)
;;8CN5;CCN 3rd-Pty Inpatient
"RTN","RCXFMSPR",222,0)
;;8CN6;CCN 3rd-Pty Outpatient
"RTN","RCXFMSPR",223,0)
;;8CN7;CCN 3rd-Pty RX
"RTN","RCXFMSPR",224,0)
;;8CC1;CC 1st-Pty Inpatient
"RTN","RCXFMSPR",225,0)
;;8CC2;CC 1st-Pty Outpatient
"RTN","RCXFMSPR",226,0)
;;8CC3;CC 1st-Pty RX
"RTN","RCXFMSPR",227,0)
;;8CC4;CC 1st-Pty LTC
"RTN","RCXFMSPR",228,0)
;;8CC5;CC Choice 1st-Pty Inpatient
"RTN","RCXFMSPR",229,0)
;;8CC6;CC Choice 1st-Pty Outpatient
"RTN","RCXFMSPR",230,0)
;;8CC7;CC Choice 1st-Pty RX
"RTN","RCXFMSPR",231,0)
;;8CC8;CC Choice 1st-Pty LTC
"RTN","RCXFMSPR",232,0)
;;8CN1;CCN 1st-Pty Inpatient
"RTN","RCXFMSPR",233,0)
;;8CN2;CCN 1st-Pty Outpatient
"RTN","RCXFMSPR",234,0)
;;8CN3;CCN 1st-Pty RX
"RTN","RCXFMSPR",235,0)
;;8CN4;CCN 1st-Pty LTC
"RTN","RCXFMSPR",236,0)
;;8CD1;CC DOD 1st-Pty Inpatient
"RTN","RCXFMSPR",237,0)
;;8CD2;CC DOD 1st-Pty Outpatient
"RTN","RCXFMSPR",238,0)
;;8CD3;CC DOD 1st-Pty RX
"RTN","RCXFMSPR",239,0)
;;END
"RTN","RCXFMSUF")
0^8^B57862958
"RTN","RCXFMSUF",1,0)
RCXFMSUF ;WISC/RFJ-calculate fms fund code for a bill ; 10/20/10 10:37am
"RTN","RCXFMSUF",2,0)
;;4.5;Accounts Receivable;**90,101,135,157,160,165,170,203,207,173,211,192,220,235,273,310,315,338,351**;Mar 20, 1995;Build 14
"RTN","RCXFMSUF",3,0)
;;Per VA Directive 6402, this routine should not be modifieD
"RTN","RCXFMSUF",4,0)
Q
"RTN","RCXFMSUF",5,0)
;
"RTN","RCXFMSUF",6,0)
;
"RTN","RCXFMSUF",7,0)
GETFUNDO(TYPE) ; return the fund for other type associated collections
"RTN","RCXFMSUF",8,0)
; type can equal:
"RTN","RCXFMSUF",9,0)
; I for interest A for admin
"RTN","RCXFMSUF",10,0)
; M for marshall fee C for court cost
"RTN","RCXFMSUF",11,0)
I TYPE="I" Q "1435"
"RTN","RCXFMSUF",12,0)
I TYPE="A" Q "3220"
"RTN","RCXFMSUF",13,0)
I TYPE="M" Q "0869"
"RTN","RCXFMSUF",14,0)
I TYPE="C" Q "0869"
"RTN","RCXFMSUF",15,0)
Q ""
"RTN","RCXFMSUF",16,0)
;
"RTN","RCXFMSUF",17,0)
;
"RTN","RCXFMSUF",18,0)
GETFUNDB(BILLDA,DONTSTOR,RCEFT) ; return a bills fms fund code
"RTN","RCXFMSUF",19,0)
; pass DONTSTOR equal 1 to prevent storing the fund code
"RTN","RCXFMSUF",20,0)
; cannot rely on data in the fund field since it may reference the
"RTN","RCXFMSUF",21,0)
; old funds S FUND=$P($G(^PRCA(430,BILLDA,11)),"^",17). since there
"RTN","RCXFMSUF",22,0)
; are reports which use 11;17, set it for a bill once its computed
"RTN","RCXFMSUF",23,0)
; until all references to the fund are eliminated.
"RTN","RCXFMSUF",24,0)
; rceft = 1 if processing an EFT deposit
"RTN","RCXFMSUF",25,0)
;
"RTN","RCXFMSUF",26,0)
N ACTDATE,CATEGDA,FUND,NEWFUND
"RTN","RCXFMSUF",27,0)
;
"RTN","RCXFMSUF",28,0)
; calculate a bills fund
"RTN","RCXFMSUF",29,0)
I $G(RCEFT)=1 S FUND="5287"_$S(DT<3030926:"",DT'<3030926&(DT<$$ADDPTEDT^PRCAACC()):".4",1:"04") Q FUND
"RTN","RCXFMSUF",30,0)
S CATEGDA=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
"RTN","RCXFMSUF",31,0)
I CATEGDA>84 Q ""
"RTN","RCXFMSUF",32,0)
;
"RTN","RCXFMSUF",33,0)
; piece 5 is new fund, remove spaces
"RTN","RCXFMSUF",34,0)
S FUND=$P($TR($T(@CATEGDA)," "),";",5)
"RTN","RCXFMSUF",35,0)
;
"RTN","RCXFMSUF",36,0)
; set fund 528711 for 3rd party RX bills after 4/27/2011
"RTN","RCXFMSUF",37,0)
I $$TYP^IBRFN(BILLDA)="PH" D
"RTN","RCXFMSUF",38,0)
. I (CATEGDA=6)!(CATEGDA=7)!(CATEGDA=9)!(CATEGDA=10),$$CHECKRXS(BILLDA) S FUND=528711
"RTN","RCXFMSUF",39,0)
;
"RTN","RCXFMSUF",40,0)
; if category is vendor(17), ex-employee(15), current employee(16)
"RTN","RCXFMSUF",41,0)
; federal agency refund(13), federal agency reimb(14), military(12)
"RTN","RCXFMSUF",42,0)
; set the fund to what is stored in the file. This was entered
"RTN","RCXFMSUF",43,0)
; by the user during the audit process. If fund is in the file
"RTN","RCXFMSUF",44,0)
; already, do not need to store it again.
"RTN","RCXFMSUF",45,0)
; if category is nursing home proceeds (40), parking fees (41),
"RTN","RCXFMSUF",46,0)
; cwt proceeds (42), comp & pen proceeds (43), enhanced use lease
"RTN","RCXFMSUF",47,0)
; proceeds (44), set the fund to what is stored in the file.
"RTN","RCXFMSUF",48,0)
; This was generated by the software at the time of bill enter.
"RTN","RCXFMSUF",49,0)
I CATEGDA=17!(CATEGDA=15)!(CATEGDA=16)!(CATEGDA=13)!(CATEGDA=14)!(CATEGDA=12)!(CATEGDA=40)!(CATEGDA=41)!(CATEGDA=42)!(CATEGDA=43)!(CATEGDA=44) D
"RTN","RCXFMSUF",50,0)
. I $P($G(^PRCA(430,BILLDA,11)),"^",17)'="" S FUND=$P(^(11),"^",17),DONTSTOR=1
"RTN","RCXFMSUF",51,0)
;
"RTN","RCXFMSUF",52,0)
; public law states that bills in the category ineligible (1),
"RTN","RCXFMSUF",53,0)
; emerg/human (2), torts (10), or medicare (21) which are older
"RTN","RCXFMSUF",54,0)
; than oct 1, 1992 should be reported under fund 3220.
"RTN","RCXFMSUF",55,0)
I CATEGDA=1!(CATEGDA=2)!(CATEGDA=10)!(CATEGDA=21) D
"RTN","RCXFMSUF",56,0)
. S ACTDATE=$P($G(^PRCA(430,BILLDA,6)),"^",21)
"RTN","RCXFMSUF",57,0)
. I ACTDATE,ACTDATE<2921001 S FUND=3220 Q
"RTN","RCXFMSUF",58,0)
. ;
"RTN","RCXFMSUF",59,0)
. ; patch157 changes ineligibles. an ineligible activated before
"RTN","RCXFMSUF",60,0)
. ; oct 1, 1992 or after sep 30, 2000 will be recorded in fund 0160A1.
"RTN","RCXFMSUF",61,0)
. ; otherwise it will be recorded in fund 5287.3 if before 3040928
"RTN","RCXFMSUF",62,0)
. ; if 3040928 or after, fund should be 528703
"RTN","RCXFMSUF",63,0)
. I CATEGDA=1,ACTDATE,ACTDATE<3001001 S FUND=$S(DT<$$ADDPTEDT^PRCAACC():"5287.3",1:528703)
"RTN","RCXFMSUF",64,0)
;
"RTN","RCXFMSUF",65,0)
; set the fund for the bill
"RTN","RCXFMSUF",66,0)
; PRCA*4.5*310/DRF Add Non-VA fund 528713
"RTN","RCXFMSUF",67,0)
;
"RTN","RCXFMSUF",68,0)
I $G(DONTSTOR)'=1 D STORE^RCXFMSUR(BILLDA,"",FUND)
"RTN","RCXFMSUF",69,0)
;
"RTN","RCXFMSUF",70,0)
; PRCA*4.5*338 Added funds for Community Care
"RTN","RCXFMSUF",71,0)
I FUND>528704,FUND<528709!(FUND=528710)!(FUND=528711) Q FUND
"RTN","RCXFMSUF",72,0)
I FUND=528713 Q FUND
"RTN","RCXFMSUF",73,0)
I FUND=528714 Q FUND
"RTN","RCXFMSUF",74,0)
;
"RTN","RCXFMSUF",75,0)
I $G(REPRODT),REPRODT<3030926,$E(FUND,1,4)=5287 Q 5287
"RTN","RCXFMSUF",76,0)
I $G(REPRODT),REPRODT<3031001,$E(FUND,1,4)=5287,$G(REFMS) Q 5287
"RTN","RCXFMSUF",77,0)
I DT<3030926,$E(FUND,1,4)=5287 Q 5287 ; Effective date
"RTN","RCXFMSUF",78,0)
I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528709 Q 4032 ;Effective date-528709
"RTN","RCXFMSUF",79,0)
I $G(REPRODT),REPRODT<3041001,FUND=528709,$G(REFMS) Q 4032 ;Resubmitted documents not held
"RTN","RCXFMSUF",80,0)
I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528709 Q 4032
"RTN","RCXFMSUF",81,0)
I DT<$$ADDPTEDT^PRCAACC(),FUND=528709 Q 4032
"RTN","RCXFMSUF",82,0)
I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528701 Q 5287.1 ;Effective date-528701
"RTN","RCXFMSUF",83,0)
I $G(REPRODT),REPRODT<3041001,FUND=528701,$G(REFMS) Q 5287.1 ;Resubmitted documents not held
"RTN","RCXFMSUF",84,0)
I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528701 Q 5287.1
"RTN","RCXFMSUF",85,0)
I DT<$$ADDPTEDT^PRCAACC(),FUND=528701 Q 5287.1
"RTN","RCXFMSUF",86,0)
I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528703 Q 5287.3 ;Effective date-528703
"RTN","RCXFMSUF",87,0)
I $G(REPRODT),REPRODT<3041001,FUND=528703,$G(REFMS) Q 5287.3 ;Resubmitted documents not held
"RTN","RCXFMSUF",88,0)
I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528703 Q 5287.3
"RTN","RCXFMSUF",89,0)
I DT<$$ADDPTEDT^PRCAACC(),FUND=528703 Q 5287.3
"RTN","RCXFMSUF",90,0)
I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528704 Q 5287.4 ;Effective date-528704
"RTN","RCXFMSUF",91,0)
I $G(REPRODT),REPRODT<3041001,FUND=528704,$G(REFMS) Q 5287.4 ;Resubmitted documents not held
"RTN","RCXFMSUF",92,0)
I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528704 Q 5287.4
"RTN","RCXFMSUF",93,0)
I DT<$$ADDPTEDT^PRCAACC(),FUND=528704 Q 5287.4
"RTN","RCXFMSUF",94,0)
Q FUND
"RTN","RCXFMSUF",95,0)
;
"RTN","RCXFMSUF",96,0)
CHECKRXS(BILLDA) ; returns true (1) if bill has any scripts on or after 4/27/11
"RTN","RCXFMSUF",97,0)
N RXNUM,NEWFUND,FILLDT,ARRXS
"RTN","RCXFMSUF",98,0)
S NEWFUND=0
"RTN","RCXFMSUF",99,0)
D SET^IBCSC5A(BILLDA,.ARRXS,)
"RTN","RCXFMSUF",100,0)
S RXNUM=0,FILLDT=""
"RTN","RCXFMSUF",101,0)
F S RXNUM=$O(ARRXS(RXNUM)) Q:RXNUM'>0!(NEWFUND) D
"RTN","RCXFMSUF",102,0)
. S FILLDT=$O(ARRXS(RXNUM,0))
"RTN","RCXFMSUF",103,0)
. I FILLDT'<3110427 S NEWFUND=1
"RTN","RCXFMSUF",104,0)
Q NEWFUND
"RTN","RCXFMSUF",105,0)
;
"RTN","RCXFMSUF",106,0)
; this is a listing of all categories and associated funds
"RTN","RCXFMSUF",107,0)
; the label is from the internal entry number in the category
"RTN","RCXFMSUF",108,0)
; file 430.2. piece 3 is a description, piece 4 is the old fund,
"RTN","RCXFMSUF",109,0)
; piece 5 is the new fund
"RTN","RCXFMSUF",110,0)
; PRCA*4.5*310/DRF Added 45 - FEE REIMB INS to routine.
"RTN","RCXFMSUF",111,0)
0 ;;no fund ; ;
"RTN","RCXFMSUF",112,0)
1 ;;INELIGIBLE HOSP. ;3220 ;0160R1
"RTN","RCXFMSUF",113,0)
2 ;;EMERGENCY/HUMANITARIAN ;0160A1 ;528703
"RTN","RCXFMSUF",114,0)
3 ;;NURSING HOME CARE(NSC) ;2431 ;528703
"RTN","RCXFMSUF",115,0)
4 ;;OUTPATIENT CARE(NSC) ;2431 ;528703
"RTN","RCXFMSUF",116,0)
5 ;;HOSPITAL CARE (NSC) ;2431 ;528703
"RTN","RCXFMSUF",117,0)
6 ;;WORKMAN'S COMP. ;5014 ;528704
"RTN","RCXFMSUF",118,0)
7 ;;NO-FAULT AUTO ACC. ;5014 ;528704
"RTN","RCXFMSUF",119,0)
8 ;;CRIME OF PER.VIO. ;5014 ;528704
"RTN","RCXFMSUF",120,0)
9 ;;REIMBURS.HEALTH INS. ;5014 ;528704
"RTN","RCXFMSUF",121,0)
10 ;;TORT FEASOR ;0160A1 ;528704
"RTN","RCXFMSUF",122,0)
11 ;;no entry ; ;
"RTN","RCXFMSUF",123,0)
12 ;;MILITARY ;0160A1 ;0160R1
"RTN","RCXFMSUF",124,0)
13 ;;FEDERAL AGENCIES-REFUND ;0160A1 ;0160A1
"RTN","RCXFMSUF",125,0)
14 ;;FEDERAL AGENCIES-REIMB. ;0160R1 ;0160R1
"RTN","RCXFMSUF",126,0)
15 ;;EX-EMPLOYEE ;0160A1 ;0160A1
"RTN","RCXFMSUF",127,0)
16 ;;CURRENT EMP. ;0160A1 ;0160A1
"RTN","RCXFMSUF",128,0)
17 ;;VENDOR ;0160A1 ;0160A1
"RTN","RCXFMSUF",129,0)
18 ;;C (MEANS TEST) ;2431 ;528703
"RTN","RCXFMSUF",130,0)
19 ;;SHARING AGREEMENTS ;0160A1 ;0160R1
"RTN","RCXFMSUF",131,0)
20 ;;INTERAGENCY ;0160A1 ;0160R1
"RTN","RCXFMSUF",132,0)
21 ;;MEDICARE ;5014 ;528704
"RTN","RCXFMSUF",133,0)
22 ;;RX CO-PAYMENT/SC VET ;5014 ;528701
"RTN","RCXFMSUF",134,0)
23 ;;RX CO-PAYMENT/NSC VET ;5014 ;528701
"RTN","RCXFMSUF",135,0)
24 ;;NURSING HOME CARE PER DIEM ;2431 ;528703
"RTN","RCXFMSUF",136,0)
25 ;;HOSPITAL CARE PER DIEM ;2431 ;528703
"RTN","RCXFMSUF",137,0)
26 ;;PREPAYMENT ;5014 ;528703
"RTN","RCXFMSUF",138,0)
27 ;;CHAMPVA SUBSISTENCE ;3220 ;3220
"RTN","RCXFMSUF",139,0)
28 ;;CHAMPVA THIRD PARTY ;3220 ;0160R1
"RTN","RCXFMSUF",140,0)
29 ;;CHAMPVA ;0160A1 ;0160R1
"RTN","RCXFMSUF",141,0)
30 ;;TRICARE ;0160A1 ;0160R1
"RTN","RCXFMSUF",142,0)
31 ;;TRICARE PATIENT ;0160A1 ;0160R1
"RTN","RCXFMSUF",143,0)
32 ;;TRICARE THIRD PARTY ;0160A1 ;0160R1
"RTN","RCXFMSUF",144,0)
33 ;;ADULT DAY HEALTH CARE ;4032 ;528709
"RTN","RCXFMSUF",145,0)
34 ;;DOMICILIARY ;4032 ;528709
"RTN","RCXFMSUF",146,0)
35 ;;RESPITE CARE-INSTITUTIONAL ;4032 ;528709
"RTN","RCXFMSUF",147,0)
36 ;;RESPITE CARE-NON-INSTITUTIONAL;4032 ;528709
"RTN","RCXFMSUF",148,0)
37 ;;GERIATRIC EVAL-INSTITUTIONAL ;4032 ;528709
"RTN","RCXFMSUF",149,0)
38 ;;GERIATRIC EVAL-NON-INSTITUTION;4032 ;528709
"RTN","RCXFMSUF",150,0)
39 ;;NURSING HOME CARE-LTC ;4032 ;528709
"RTN","RCXFMSUF",151,0)
40 ;;NURSING HOME PROCEEDS ; ;528705
"RTN","RCXFMSUF",152,0)
41 ;;PARKING FEES ; ;528706
"RTN","RCXFMSUF",153,0)
42 ;;CWT PROCEEDS ; ;528707
"RTN","RCXFMSUF",154,0)
43 ;;COMP & PEN PROCEEDS ; ;528708
"RTN","RCXFMSUF",155,0)
44 ;;ENHANCED USE LEASE PROCEEDS ;5358.3 ;528710
"RTN","RCXFMSUF",156,0)
45 ;;FEE REIMB INS ; ;528713
"RTN","RCXFMSUF",157,0)
46 ;;EMERGENCY/HUMANITARIAN REIMB. ; ;528704 ;315
"RTN","RCXFMSUF",158,0)
47 ;;INELIGIBLE REIMB. INS. ; ;0160R1 ;315
"RTN","RCXFMSUF",159,0)
48 ;;CHOICE THIRD PARTY ; ;528713
"RTN","RCXFMSUF",160,0)
49 ;;CC THIRD PARTY ; ;528713
"RTN","RCXFMSUF",161,0)
50 ;;CCN THIRD PARTY ; ;528713
"RTN","RCXFMSUF",162,0)
51 ;;CC MTF THIRD PARTY ; ;528713
"RTN","RCXFMSUF",163,0)
52 ;;CHOICE NO-FAULT AUTO ; ;528713
"RTN","RCXFMSUF",164,0)
53 ;;CHOICE TORT FEASOR ; ;528713
"RTN","RCXFMSUF",165,0)
54 ;;CCN WORKERS' COMP ; ;528713
"RTN","RCXFMSUF",166,0)
55 ;;CCN NO-FAULT AUTO ; ;528713
"RTN","RCXFMSUF",167,0)
56 ;;CCN TORT FEASOR ; ;528713
"RTN","RCXFMSUF",168,0)
57 ;;CC WORKERS' COMP ; ;528713
"RTN","RCXFMSUF",169,0)
58 ;;CC NO-FAULT AUTO ; ;528713
"RTN","RCXFMSUF",170,0)
59 ;;CC TORT FEASOR ; ;528713
"RTN","RCXFMSUF",171,0)
60 ;;CHOICE WORKERS' COMP ; ;528713
"RTN","RCXFMSUF",172,0)
61 ;;CHOICE INPT ; ;528714
"RTN","RCXFMSUF",173,0)
62 ;;CHOICE RX CO-PAYMENT ; ;528714
"RTN","RCXFMSUF",174,0)
63 ;;CC INPT ; ;528714
"RTN","RCXFMSUF",175,0)
64 ;;CC RX CO-PAYMENT ; ;528714
"RTN","RCXFMSUF",176,0)
65 ;;CCN INPT ; ;528714
"RTN","RCXFMSUF",177,0)
66 ;;CCN RX CO-PAYMENT ; ;528714
"RTN","RCXFMSUF",178,0)
67 ;;CC MTF INPT ; ;528714
"RTN","RCXFMSUF",179,0)
68 ;;CC MTF RX CO-PAYMENT ; ;528714
"RTN","RCXFMSUF",180,0)
69 ;;CC NURSING HOME CARE - LTC ; ;528714
"RTN","RCXFMSUF",181,0)
70 ;;CC RESPITE CARE ; ;528714
"RTN","RCXFMSUF",182,0)
71 ;;CCN NURSING HOME CARE - LTC ; ;528714
"RTN","RCXFMSUF",183,0)
72 ;;CCN RESPITE CARE ; ;528714
"RTN","RCXFMSUF",184,0)
73 ;;CHOICE NURSING HOME CARE - LTC ; ;528714
"RTN","RCXFMSUF",185,0)
74 ;;CHOICE RESPITE CARE ; ;528714
"RTN","RCXFMSUF",186,0)
75 ;;TRICARE DES ; ;0160R1
"RTN","RCXFMSUF",187,0)
76 ;;TRICARE SCI ; ;0160R1
"RTN","RCXFMSUF",188,0)
77 ;;TRICARE TBI ; ;0160R1
"RTN","RCXFMSUF",189,0)
78 ;;TRICARE BLIND REHABILITATION ; ;0160R1
"RTN","RCXFMSUF",190,0)
79 ;;TRICARE DENTAL ; ;0160R1
"RTN","RCXFMSUF",191,0)
80 ;;TRICARE PHARMACY ; ;0160R1
"RTN","RCXFMSUF",192,0)
81 ;;CHOICE OPT ; ;528714
"RTN","RCXFMSUF",193,0)
82 ;;CC OPT ; ;528714
"RTN","RCXFMSUF",194,0)
83 ;;CCN OPT ; ;528714
"RTN","RCXFMSUF",195,0)
84 ;;CC MTF OPT ; ;528714
"VER")
8.0^22.2
**END**
**END**