source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCABJ.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.6 KB
RevLine 
[613]1PRCABJ ;WASH-ISC@ALTOONA,PA/LDB,TJK-NIGHTLY PROCESS FOR ACCOUNTS RECEIVABLE ;11/8/96 3:54 PM
2 ;;4.5;Accounts Receivable;**11,34,101,114,155,153,141,165,167,173,201,237**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;This routine is called by the PRCA NIGHTLY PROCESS option which should be run nightly to call the following tasks
6 ;1) Update of interest/admin charges on patients' accounts
7 ;2) Update statement days
8 ;3) Print of Patient Statements, Uniform Billing forms, and non-patient follow-up letters
9 ;4) Purge of Receipts
10 ;5) Creation of TOP (Treasury Offset Program) documents
11 ;6) Print of the Follow-up list
12 ;7) Purge AR Events
13 ;8) Flag prepayments for refund review
14 ;9) Print Comment List
15 ;10) Starts the Repayment Plan Monitor
16 ;11) Generates Diagnostic Measures Workload Reports
17 ;12) Matches EFT with ERA
18 ;13) Generates CBO Data Extract files for Boston ARC
19 ;
20 ;Process will first check and Validate AR pointer files 341.1,
21 ;430.2, and 430.3.
22 ;Process will terminate and send bulletin if files are not valid
23 ;
24EN ;Start of nightly process-check to see if process is already running
25 L +^RC("PRCABJ"):5 Q:'$T
26 NEW ERROR S ERROR=0
27 D VERIFY I ERROR L -^RC("PRCABJ") Q
28 ;
29DRIVER ;All processes are called from this point
30 N CHK,POP,% S CHK=0
31 D CHK,INT,CHK,EN^RCCPCBJ,CHK,STM,CHK,RECPT,CHK,TOP,CHK,EVNT,CHK,BNUM
32 D CHK,ENUM,CHK,PURFMS,CHK,EN3^RCFMOBR,CHK,START^RCRJR,CHK,UB
33 D CHK,STATMNT,CHK,UDLIST^PRCABJ1,CHK,LIST,CHK,COMMENT,CHK,REPAY
34 D CHK,WRKLD,CHK,EFT,CHK,CBO
35 D NOW^%DTC S $P(^RC(342,1,0),"^",10)=%
36 L -^RC("PRCABJ")
37 K ^RC("PRCABJ")
38 Q
39 ;
40CHK ;checkpoint of process
41 S CHK=CHK+1 S ^RC("PRCABJ")=CHK
42 Q
43 ;
44VERIFY ;Verifies Pointer Files--Will HALT Process if Pointer Files Invalid
45 NEW A,B,FILE
46 F FILE=341.1,430.2,430.3 D Q:ERROR
47 .S A=$S(FILE=341.1:"AC;0;2",FILE=430.2:"AC;0;7",1:"AC;0;3")
48 .S B=$S(FILE=341.1:"",1:"C;0;2")
49 .D EN1^PRCABJV(FILE,A,B,.ERROR)
50 .Q:'ERROR
51 .;SEND BULLETIN HERE IF FILE IN ERROR
52 .NEW XMB,XMTEXT,XMDUZ
53 .S XMDUZ="ACCOUNTS RECEIVABLE PACKAGE"
54 .S XMB="PRCA NIGHTLY PROCESS ABORT"
55 .S XMTEXT="ERROR("
56 .D ^XMB
57 .Q
58 Q
59 ;
60INT ; update interest and admin charges for non-benefit debts
61 ; example: vendor, employee, ex-employee
62 D NONBENE^RCBECHGS
63 Q
64 ;
65STM ;Update statement days for PERSONS, VENDORS, and Institutions
66 D STM^PRCABJ1
67 Q
68 ;
69STATMNT ;Print patient statements
70 N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,PRCADEV
71 S (IOP,PRCADEV)=$P($G(^RC(342,1,0)),"^",8)
72 I IOP]"" D
73 .S ZTRTN="PRCAGS",ZTDTH=$H,ZTDESC="Print AR Statements/Letters"
74 .S %ZIS="N0" D ^%ZIS Q:POP
75 .S ZTSAVE("PRCADEV")="" D ^%ZTLOAD,^%ZISC
76 Q
77 ;
78RECPT ;Manage Receipts and Deposits
79 N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
80 S ZTIO="",ZTRTN="MAN^RCDPUT",ZTDTH=$H,ZTDESC="Manage Receipts and Deposits"
81 D ^%ZTLOAD
82 Q
83 ;
84TOP ;Transmit TOP documents
85 Q:$$DOW^XLFDT(DT,1)'=1
86 I DT'<$P($G(^RC(342,1,30)),"^",1)&(DT'>$P($G(^RC(342,1,30)),"^",2)) D ^RCEXINAD
87 N RCM,RCDOC
88 ;Run of TOP documents every Monday
89 I +$E(DT,6,7)>7,$E(DT,6,7)<15 S RCM=1
90 I '$D(^RCD(340,"TOP")),'$G(RCM) Q
91 S RCDOC=$S($G(RCM):"M",1:"U")
92 I $E(DT,4,5)=12,RCDOC="M" S RCDOC="Y"
93TOPQUE N ZTDESC,ZTASK,ZTDTH,ZTIO,ZTRTN,ARDUZ,ZTSAVE
94 S ZTIO="",ZTRTN="^RCTOPD",ZTSAVE("RCDOC")=""
95 S ZTDESC="TOP REFERRAL DOCUMENTS",ZTDTH=$H
96 D ^%ZTLOAD
97 Q
98 ;
99UB ;Print Uniform Billing forms
100 N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
101 S ZTIO="",ZTRTN="PRCALT2",ZTDTH=$H,ZTDESC="Print Reimbursable Health Insurance Uniform Billing forms"
102 D ^%ZTLOAD,^%ZISC
103 Q
104 ;
105LIST ;Print Follow-up List
106 N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,BEG,END,PRCADEV
107 S IOP=$P($G(^RC(342,1,0)),"^",8)
108 I IOP]"" D
109 .S %ZIS="N0" D ^%ZIS Q:POP
110 .S ZTRTN="DQ1^PRCACM",ZTDTH=$H,PRCADEV=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$G(IO("DOC"))
111 .S (ZTSAVE("BEG"),ZTSAVE("END"))=DT,ZTSAVE("PRCADEV")="",ZTDESC="Bill Comment Follow-Up List"
112 .D ^%ZTLOAD,^%ZISC
113 Q
114 ;
115COMMENT ;Print Comment List
116 N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,BEG,END,PRCADEV
117 S IOP=$P($G(^RC(342,1,0)),"^",8)
118 I IOP]"" D
119 .S %ZIS="N0" D ^%ZIS Q:POP
120 .S ZTRTN="DQ2^PRCACM",ZTDTH=$H,PRCADEV=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$G(IO("DOC"))
121 .S (ZTSAVE("BEG"),ZTSAVE("END"))=DT,ZTSAVE("PRCADEV")="",ZTDESC="Debtor Comment Follow-up List"
122 .D ^%ZTLOAD,^%ZISC
123 Q
124 ;
125REPAY ; Starts the Repayment Plan Monitor
126 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
127 S ZTIO="",ZTRTN="EN^RCDMB1MT",ZTDTH=$H,ZTDESC="Repayment Plan Monitor"
128 D ^%ZTLOAD
129 Q
130 ;
131WRKLD ; Generates Diagnostic Measures Workload Reports
132 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
133 S ZTIO="",ZTRTN="DQ^RCDMBWLR",ZTDTH=$H,ZTDESC="Diagnostic Measures Workload Reports"
134 D ^%ZTLOAD
135 Q
136 ;
137EVNT ;Purge AR Events
138 N IOP,ZTIO,ZTDESC,ZTASK,ZTIO,ZTRTN,ZTSAVE,%ZIS
139 S ZTIO="",ZTRTN="PUR^RCEVDRV1",ZTDTH=$H,ZTDESC="Purge AR Event Information" D ^%ZTLOAD
140 Q
141PURFMS ;Purge FMS documents
142 NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
143 S ZTIO="",ZTRTN="EN^RCFMPUR",ZTDESC="AR/FMS DOC PURGE",ZTDTH=$H D ^%ZTLOAD
144 Q
145 ;
146EFT ; Starts matching of EFTs to EOBs job
147 NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
148 S ZTIO="",ZTRTN="EN^RCDPEM",ZTDESC="AR/EDI LOCKBOX MATCHING EFTs",ZTDTH=$H D ^%ZTLOAD
149 Q
150 ;
151BNUM ;Check bill numbering series
152 I $P(^RC(342,1,0),"^",3)="" S $P(^RC(342,1,0),"^",3)="K"_$E($$FY^RCFN01,2)_"00000"
153 I $E($P(^RC(342,1,0),"^",3),2)'=$E($$FY^RCFN01,2) S $P(^RC(342,1,0),"^",3)="K"_$E($$FY^RCFN01,2)_"00000"
154 Q
155ENUM ;Check event numbering series
156 I $P(^RC(342,1,0),"^",6)="" S $P(^RC(342,1,0),"^",6)="K"_$E($$FY^RCFN01,2)_"A0000"
157 I $E($P(^RC(342,1,0),"^",6),2)'=$E($$FY^RCFN01,2) S $P(^RC(342,1,0),"^",6)="K"_$E($$FY^RCFN01,2)_"A0000"
158 Q
159 ;
160CBO ; Create Extract Files for ARC
161 NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
162 S ZTIO="",ZTRTN="EN^RCXVTSK",ZTDESC="CBO DATA EXTRACT",ZTDTH=$H
163 D ^%ZTLOAD
164 Q
Note: See TracBrowser for help on using the repository browser.