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

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

initial load of WorldVistAEHR

File size: 4.6 KB
RevLine 
[613]1IBCNEDE7 ;DAOU/DAC - IIV DATA EXTRACTS ;04-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**271**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q ; no direct calls allowed
6 ;
7SETTINGS(EXTNUM) ; Check site parameter settings for the extracts
8 ; Input Parameter:
9 ;
10 ; EXTNUM is either 1, 2, 3, 4 to represent the different extracts
11 ; 1 - Insurance Buffer extract
12 ; 2 - Pre-Reg (appointments)
13 ; 3 - Non Verified
14 ; 4 - No Ins. / No Active
15 ;
16 ; Output:
17 ; Returns a "^" delimited string passing back:
18 ; A flag of whether to consider the extract active
19 ; Number of days to look back in the past when extracting data
20 ; STALEDYS - "stale days": number of days from today to determine the
21 ; freshness this is only used for the non-verified and no
22 ; insurance extract. The other two extracts pull their days
23 ; from the IB SITE PARAMETER file within their specific
24 ; extract routine.
25 ; Max Number of entries you are allowed to set into the IIV
26 ; Transmission Queue file. If null, # of entries allowed is
27 ; unlimited.
28 ; Suppress Buffer Flag - Either '0' (No) or '1' (Yes)
29 ; 1 will suppress the creation of buffer entries
30 ; 0 will not
31 ; Applies to extracts 2 (Pre Reg) and 3 (Non verified)
32 ;
33 N DIC,DISYS,DA,X,Y,EACTIVE,XDAYS,STALEDYS,MAXCNT,OK,SUPPBUFF
34 S EACTIVE=0,(XDAYS,STALEDYS,MAXCNT)=""
35 S OK=$S(EXTNUM=1:1,EXTNUM=2:1,EXTNUM=3:1,EXTNUM=4:1,1:0)
36 I 'OK G EXIT
37 S DA=1,DIC="^IBE(350.9,"_DA_",51.17,",DIC(0)="X",X=EXTNUM D ^DIC
38 ;
39 I Y<1 G EXIT ; extract not defined in the IB Site Parameter
40 ;
41 S EACTIVE=$G(^IBE(350.9,1,51.17,+Y,0))
42 S XDAYS=$P(EACTIVE,U,3)
43 S STALEDYS=$P(EACTIVE,U,4)
44 S MAXCNT=$P(EACTIVE,U,5)
45 S SUPPBUFF=$P(EACTIVE,U,6)
46 I SUPPBUFF="" S SUPPBUFF=0
47 S EACTIVE=$P(EACTIVE,U,2)
48EXIT ;
49 I EXTNUM=2,(XDAYS="") S EACTIVE=0 ; missing required data
50 I EXTNUM=3!(EXTNUM=4) D
51 . I XDAYS=""!(STALEDYS="") S EACTIVE=0 ; missing required data
52 Q EACTIVE_U_XDAYS_U_STALEDYS_U_MAXCNT_U_SUPPBUFF
53 ;
54SETTQ(DATA1,DATA2,ORIG,OVERRIDE) ;Set extract data in TQ file 365.1
55 ;
56 ; DATA1, DATA2, & ORIG are "^" delimited variables containing the data
57 ; listed below
58 ;
59 ; OVERRIDE - flag indicates that this entry is a result of the
60 ; 'Request Re-Verification' menu option.
61 ;
62 N FDA,IENARRAY,ERROR,TRANSNO,DFN
63 ;
64 S TRANSNO=$P($G(^IBCN(365.1,0)),U,3)+1
65 S FDA(365.1,"+1,",.01)=TRANSNO ; Transaction #
66 ;
67 S DFN=$P(DATA1,U)
68 S FDA(365.1,"+1,",.02)=DFN ; patient DFN
69 S FDA(365.1,"+1,",.03)=$P(DATA1,U,2) ; ien of payer
70 S FDA(365.1,"+1,",.04)=$P(DATA1,U,3) ; ien of transmission status
71 S FDA(365.1,"+1,",.15)=DT ; trans status date
72 S FDA(365.1,"+1,",.05)=$P(DATA1,U,4) ; ien of buffer
73 ;
74 S FDA(365.1,"+1,",.06)=$$NOW^XLFDT ; creation date/time
75 S FDA(365.1,"+1,",.07)=0 ; transmission retries
76 S FDA(365.1,"+1,",.08)=0 ; number of retries
77 I $D(OVERRIDE) S FDA(365.1,"+1,",.14)=OVERRIDE ; override flag
78 S FDA(365.1,"+1,",.16)=$P(DATA1,U,5) ; Sub. ID
79 S FDA(365.1,"+1,",.17)=$P(DATA1,U,6) ; Freshness Date
80 S FDA(365.1,"+1,",.18)=$P(DATA1,U,7) ; Pass Buffer ien?
81 ;
82 I $D(DATA2) D
83 . S FDA(365.1,"+1,",.1)=$P(DATA2,U) ; which extract (ien)
84 . S FDA(365.1,"+1,",.11)=$P(DATA2,U,2) ; query flag
85 . S FDA(365.1,"+1,",.12)=$P(DATA2,U,3) ; service date
86 . S FDA(365.1,"+1,",.13)=$P(DATA2,U,4) ; patient insur. ien
87 ;
88 I $D(ORIG) D
89 . S FDA(365.1,"+1,",1.02)=$P(ORIG,U) ; original ins co (in buffer)
90 . S FDA(365.1,"+1,",1.03)=$P(ORIG,U,2) ; original grp # (in buffer)
91 . S FDA(365.1,"+1,",1.04)=$P(ORIG,U,3) ; original grp name (in buffer)
92 . S FDA(365.1,"+1,",1.05)=$P(ORIG,U,4) ; original subscriber ID
93 ;
94 D UPDATE^DIE("","FDA","IENARRAY","ERROR")
95 ;
96 I $D(ERROR) D ; MailMan msg
97 . NEW MGRP,XMSUB,MSG
98 . KILL MSG
99 . ;
100 . ; Set to IB site parameter MAILGROUP
101 . S MGRP=$$MGRP^IBCNEUT5()
102 . ;
103 . S XMSUB="IIV Problem: Trouble setting entry in File 365.1"
104 . S MSG(1)="Tried to create an entry in the IIV Transmission Queue File #365.1 without"
105 . S MSG(2)="success."
106 . S MSG(3)=""
107 . S MSG(4)="Error encountered: "_ERROR("DIERR",1,"TEXT",1)
108 . S MSG(5)=""
109 . S MSG(6)="The data that was to be stored is as follows:"
110 . S MSG(7)=""
111 . S MSG(8)="Transaction #: "_TRANSNO
112 . S MSG(9)="Patient: "_$P($G(^DPT(DFN,0)),U)_$$SSN^IBCNEDEQ(DFN)
113 . S MSG(10)="Extract: "_$G(FDA(365.1,"+1,",.1))
114 . S MSG(11)="Payer: "_$P($G(^IBE(365.12,FDA(365.1,"+1,",.03),0)),U,1)
115 . S MSG(12)="Please log a NOIS for this problem."
116 . D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
117 ;
118 Q $G(IENARRAY(1))
119 ;
Note: See TracBrowser for help on using the repository browser.