source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJRCO.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1RCRJRCO ;WISC/RFJ-control collection of monthly data ;1 Nov 97
2 ;;4.5;Accounts Receivable;**96,106,101,103,147,156,169,170,174,191,203,239**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; called by menu option to regenerate monthly data
5 N %,%DT,%X,%Y,DA347,DIQ2,DATEMOYR,FMSDOCNO,GECSDATA,LASTMONT,RCRJFAR1,RCRJFAR2,RCRJFBDR,RCRJFOIG,RCRJFSV,RCRJFTR,RCRJFWR,X,Y,ZTSK,RCNOHSIF
6 ;
7 S RCNOHSIF=$$NOHSIF() ; HSIF is disabed
8 ;
9 W !!,"This option will re-run the AR Data Collector, extracting data from"
10 W !,"the AR database and sending the data to the National Database and FMS."
11 W !,"It will also re-generate the Bad Debt Report and the OIG Extract."
12 W !!,"This option will perform the following tasks:",!
13 W !," 1. Re-send the data to the National Database. The data will only be"
14 W !," re-sent if you answer YES to the prompt. The data will only be"
15 W !," accepted in the NDB if the month-year has not been closed (in the NDB)."
16 W !," 2. Re-send the data to FMS on the SV and WR documents. The data"
17 W !," will only be re-sent if it has not been previously accepted by FMS."
18 W !," 3. Re-send the OIG Extract. If the selected month is the end of the"
19 W !," quarter (December, March, June, or September), the OIG Extract can"
20 W !," be re-generated."
21 ;
22 ; do not allow dates in future to be selected
23 ;S (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
24 I $E(DT,6,7)'>$E($$LDATE^RCRJR(DT),6,7) S (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
25 I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S (LASTMONT,DATEMOYR)=$E($$LDATE^RCRJR(DT),1,5)_"00"
26 S %DT(0)=-LASTMONT
27 S %DT("A")="Retransmit AR Data Collector data for Month/Year: "
28 S %DT="AEMP"
29 W ! D ^%DT
30 I Y<1 Q
31 ;
32 S (DATEMOYR,Y)=$E(Y,1,5)_"00" D DD^%DT
33 ;
34 ; try and find SV document to see if its accepted
35 K GECSDATA
36 D KEYLOOK^GECSSGET("SV-"_DATEMOYR,1)
37 I $G(GECSDATA) D Q:'$G(GECSDATA)
38 . W !!,"The SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
39 . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
40 . . W !,"The SV document has been ACCEPTED in FMS and will not be resent."
41 . . S RCRJFSV=1
42 . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
43 . . W !,"The SV document has REJECTED and will be RETRANSMITTED."
44 . W !,"The SV document has NOT been ACCEPTED in FMS."
45 . S %=$$ASKTRANS I %<0 K GECSDATA Q
46 . I %'=1 S RCRJFSV=1 ;do not send document
47 ;
48 ; try and find WR document to see if its accepted
49 K GECSDATA
50 D KEYLOOK^GECSSGET("WR-"_DATEMOYR,1)
51 I $G(GECSDATA) D Q:'$G(GECSDATA)
52 . W !!,"The WR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
53 . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
54 . . W !,"The WR document has been ACCEPTED in FMS and will not be resent."
55 . . S RCRJFWR=1
56 . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
57 . . W !,"The WR document has REJECTED and will be RETRANSMITTED."
58 . W !,"The WR document has NOT been ACCEPTED in FMS."
59 . S %=$$ASKTRANS I %<0 K GECSDATA Q
60 . I %'=1 S RCRJFWR=1 ;do not send document
61 ;
62 ; try and find the Bad Debt SV document to see if its accepted
63 K GECSDATA
64 D KEYLOOK^GECSSGET("SV-"_$E(DATEMOYR,1,5)_"01",1)
65 I $G(GECSDATA) D Q:'$G(GECSDATA)
66 . W !!,"The Bad Debt SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
67 . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
68 . . W !,"The Bad Debt SV document has been ACCEPTED in FMS and will not be resent."
69 . . S RCRJFBDR=1
70 . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
71 . . W !,"The Bad Debt SV document has REJECTED and will be RETRANSMITTED."
72 . W !,"The Bad Debt SV document has NOT been ACCEPTED in FMS."
73 . S %=$$ASKTRANS I %<0 K GECSDATA Q
74 . I %'=1 S RCRJFBDR=1 ;do not send document
75 ;
76 ; try and find TR document to see if its accepted
77 K GECSDATA
78 I 'RCNOHSIF D KEYLOOK^GECSSGET("TR-"_DATEMOYR,1)
79 I $G(GECSDATA) D Q:'$G(GECSDATA)
80 . W !!,"The TR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
81 . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
82 . . W !,"The TR document has been ACCEPTED in FMS and will not be resent."
83 . . S RCRJFTR=1
84 . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
85 . . W !,"The TR document has REJECTED and will be RETRANSMITTED."
86 . W !,"The TR document has NOT been ACCEPTED in FMS."
87 . S %=$$ASKTRANS I %<0 K GECSDATA Q
88 . I %'=1 S RCRJFTR=1 ;do not send document
89 ;
90 I RCNOHSIF S RCRJFTR=1 ;do not send TR if disabled
91 ;
92 ; ask to resend AR1 NDB data
93 S %=$$ASKNDB("AR1") I %<0 Q
94 I %'=1 S RCRJFAR1=1 ;do not send to ndb
95 ;
96 ; ask to resend AR2 NDB data
97 S %=$$ASKNDB("AR2") I %<0 Q
98 I %'=1 S RCRJFAR2=1 ;do not send to ndb
99 ;
100 ; ask to resend the OIG extract
101 S RCRJFOIG=1 ; resend the OIG extract
102 D I %<0 Q
103 . S %=$$ASKOIG I %<0 Q
104 . I %=1 S RCRJFOIG=0 ;re-send oig extract
105 ;
106 ;
107 I $G(RCRJFAR1),$G(RCRJFAR2),$G(RCRJFSV),$G(RCRJFWR),$G(RCRJFTR),$G(RCRJFBDR),$G(RCRJFOIG) W !!,"No reports have been selected for retransmission." Q
108 ;
109 W !!,"This option will retransmit the following monthly reports:"
110 I '$G(RCRJFAR1) W !," AR1 to the NDB."
111 I '$G(RCRJFAR2) W !," AR2 to the NDB."
112 I '$G(RCRJFSV) W !," SV document to FMS."
113 I '$G(RCRJFWR) W !," WR document to FMS."
114 I '$G(RCRJFTR) W !," TR document to FMS."
115 I '$G(RCRJFBDR) W !," rebuild the Bad Debt Report."
116 I '$G(RCRJFOIG) W !," resend the OIG Extract."
117 ;
118 I $$ASKOKAY(DATEMOYR)=1 D
119 . W !!,"This will be queued to run in the background. When it completes,"
120 . W !,"a mail message will be sent to the mail group RC AR DATA COLLECTOR."
121 . S ZTDESC="AR Data Collector",ZTRTN="DQ^RCRJRCO",ZTDTH=$H,ZTIO=""
122 . S ZTSAVE("DATEMOYR")="",ZTSAVE("RCRJF*")="",ZTSAVE("ZTREQ")="@"
123 . D ^%ZTLOAD
124 . W !!,"Queued to run in task ",$G(ZTSK)
125 Q
126 ;
127 ;
128DQ ; start collection of monthly data
129 ; datemoyr is for the month and year to run collector (ex 2971000)
130 ; rcrjfsv and rcrjfwr are flags to stop the sv and wr documents
131 ; rcrjfbdr is a flag to stop the rebuild of the bad debt report
132 N %,DATEBEG,DATEEND,PRCASITE,X
133 ;
134 I $$NOHSIF() S RCRJFTR=1 ; disable TR to FMS
135 ; get last month
136 I $G(DATEMOYR) S DATEEND=$$LDATE^RCRJR(DATEMOYR)
137 I '$G(DATEMOYR) S DATEEND=$$LDATE^RCRJR(DT),DATEMOYR=$E(DATEEND,1,5)_"00"
138 ;
139 ;S DATEBEG=$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1
140 S DATEBEG=$S(+$E(DATEEND,2,5)=309:$E(DATEEND,1,5)_"01",1:$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1)
141 ;S DATEEND=$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(DATEMOYR,4,5)) I DATEEND=28,((17+$E(DATEMOYR))_$E(DATEMOYR,2,3))#4=0 S DATEEND=29
142 ;S DATEEND=$$LDATE^RCRJR(DT)
143 ;S DATEEND=$E(DATEMOYR,1,5)_DATEEND
144 ;
145 S PRCASITE=$$SITE^RCMSITE
146 ;
147 ; queue the AR2 data collector to run in the background
148 I '$G(RCRJFAR2) D
149 . S ZTDESC="AR2 Data Collector",ZTRTN="DQ^RCRJRCO2",ZTDTH=$H,ZTIO=""
150 . S ZTSAVE("PRCASITE")="",ZTSAVE("DATEBEG")="",ZTSAVE("DATEEND")="",ZTSAVE("ZTREQ")="@"
151 . D ^%ZTLOAD
152 ;
153 ; no point in running data collector, nothing being sent
154 I $G(RCRJFAR1),$G(RCRJFSV),$G(RCRJFWR),$G(RCRJFTR),$G(RCRJFBDR),$G(RCRJFOIG) Q
155 ;
156 ; run the AR1 data collector
157 D START^RCRJRCOL(PRCASITE,DATEBEG,DATEEND)
158 Q
159 ;
160 ;
161ASKNDB(REPORT) ; ask to resend to national database
162 ; report = AR1 or AR2
163 ; 1 is yes, otherwise no
164 N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
165 S DIR(0)="YO",DIR("B")="NO"
166 S DIR("A")=" Do you want to resend the "_REPORT_" data to the National Database"
167 W ! D ^DIR
168 I $G(DTOUT)!($G(DUOUT)) S Y=-1
169 Q Y
170 ;
171 ;
172ASKBDR() ; ask to rebuild the bad debt report
173 ; 1 is yes, otherwise no
174 N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
175 S DIR(0)="YO",DIR("B")="NO"
176 S DIR("A")=" Do you want to rebuild the Bad Debt Report"
177 W ! D ^DIR
178 I $G(DTOUT)!($G(DUOUT)) S Y=-1
179 Q Y
180 ;
181 ;
182ASKOKAY(DATEMOYR) ; ask if its okay
183 ; 1 is yes, otherwise no
184 N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
185 S Y=DATEMOYR D DD^%DT
186 S DIR(0)="YO",DIR("B")="NO"
187 S DIR("A")=" Are you SURE you want to regenerate the data for "_Y
188 W ! D ^DIR
189 I $G(DTOUT)!($G(DUOUT)) S Y=-1
190 Q Y
191 ;
192 ;
193ASKTRANS() ; ask if its okay to retransmit document to FMS
194 ; 1 is yes, otherwise no
195 N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
196 S Y=DATEMOYR D DD^%DT
197 S DIR(0)="YO",DIR("B")="NO"
198 S DIR("A")=" Do you want to regenerate and retransmit this document to FMS"
199 D ^DIR
200 I $G(DTOUT)!($G(DUOUT)) S Y=-1
201 Q Y
202 ;
203 ;
204ASKOIG() ; ask to resend to oig
205 ; 1 is yes, otherwise no
206 N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
207 S DIR(0)="YO",DIR("B")="NO"
208 S DIR("A")=" Do you want to resend the data to the OIG"
209 W ! D ^DIR
210 I $G(DTOUT)!($G(DUOUT)) S Y=-1
211 Q Y
212 ;
213 ;The Date when AAC is ready for Point Accounts:
214PAEFFDT() Q 3031001 ;10/1/2003
215 ;
216 ; The Data Collector cannot send 5287 Point Accounts before the Effective Date
217 ; This function adjusts the fund depending on the current date
218ADJFUND(RCFUND) ;
219 I DT'<$$PAEFFDT() Q RCFUND ; Do nothing after the effective date
220 I $E(RCFUND,1,4)=5287 Q 5287 ; No point accounts before the effective date
221 Q RCFUND
222 ;
223 ; The function returns 1 if MCCF-HSIF transfer is disabled
224NOHSIF() ;
225 Q (DT'<$$PAEFFDT()) ; Disabled after the AAC is ready.
Note: See TracBrowser for help on using the repository browser.