source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCMSG3.m@ 1651

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1VAFCMSG3 ;ALB/JRP,PKE-Message Builder Utilities ; 4/26/03 12:05pm
2 ;;5.3;Registration;**91,209,149,261,307,494,484,477**;Aug 13, 1993
3 ;
4 ;-- Line tags for building HL7 segments
5 ;
6 ; Standardized variable names:
7 ; All HL7 variables created by calling INIT^HLFNC2() must exist
8 ; DFN - Pointer to entry in PATIENT file (#2)
9 ; EVNTHL7 - HL7 ADT event being transmitted
10 ; EVNTDATE - Date/time event occurred (FileMan format)
11 ; EVNTINFO() - Array containing extra info needed to build segments
12 ; (full global reference)
13 ; VAFSTR - String of fields to put into segment separated by commas
14 ;
15BLDEVN S VAFEVN=$$EN^VAFHLEVN(EVNTHL7,EVNTDATE,VAFSTR,HL("Q"),HL("FS"))
16 ;Manually add event type code (seq #1)
17 S $P(VAFEVN,HL("FS"),2)=EVNTHL7
18 ;Manually add event reason code (seq #4)
19 S $P(VAFEVN,HL("FS"),5)=$G(@EVNTINFO@("REASON",1))
20 ;If applicable, manually add operator (seq #5)
21 S:($D(@EVNTINFO@("USER"))) $P(VAFEVN,HL("FS"),6)=@EVNTINFO@("USER")
22 Q
23BLDPID ;
24 S VAFPID=$$EN^VAFCPID(DFN,VAFSTR)
25 ;CHECK IF PATIENT HAS AN ICN IF NOT A28
26 I $P(VAFPID,HL("FS"),3)=HLQ&(EVNTHL7'="A28") D
27 . I $T(GETICN^MPIF001)']"" Q
28 . ; returns National ICN -- don't create local ICN
29 . N ICN S ICN=$$GETICN^MPIF001(DFN)
30 . I +ICN>0 S $P(VAFPID,HL("FS"),3)=ICN
31 Q
32 ;
33BLDPD1 ;
34 I EVNTHL7="A28" D
35 . N CHANGE,CMOR
36 . N X S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
37 . I +$$GETVCCI^MPIF001(DFN)'>0 D
38 . . ;S CMOR=$P($$SITE^VASITE(),"^")
39 . . ;S CHANGE=$$CHANGE^MPIF001(DFN,CMOR)
40 . . ;I +CHANGE<0 D START^RGHLLOG(),EXC^RGHLLOG(211,"Trouble updating CMOR while building A28 msg in VAFCMSG3 for DFN = "_DFN),STOP^RGHLLOG()
41 S VAFPD1=$$EN^VAFHLPD1(DFN)
42 ;
43BLDPV1 I EVNTHL7="A28" S VAFPV1="PV1"_HL("FS")_1
44 E S VAFPV1=$$EN^VAFCPV1(DFN) Q
45 ;
46BLDROL ;
47 I $G(@EVNTINFO@("SERVER PROTOCOL"))'="VAFC ADT-A08-SDAM SERVER"
48 IF I $G(^DPT(DFN,.1))]"" DO
49 . D BLDROL^VAFCROL("VAFROL",DFN,EVNTDATE,VAFSTR,$G(@EVNTINFO@("PIVOT")))
50 Q
51 ;
52BLDOBX ;
53 N VAFARRY S SECINFO=$$EN^VAFHLZSN(DFN) I $P(SECINFO,"^",2)'="",$P(SECINFO,"^",2)'?.2"""" D ;**477
54 . S VAFARRY(2)="CE"
55 . S $P(VAFARRY(3),$E(HL("ECH"),1),2)="SECURITY LEVEL"
56 . S VAFARRY(5)=$P(SECINFO,"^",2)
57 . S VAFARRY(11)="F"
58 . S VAFARRY(14)=$$FMDATE^HLFNC($P(SECINFO,"^",4))
59 . S VAFARRY(16)=$P(SECINFO,"^",3)
60 ;
61 S VAFOBX=$$EN^VAFHLOBX(.VAFARRY) K SECINFO
62 Q
63 ;
64BLDZPD S VAFZPD=$$EN^VAFHLZPD(DFN,VAFSTR) Q
65 ;
66BLDZSP S VAFZSP=$$EN^VAFHLZSP(DFN) Q
67 ;
68BLDZEL S VAFZEL=$$EN^VAFHLZEL(DFN,VAFSTR,1) Q
69 ;
70BLDZCT S VAFZCT=$$EN^VAFHLZCT(DFN,VAFSTR) Q
71 ;
72BLDZEM S VAFZEM=$$EN^VAFHLZEM(DFN,VAFSTR) Q
73 ;
74BLDZFF S VAFZFF="ZFF"_HL("FS")_2_HL("FS")
75 S VAFZFF=VAFZFF_$P($G(^VAT(391.71,+$G(@EVNTINFO@("PIVOT")),2)),U)
76 Q
77 ;
78BLDZIR K DGREL,DGINC,DGINR,DGDEP
79 D ALL^DGMTU21(DFN,"V",EVNTDATE,"R")
80 S VAFZIR=$$EN^VAFHLZIR(+$G(DGINR("V")),VAFSTR,1)
81 K DGREL,DGINC,DGINR,DGDEP
82 Q
83 ;
84BLDZEN S VAFZEN=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS")) Q
85 ;
86 ;
87 ;-- Line tags for copying HL7 segments into HL7 message
88 ;
89 ; Standardized variable names:
90 ; Variables set by BLDxxx tags
91 ; XMITARRY - Array to build HL7 message into (full global reference)
92 ; LASTLINE - Last line number used in HL7 message
93 ; - This value will be incremented appropriately
94 ; LINESADD - Total number of lines added to HL7 message
95 ; - This value will be incremented appropriately
96 ;
97CPYEVN N I
98 S LASTLINE=1+$G(LASTLINE)
99 S @XMITARRY@(LASTLINE)=VAFEVN
100 S LINESADD=1+$G(LINESADD)
101 S I=""
102 F S I=+$O(VAFEVN(I)) Q:('I) D
103 .S @XMITARRY@(LASTLINE,I)=VAFEVN(I)
104 .S LINESADD=LINESADD+1
105 Q
106 ; rev $o is # lines from array
107CPYPID S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPID(""),-1)
108 MERGE @XMITARRY@(LASTLINE)=VAFPID Q
109 ;
110CPYPD1 S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPD1(""),-1)
111 MERGE @XMITARRY@(LASTLINE)=VAFPD1 Q
112 ;
113CPYPV1 S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPV1(""),-1)
114 MERGE @XMITARRY@(LASTLINE)=VAFPV1 Q
115 ;
116CPYROL N I,J,K
117 S I=""
118 F K=1:1 S I=+$O(VAFROL(I)) Q:('I) D
119 . S J=""
120 . F S J=$O(VAFROL(I,J)) Q:(J="") D
121 . . S:('J) @XMITARRY@(LASTLINE+K)=VAFROL(I,J)
122 . . S:(J) @XMITARRY@(LASTLINE+K,J)=VAFROL(I,J)
123 . . S LINESADD=1+$G(LINESADD)
124 S LASTLINE=LASTLINE+K-1
125 Q
126 ;
127CPYOBX S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFOBX(""),-1)
128 MERGE @XMITARRY@(LASTLINE)=VAFOBX Q
129 ;
130CPYZPD S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZPD(""),-1)
131 MERGE @XMITARRY@(LASTLINE)=VAFZPD Q
132 ;
133CPYZSP S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZSP(""),-1)
134 MERGE @XMITARRY@(LASTLINE)=VAFZSP Q
135 ;
136CPYZEL S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZEL(""),-1)
137 MERGE @XMITARRY@(LASTLINE)=VAFZEL Q
138 ;
139CPYZCT S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZCT(""),-1)
140 MERGE @XMITARRY@(LASTLINE)=VAFZCT Q
141 ;
142CPYZEM S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZEM(""),-1)
143 MERGE @XMITARRY@(LASTLINE)=VAFZEM Q
144 ;
145CPYZFF S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZFF(""),-1)
146 MERGE @XMITARRY@(LASTLINE)=VAFZFF Q
147 ;
148CPYZIR S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZIR(""),-1)
149 MERGE @XMITARRY@(LASTLINE)=VAFZIR Q
150 ;
151CPYZEN S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZEN(""),-1)
152 MERGE @XMITARRY@(LASTLINE)=VAFZEN Q
153 ;
154 ;
155 ;-- Line tags for deleting variables used to build HL7 segments
156 ;
157DELEVN K VAFEVN Q
158 ;
159DELPID K VAFPID Q
160 ;
161DELPD1 K VAFPD1 Q
162 ;
163DELPV1 K VAFPV1 Q
164 ;
165DELROL K VAFROL Q
166 ;
167DELOBX K VAFOBX Q
168 ;
169DELZPD K VAFZPD Q
170 ;
171DELZSP K VAFZSP Q
172 ;
173DELZEL K VAFZEL Q
174 ;
175DELZCT K VAFZCT Q
176 ;
177DELZEM K VAFZEM Q
178 ;
179DELZFF K VAFZFF Q
180 ;
181DELZIR K VAFZIR Q
182 ;
183DELZEN K VAFZEN Q
184 ;
Note: See TracBrowser for help on using the repository browser.