source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQXRF2.m@ 1804

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1VAQXRF2 ;ALB/JRP - X-REF CODES FOR PDX;01-DEC-92
2 ;;1.5;PATIENT DATA EXCHANGE;**30**;NOV 17, 1993
3AD(IFN1,IFN,SET,FNUM,OLDX) ;AD* X-REF FOR OUTGOING GROUP FILE (#394.83)
4 ;INPUT : IFN1 - Internal file number of master record
5 ; IFN - Internal file number of record
6 ; SET - If 1, set cross reference
7 ; If 0, kill cross reference (DEFAULT)
8 ; FNUM - Only valid for KILLS
9 ; The field number that was changed
10 ; OLDX - Only valid for KILLS
11 ; The previous value
12 ;OUTPUT : 0 - Cross reference was set/killed
13 ; -1 - Cross reference not set/killed
14 ; -2 - Bad input
15 ;
16 ;CHECK INPUT & RECORD EXISTANCE
17 Q:($G(IFN1)="") -2
18 Q:($G(IFN)="") -2
19 S SET=+$G(SET)
20 Q:('$D(^VAT(394.83,IFN1,"FAC",IFN))) -2
21 Q:(('SET)&('$D(FNUM))&('$D(OLDX))) -2
22 ;DECLARE VARIABLES
23 N FACILITY,DOMAIN,ZERO
24 ;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
25 S ZERO=$G(^VAT(394.83,IFN1,"FAC",IFN,0))
26 Q:(ZERO="") -1
27 S FACILITY=$P(ZERO,"^",1)
28 I ('SET) S:(FNUM=.01) FACILITY=OLDX
29 Q:(FACILITY="") -1
30 S DOMAIN=$P(ZERO,"^",2)
31 I ('SET) S:(FNUM=.02) DOMAIN=OLDX
32 Q:(DOMAIN="") -1
33 ;SET X-REF
34 S:(SET) ^VAT(394.83,IFN1,"FAC","A-OUTGRP",FACILITY,DOMAIN,IFN)=""
35 ;KILL X-REF
36 K:('SET) ^VAT(394.83,IFN1,"FAC","A-OUTGRP",FACILITY,DOMAIN,IFN)
37 Q 0
38OKDOM1(X) ; Screen for "Remote Facility" field #.01 in "Remote Facility"
39 ; multiple 394.831 (field #10) in file 394.83
40 N VIEN
41 S VIEN=+$G(^DIC(4,X,6))
42 Q:$P($G(^DIC(4.2,VIEN,0)),U,2)'["C" 1
43 ;D EN^DDIOL("Domain for this Facility is closed.")
44 Q 0
45OKDOM2(X) ; Screen for "Remote Domain" field #.02 in "Remote Facility"
46 ; multiple 394.831 (field #10) in file 394.83
47 Q:$P($G(^(0)),U,2)'["C" 1
48 ;D EN^DDIOL("Domain is closed.")
49 Q 0
50 ;
51AE(IFN,SET,FNUM,OLDX) ;AE* X-REF FOR SEGMENT GROUP FILE (#394.84)
52 ;INPUT : IFN - Internal file number of record
53 ; SET - If 1, set cross reference
54 ; If 0, kill cross reference (DEFAULT)
55 ; FNUM - Only valid for KILLS
56 ; The field number that was changed
57 ; OLDX - Only valid for KILLS
58 ; The previous value
59 ;OUTPUT : 0 - Cross reference was set/killed
60 ; -1 - Cross reference not set/killed
61 ; -2 - Bad input
62 ;
63 ;CHECK INPUT & RECORD EXISTANCE
64 Q:($G(IFN)="") -2
65 S SET=+$G(SET)
66 Q:('$D(^VAT(394.84,IFN))) -2
67 Q:(('SET)&('$D(FNUM))&('$D(OLDX))) -2
68 ;DECLARE VARIABLES
69 N TYPE,PERSON,ZERO
70 ;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
71 S ZERO=$G(^VAT(394.84,IFN,0))
72 Q:(ZERO="") -1
73 S TYPE=$P(ZERO,"^",2)
74 I ('SET) S:(FNUM=.02) TYPE=OLDX
75 Q:(TYPE="") -1
76 S PERSON=$P(ZERO,"^",3)
77 I ('SET) S:(FNUM=.03) PERSON=OLDX
78 Q:(PERSON="") -1
79 ;SET X-REF
80 S:(SET) ^VAT(394.84,"A-SEGGRP",TYPE,PERSON,IFN)=""
81 ;KILL X-REF
82 K:('SET) ^VAT(394.84,"A-SEGGRP",TYPE,PERSON,IFN)
83 Q 0
84 ;
85BS5(IFN,SET,FNUM,OLDX) ;BS5* X-REF FOR TRANSACTION FILE (#394.61)
86 ;INPUT : IFN - Internal file number of record
87 ; SET - If 1, set cross reference
88 ; If 0, kill cross reference (DEFAULT)
89 ; FNUM - Only valid for KILLS
90 ; The field number that was changed
91 ; OLDX - Only valid for KILLS
92 ; The previous value
93 ;OUTPUT : 0 - Cross reference was set/killed
94 ; -1 - Cross reference not set/killed
95 ; -2 - Bad input
96 ;
97 ;CHECK INPUT & RECORD EXISTANCE
98 Q:($G(IFN)="") -2
99 S SET=+$G(SET)
100 Q:('$D(^VAT(394.61,IFN))) -2
101 Q:(('SET)&('$D(FNUM))&('$D(OLDX))) -2
102 ;DECLARE VARIABLES
103 N NAME,SSN,QRY
104 ;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
105 S QRY=$G(^VAT(394.61,IFN,"QRY"))
106 Q:(QRY="") -1
107 S NAME=$P(QRY,"^",1)
108 I ('SET) S:(FNUM=10) NAME=OLDX
109 Q:(NAME="") -1
110 S SSN=$P(QRY,"^",2)
111 I ('SET) S:(FNUM=11) SSN=OLDX
112 Q:(SSN="") -1
113 ;SET X-REF
114 S:(SET) ^VAT(394.61,"BS5",($E(NAME,1)_$E(SSN,6,10)),IFN)=""
115 ;KILL X-REF
116 K:('SET) ^VAT(394.61,"BS5",($E(NAME,1)_$E(SSN,6,10)),IFN)
117 Q 0
118AUTO(VNODE) ;Auto-Numbering Logic
119 ;INPUT : VNODE - Shows which field is being incremented
120 ; 1 - Field .01 of file 394.61
121 ; 2 - Field .01 of file 394.62
122 ; 3 - Field .01 of file 394.73
123 ;OUTPUT : N - Next available number
124 ; -1 - Could not find auto-number record
125 ; -2 - Bad input
126 N VFILE,VIEN,VNEXT
127 S VIEN=+$O(^VAT(394.86,"B",1,0)) ;Check for record existence
128 Q:'VIEN -1
129 S VFILE=$S($G(VNODE)=1:394.61,$G(VNODE)=2:394.62,$G(VNODE)=3:394.73,1:0)
130 Q:'VFILE -2
131 L +^VAT(394.86,VIEN,VNODE) ;Lock node to prevent simultaneous use
132 ;Get next value for .01 of 394.61 or 394.62 or 394.73
133 F VNEXT=$G(^VAT(394.86,VIEN,VNODE))+1:1 S:(VNEXT>9999999999) VNEXT=100 Q:'$D(^VAT(VFILE,"B",VNEXT))
134 S ^VAT(394.86,VIEN,VNODE)=VNEXT ;Store new value
135 L -^VAT(394.86,VIEN,VNODE) ;Unlock node
136 ; Note that we enclose the number in quotes so that ^DIC does not
137 ; perform a lookup. Rather, it simply adds the new record to the file.
138 Q """"_VNEXT_"""" ;Return next available number
Note: See TracBrowser for help on using the repository browser.