source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVTSK.m@ 738

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1RCXVTSK ;DAOU/ALA-AR Data Extract Nightly Task ;23-JUL-03
2 ;;4.5;Accounts Receivable;**201,227,228,232**;Mar 20, 1995
3 ;
4 ;** Program Description **
5 ; This program is the nightly task program for the
6 ; CBO Data Extract to the Boston Allocation Resource
7 ; Center
8 ;
9EN ; Entry point
10 ;
11 ; If a test system has 'turned off' extract, quit
12 I '$$GET1^DIQ(342,"1,",20.04,"I") Q
13 ;
14 N $ES,$ET
15 S $ET="D ER^RCXVTSK"
16 ;
17 L +^RCXVTSK:60 E Q
18 ;
19 ; Purge completed batches
20 S IEN="",DIK="^RCXV("
21 F S IEN=$O(^RCXV("AC","C",IEN)) Q:IEN="" D
22 . S DA=IEN D ^DIK
23 ;
24 K ^TMP("RCXVMSG",$J)
25 ;
26 ; Find all deposits/receipts
27 S RCXVD0="",RCXVRNUM=0,RCXVDT=$$FMADD^XLFDT(DT,-1)
28 F S RCXVD0=$O(^RCY(344,"ASTAT",0,RCXVD0)) Q:RCXVD0="" D
29 . S RCXVEDT=$P($G(^RCY(344,RCXVD0,0)),U,12)\1
30 . I RCXVEDT'=RCXVDT Q
31 . S RCXVRNUM=RCXVRNUM+1
32 . D FIL^RCXVDEQ("R")
33 . D UDR^RCXVDEQ
34 ;
35 K RCXVD0,RCXVRNUM,RCXVDT,RCXVEDT,RCXVDA,RCVXCTY,RCXVBDT
36 ;
37 S RCXVBTN="",RCXVU="^",RCXVXDT=DT
38 ;
39 ; If the CCPC calculation is scheduled to run, don't
40 ; run the nightly task
41 ; Patch 228 changes software to allow nightly task on CCPC date
42 ;S X1=$$STD^RCCPCFN,X2=-3 D C^%DTC I X=DT L -^RCXVTSK K X Q
43 ;K X1,X2
44 ;
45MONTHLY ;Set up monthly transmission batches
46 I $E(DT,6,7)="01" D EN^RCXVDC10
47NM ; Find all new batches to be transmitted
48 S RBSQ=0,RBTOT=0
49 F S RCXVBTN=$O(^RCXV("AC","P",RCXVBTN)) Q:RCXVBTN="" D
50 . I $G(^RCXV(RCXVBTN,0))="" Q
51 . S RBSQ=RBSQ+1,RBTOT=RBTOT+1
52 . I $P(^RCXV(RCXVBTN,0),U,1)'=RCXVBTN S RCXVUP(348.4,RCXVBTN_",",.01)=RCXVBTN
53 . S RCXVUP(348.4,RCXVBTN_",",.05)=RBSQ
54 F S RCXVBTN=$O(RCXVUP(348.4,RCXVBTN)) Q:RCXVBTN="" D
55 . S RCXVUP(348.4,RCXVBTN,.06)=RBTOT
56 D FILE^DIE("","RCXVUP","RCXVERR")
57 K RCXVUP
58 ;
59 S RCXVBTN=""
60STRT ; Start the build and transmission of batches
61 D ^RCXVCHK
62 F RCSTAT="T","P" F S RCXVBTN=$O(^RCXV("AC",RCSTAT,RCXVBTN)) Q:RCXVBTN="" D
63 . S RCXVBLN=0,RQFL=0
64 . S RCXVSITE=$P($$SITE^VASITE(),U,3)
65 . S RCXVDIR=$P($G(^RC(342,1,20)),U,1)
66 . S RCXVBDT=$P($G(^RCXV(RCXVBTN,0)),U,2)
67 . S RCXVBTY=$P($G(^RCXV(RCXVBTN,0)),U,4)
68 . S RCXVSEQ=$P($G(^RCXV(RCXVBTN,0)),U,5)
69 . S RCXVSTOT=$P($G(^RCXV(RCXVBTN,0)),U,6)
70 . S RCXVLDOM=$P($G(^RC(342,1,20)),U,8)
71 . ;S RCXVLEG=+$P($G(^RC(342,1,20)),U,7)
72 . ;
73 . I RCSTAT'="T" D Q:RQFL
74 .. I $G(RCXVSEQ)="" S RQFL=1 Q
75 .. I $P(^RCXV(RCXVBTN,0),U,3)="C" S RQFL=1 Q
76 .. S RCXVUP(348.4,RCXVBTN_",",.03)="T"
77 .. D FILE^DIE("I","RCXVUP","RCXVERR")
78 .. K RCXVUP
79 . ;
80 . ; If a file has been transmitted but no acknowledgement
81 . ; has been received after 5 days, resend
82 . I RCSTAT="T" D Q:RQFL
83 .. S RCXVTRD=$P($G(^RCXV(RCXVBTN,0)),U,8)\1
84 .. S RCXVARD=$P($G(^RCXV(RCXVBTN,0)),U,9)\1
85 .. I $$FMADD^XLFDT(RCXVTRD,5)>DT S RQFL=1
86 .. ;I RCXVARD=0,RCXVLEG,RCXVTRD'=0 S RQFL=1
87 . ;
88 . Q:RQFL
89 . ; FILENAME=SITE_DATE_BATCH#
90 . S RCXVFILE="RCXV"_RCXVSITE_RCXVBDT_RCXVBTN_".TXT"
91 . S RCXVSCR="TMP_RCXV"_RCXVSITE_"_"_RCXVBTN
92 . D OPEN^%ZISH("RCXVHNDL",RCXVDIR,RCXVFILE,"W")
93 . U IO
94 . S RCXVDMN=$P($G(^XTV(8989.3,1,0)),U,1)
95 . S RCXVDMN=$P($G(^DIC(4.2,RCXVDMN,0)),U,1)
96 . S RCXVRN=$P($G(^RCXV(RCXVBTN,1,0)),U,4) ; # OF REC FOR BILLS
97 . I RCXVRN="" S RCXVRN=$P($G(^RCXV(RCXVBTN,2,0)),U,4) ; # REC DEP/REC
98 . S RCXVRT=$P($G(^RCXV(RCXVBTN,0)),U,4) ; TYPE OF DATA
99 . W "HDR:"_RCXVSITE_RCXVU_RCXVDMN_RCXVU_RCXVRT_RCXVU_RCXVRN_RCXVU_RCXVBDT_RCXVU_RCXVXDT_RCXVU_RCXVSEQ_RCXVU_RCXVSTOT_RCXVU_RCXVLDOM,!
100 . F S RCXVBLN=$O(^RCXV(RCXVBTN,1,RCXVBLN)) Q:'RCXVBLN D
101 .. S DFN=$P(^RCXV(RCXVBTN,1,RCXVBLN,0),U,2)
102 .. D EN^RCXVDC
103 . ;
104 . S RCXVD0=0
105 . F S RCXVD0=$O(^RCXV(RCXVBTN,2,RCXVD0)) Q:'RCXVD0 D
106 .. S RCXVEDT=$P($G(^RCY(344,RCXVD0,0)),U,12)\1
107 .. D D344^RCXVDC8
108 . ;
109 . S RCXVD0=0
110 . F S RCXVD0=$O(^RCXV(RCXVBTN,3,RCXVD0)) Q:'RCXVD0 D
111 .. S DFN=RCXVD0
112 .. D D3547^RCXVDC10
113 . ;
114 . I $D(^RCXV(RCXVBTN,4)) S RCXVMO=$G(^(4)) D PREREG^RCXVDC10
115 . ;
116 . I $D(^RCXV(RCXVBTN,5)) S RCXVMO=$G(^(5)) D BUFFER^RCXVDC10
117 . ;
118 . D CLOSE^%ZISH("RCXVHNDL")
119 . ;
120 . S $P(^RC(342,1,20),U,9)=$$NOW^XLFDT()
121 . ;
122 . ; FTP directly to ARC
123 . D EN^RCXVFTP(RCXVFILE,RCXVDIR)
124 ;
125 ; Check on FTP transfer messages
126 D ^RCXVFTR
127 ;
128 L -^RCXVTSK
129EXIT D MSG^RCXVCHK
130 K IEN,DIK,DA,RCXVBLN,RCXVBTN,RCSTAT,RCXVBDT,RCXVDMN,RCXVXDT,RCXVTRD
131 K RCXVSITE,RCXVFILE,RCXVRN,RCXVRT,RCXVDIR,RCXVATP,RCXVU,DTACT,RBSQ,RBTOT
132 K RCFDATE,RCXVCFLG,RCXVDBN,RCXVIDT,RCXVSEQ,RCXVSTOT,RCXVTRD,CCT,DTENT
133 K RCBLN,RCDBTR,RCDEBT,RCTRAN,RCXVTR,RCBCN,RCXVPFDT,RCXVPTDT,RCXRMB
134 K RCXVLDOM,RCXVARD,RCXVSUB,RCXVBTY,RCXVLEG,RCXVSCR,Y,X,RCXVMO
135 K ^TMP("RCXVMSG",$J),^TMP("RCXVA",$J),^TMP("RCXVIN",$J)
136 Q
137 ;
138HIS ; Historical data extract
139 ;
140 L +^RCXVTSK:60 E HANG 600 G HIS
141 ;
142 I $G(DT)="" D DT^DICRW
143 ;
144 I $G(RCXVFFD)="" D
145 . S RCFDATE=$$FYCY^IBCU8(DT)
146 . S RCXVFFD=$P(RCFDATE,U,3),RCXVFTD=$P(RCFDATE,U,4)
147 ;
148 S RCXVDAT=RCXVFFD-.01
149 F S RCXVDAT=$O(^PRCA(430,"ACTDT",RCXVDAT)) Q:RCXVDAT=""!(RCXVDAT>RCXVFTD) D
150 . S IEN=""
151 . F S IEN=$O(^PRCA(430,"ACTDT",RCXVDAT,IEN)) Q:IEN="" D
152 .. I $P(^PRCA(430,IEN,0),U,8)=16!($P(^PRCA(430,IEN,0),U,8)=40) Q
153 .. S RCXVBLN=IEN,DFN=$P(^PRCA(430,IEN,0),U,7)
154 .. D FIL^RCXVDEQ("H")
155 ;
156 L -^RCXVTSK
157 ;
158 D EN
159 K RCXVDAT,RCFDATE,RCXVFFD,RCXVFTD,IEN,DFN,RCXVBLN
160 ;
161 Q
162 ;
163CUR ; Find all current fiscal year bills
164 ;
165 L +^RCXVTSK:60 E HANG 600 G CUR
166 ;
167 S TTYP=""
168 F S TTYP=$O(^PRCA(433,"AT",TTYP)) Q:TTYP="" D
169 . I '+$P(^PRCA(430.3,TTYP,0),U,6) Q
170 . S RDATE=RCXVFFD-.01
171 . F S RDATE=$O(^PRCA(433,"AT",TTYP,RDATE)) Q:RDATE=""!(RDATE\1>RCXVFTD) D
172 .. S IEN=""
173 .. F S IEN=$O(^PRCA(433,"AT",TTYP,RDATE,IEN)) Q:IEN="" D
174 ... S RCXVBLN=$P(^PRCA(433,IEN,0),U,2)
175 ... I RCXVBLN="" Q
176 ... S X=$P($G(^PRCA(430,RCXVBLN,0)),U,8)
177 ... I X=16!(X=40) Q
178 ... ; Line below changed for patch 228 to do FY05 extract
179 ... D FIL^RCXVDEQ("E")
180 ;
181 L -^RCXVTSK
182 ;
183 D EN
184 K TTYP,RDATE,RCXVFFD,RCXVFTD,RCXVBLN
185 Q
186 ;
187ACT ; Active data extract
188 ;
189 L +^RCXVTSK:60 E HANG 600 G ACT
190 ;
191 NEW STAT,CSTAT,QFL
192 ; Set up the AR Data Queue for all 'Active' and 'Suspended' bills
193 F STAT=16,40 S IEN="" F S IEN=$O(^PRCA(430,"AC",STAT,IEN)) Q:IEN="" D
194 . S RCXVBLN=IEN,DFN=$P(^PRCA(430,IEN,0),U,7)
195 . I $P(^PRCA(430,IEN,0),U,2)="" Q
196 . S CSTAT=$P(^PRCA(430,IEN,0),U,8)
197 . I CSTAT'=STAT S QFL=0 D Q:QFL
198 .. I CSTAT'=16!(CSTAT'=40) S QFL=1
199 . D FIL^RCXVDEQ("A")
200 ;
201 L -^RCXVTSK
202 ;
203 D EN
204 Q
205 ;
206ER ; Unlock and log error
207 L -^RCXVTSK
208 D ^%ZTER
209 D UNWIND^%ZTER
210 Q
Note: See TracBrowser for help on using the repository browser.