source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJVDEQ.m@ 648

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1IBJVDEQ ;DAOU/ALA - CBO Data Extract Queue Trigger ;02-JUL-03
2 ;;2.0;INTEGRATED BILLING;**233,301**;21-MAR-94
3 ;
4 ;**Program Description**
5 ; This program will log a record who meets the
6 ; selection criteria for the VISTA Data Extract
7 ;
8BC ; Triggers from the Bill/Claims File (#399)
9 ; Called from the STATUS DATE field (#.14)
10 ; Variable D0 is the internal bill# passed in by FileMan
11 ;
12 NEW DFN
13 ;
14 ; Filter (Auth DT must exist)
15 S RDATES=$G(^DGCR(399,D0,"S"))
16 I $P(RDATES,U,10)="" Q
17 ;
18 ; Get the bill number
19 S RCBILL=$P($G(^DGCR(399,D0,0)),U,1)
20 ; Use PRCA(430,"D",bill number to get 430 IEN
21 S RCXVBLN=$O(^PRCA(430,"D",RCBILL,""))
22 I RCXVBLN="" Q
23 ;
24 S DFN=$P(^DGCR(399,D0,0),U,2)
25 ; Retrieve all for every new bill authorized in IB
26 D FIL("D")
27 ;
28 K RCBILL,RCXVBLN,RDATES
29 Q
30 ;
31FIL(RCXVBTY) ; File the record into the AR Data Queue File (#348.4)
32 ;
33 ; If a test system has 'turned off' extract, quit
34 I '$$GET1^DIQ(342,"1,",20.04,"I") Q
35 ;
36 ; Input Parameter
37 ; RCXVBTY = Batch Type (H=Historical, D=Daily, C=Current Fiscal Year, A=Active)
38 ; RCXVBLN = Bill IEN
39 ;
40 NEW FDA,RCXVCURB,RCVXBNM,RCVXBMX
41 ;
42 ; Where there has been any update/change to the system
43 ; for a particular bill for the previous days business (T-1).
44 ;
45 ; Get current batch
46BTC K ^TMP("RCXVA",$J)
47 D FIND^DIC(348.4,"","","P",DT,"","C","I $P(^(0),U,4)=RCXVBTY","","^TMP(""RCXVA"",$J)")
48 S RCXVCURB=$P(^TMP("RCXVA",$J,"DILIST",0),U,1)
49 S RCVXCTY="",RCXVBDT="",RCXQFL=0
50 ;
51 ; If there is no batch for today, create a new batch
52 I RCXVCURB=0 D NBT G CON:'RCXQFL,BTC
53 ;
54 ; Check to see if batch is full.
55 S RCXVCURB=$P(^TMP("RCXVA",$J,"DILIST",RCXVCURB,0),U,1)
56 I RCXVCURB'=0 D
57 . S RCVXBNM=$P($G(^RCXV(RCXVCURB,0)),U,7) ; Number of record in batch
58 . S RCVXCTY=$P($G(^RCXV(RCXVCURB,0)),U,4) ; Current batch type
59 . S RCXVBDT=$P($G(^RCXV(RCXVCURB,0)),U,2) ; Batch Date
60 . S RCXVBST=$P($G(^RCXV(RCXVCURB,0)),U,3) ; Batch Status
61 S RCVXBMX=$P($G(^RC(342,1,20)),U,5) ; Max. # of record per batch
62 ; OR if the number of records in batch exceeds the
63 ; maximum number of records per batch --> create new batch
64 I (RCVXBNM>RCVXBMX)!(RCVXBNM=RCVXBMX)!(RCXVBST="T") D NBT G BTC:RCXQFL
65 ;
66CON ; Continue with updating the AR Data Queue file
67 S RCXVDA=$S($G(RCXVCURB)'=0:RCXVCURB,1:RCXVDA)
68 ;
69 I $D(^RCXV(RCXVDA,1,RCXVBLN)) Q
70 ;
71 ; File record
72 NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM,DO
73 S DA(1)=RCXVDA,DIC="^RCXV("_DA(1)_",1,",DIE=DIC,(X,DINUM)=RCXVBLN
74 S DLAYGO=348.41,DIC(0)="L",DIC("P")=DLAYGO
75 I '$D(^RCXV(DA(1),1,0)) S ^RCXV(DA(1),1,0)="^348.41^^"
76 D FILE^DICN
77 ;
78 S RCUPD(348.4,RCXVDA_",",.07)=(RCVXBNM+1)
79 S RCUPD(348.41,RCXVBLN_","_RCXVDA_",",.02)=DFN
80 D FILE^DIE("","RCUPD","RCERROR")
81 ;
82 K RCXVDA,RCVXBNM,RCXVBLN,RCXVCURB,RCXVBTY,RCVXBMX,RCVXCTY,RCXVBDT
83 K ^TMP("RCXVA",$J),IENARRAY,RCXVBST,DINUM,ERROR,RCUPD,RCXQFL
84 Q
85 ;
86NBT ; Create a new batch
87 N $ES,$ET
88 S $ET="D ER^IBJVDEQ"
89 L +^RCXVLK:1 E S RCXQFL=1 Q
90 S RCXVCURB=$P(^RCXV(0),U,3)+1
91 S RCVXBNM=0
92 S FDA(348.4,"+1,",.01)=RCXVCURB
93 S FDA(348.4,"+1,",.02)=DT
94 S FDA(348.4,"+1,",.03)="P"
95 S FDA(348.4,"+1,",.04)=RCXVBTY
96 S FDA(348.4,"+1,",.07)=RCVXBNM
97 D UPDATE^DIE("","FDA","IENARRAY","ERROR")
98 I '$D(ERROR) S RCXVDA=$G(IENARRAY(1))
99 L -^RCXVLK
100 Q
101 ;
102ER ; Unlock and log error
103 L -^RCXVLK
104 D ^%ZTER
105 D UNWIND^%ZTER
106 Q
Note: See TracBrowser for help on using the repository browser.