source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDEQ.m@ 619

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

initial load of WorldVistAEHR
File size: 3.9 KB
Line 
1RCXVDEQ ;DAOU/ALA-AR Data Extract Queue Trigger ;02-JUL-03
2 ;;4.5;Accounts Receivable;**201,228,240,243,232**;Mar 20, 1995
3 ;*****240 change in this routine for test sites only****
4 ;
5 ;**Program Description**
6 ; This program will log a record who meets the
7 ; selection criteria for the VISTA Data Extract
8 ;
9AR ; Triggers from the Accounts Receivable File (#430)
10 NEW DFN
11 ;
12 S RCXVBLN=D0,RCXVSTAT=$P(^PRCA(430,D0,0),U,8)
13 I '+$P(^PRCA(430.3,RCXVSTAT,0),U,6) Q
14 ;
15 S DFN=$P(^PRCA(430,D0,0),U,7)
16 D FIL("D")
17 ;
18 K RCXVBLN,RCXVSTAT
19 Q
20 ;
21AT ; Triggers from the Accounts Receivable Transactions (#433)
22 NEW DFN
23 ;
24 S RCXVBLN=$P($G(^PRCA(433,D0,0)),U,2)
25 I RCXVBLN="" Q
26 S RCXVTYP=$P($G(^PRCA(433,D0,1)),U,2)
27 I RCXVTYP="" Q
28 ;
29 I '+$P(^PRCA(430.3,RCXVTYP,0),U,6) Q
30 ;
31 S DFN=$P(^PRCA(430,RCXVBLN,0),U,7)
32 D FIL("D")
33 ;
34 K RCXVBLN,RCXVTYP
35 Q
36 ;
37FIL(RCXVBTY) ; File the record into the AR Data Queue File (#348.4)
38 ;
39 ; If a test system has 'turned off' extract, quit
40 I '$$GET1^DIQ(342,"1,",20.04,"I") Q
41 ;
42 ; Input Parameter
43 ; RCXVBTY = Batch Type (H=Historical, D=Daily, C=Current Fiscal Year, A=Active,E=FY05 DATA,I=CoPay Patient Data)
44 ; RCXVBLN = Bill IEN
45 ;
46 N FDA,RCXVCURB,RCVXBNM,RCVXBMX
47 ;
48 ; Where there has been any update/change to the system
49 ; for a particular bill for the previous days business business (T-1).
50 ;
51 ; Get current batch
52BTC K ^TMP("RCXVA",$J)
53 D FIND^DIC(348.4,"","","P",DT,"","C","I $P(^(0),U,4)=RCXVBTY","","^TMP(""RCXVA"",$J)")
54 S RCXVCURB=+$P($G(^TMP("RCXVA",$J,"DILIST",0)),U,1)
55 S RCVXCTY="",RCXVBDT="",RCXQFL=0
56 ;
57 ; If there is no batch for today, create a new batch
58 I RCXVCURB=0 D NBT G CON:'RCXQFL,BTC
59 ;
60 ; Check to see if batch is full.
61 S RCXVCURB=$P(^TMP("RCXVA",$J,"DILIST",RCXVCURB,0),U,1)
62 I RCXVCURB'=0 D
63 . S RCVXBNM=$P($G(^RCXV(RCXVCURB,0)),U,7) ; Number of record in batch
64 . S RCVXCTY=$P($G(^RCXV(RCXVCURB,0)),U,4) ; Current batch type
65 . S RCXVBDT=$P($G(^RCXV(RCXVCURB,0)),U,2) ; Batch Date
66 . S RCXVBST=$P($G(^RCXV(RCXVCURB,0)),U,3) ; Batch Status
67 S RCVXBMX=$P($G(^RC(342,1,20)),U,5) ; Max. # of record per batch
68 ; OR if the number of records in batch exceeds the
69 ; maximum number of records per batch --> create new batch
70 ; change in line below for patch 240
71 I (RCVXBNM>RCVXBMX)!(RCVXBNM=RCVXBMX)!(RCXVBST="T")!(RCXVBST="C") D NBT G BTC:RCXQFL=1
72 ;
73CON ; Continue with updating the AR Data Queue file
74 S RCXVDA=$S($G(RCXVCURB)'=0:RCXVCURB,1:RCXVDA)
75 ;
76 ; If the Batch Type is 'R', quit
77 I RCXVBTY="R"!(RCXVBTY="I") Q
78 ;
79 ; If this bill number already exists in this batch, quit
80 I $D(^RCXV(RCXVDA,1,RCXVBLN)) Q
81 ;
82 ; File record
83 NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM
84 S DA(1)=RCXVDA,DIC="^RCXV("_DA(1)_",1,",DIE=DIC,(X,DINUM)=RCXVBLN
85 S DLAYGO=348.41,DIC(0)="L",DIC("P")=DLAYGO
86 I '$D(^RCXV(DA(1),1,0)) S ^RCXV(DA(1),1,0)="^348.41^^"
87 K DO D FILE^DICN K DO
88 ;
89 S RCUPD(348.4,RCXVDA_",",.07)=(RCVXBNM+1)
90 S RCUPD(348.41,RCXVBLN_","_RCXVDA_",",.02)=$G(DFN)
91 D FILE^DIE("","RCUPD","RCXVERR")
92 ;
93 K RCXVDA,RCVXBNM,RCXVBLN,RCXVCURB,RCXVBTY,RCVXBMX,RCVXCTY,RCXVBDT
94 K ^TMP("RCXVA",$J),IENARRAY,RCXVBST,RCUPD,RCXVERR,RCXQFL
95 Q
96 ;
97NBT ; Create a new batch
98 N $ES,$ET
99 S $ET="D ER^RCXVDEQ"
100 L +^RCXVLK:1 E S RCXQFL=1 Q
101 S RCXVCURB=$P(^RCXV(0),U,3)+1
102 S RCVXBNM=0
103 S FDA(348.4,"+1,",.01)=RCXVCURB
104 S FDA(348.4,"+1,",.02)=DT
105 S FDA(348.4,"+1,",.03)="P"
106 S FDA(348.4,"+1,",.04)=RCXVBTY
107 S FDA(348.4,"+1,",.07)=RCVXBNM
108 D UPDATE^DIE("","FDA","IENARRAY","ERROR")
109 I '$D(ERROR) S RCXVDA=$G(IENARRAY(1))
110 L -^RCXVLK
111 Q
112 ;
113UDR ; Update Deposits/Receipts subfile
114 ; If this batch payment number already exists in this batch, quit
115 I $D(^RCXV(RCXVDA,2,RCXVD0)) Q
116 ;
117 ; File record
118 NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM
119 S DA(1)=RCXVDA,DIC="^RCXV("_DA(1)_",2,",DIE=DIC,(X,DINUM)=RCXVD0
120 S DLAYGO=348.42,DIC(0)="L",DIC("P")=DLAYGO
121 I '$D(^RCXV(DA(1),2,0)) S ^RCXV(DA(1),2,0)="^348.42^^"
122 K DO D FILE^DICN K DO
123 ;
124 S RCUPD(348.4,RCXVDA_",",.07)=RCXVRNUM
125 D FILE^DIE("","RCUPD","RCXVERR")
126 K RCXVERR,RCUPD
127 Q
128 ;
129ER ; Unlock and log error
130 L -^RCXVLK
131 D ^%ZTER
132 D UNWIND^%ZTER
133 Q
Note: See TracBrowser for help on using the repository browser.