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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1VAFCADT2 ;ALB/RJS - HL7 ADT MESSAGE BUILDING ROUTINE ; 3/6/06 8:24am
2 ;;5.3;Registration;**91,179,209,415,494,484,508,692**;Aug 13, 1993
3 ;hl7v1.6
4 ;
5 ;This routine builds ADT HL7 messages: A01 = Admission
6 ; A02 = Transfer
7 ; A03 = Discharge
8 ; A08 = Treating Specialty Update
9 ; A11 = Cancel Admission
10 ; A12 = Cancel Transfer
11 ; A13 = Cancel Discharge
12 ;
13 ;It is called by VAFCADT1, which is itself is called by the
14 ;DGPM patient movement event driver.
15 ;
16 ;
17BLDMSG(DFN,EVENT,VAFHDT,EVCODE,IEN,PIVOT,PV1) ;
18 ;Required Variables are: DFN = IEN of Patient File
19 ; EVENT = HL7 Event, A01, A02, A03, etc.
20 ; VAFHDT = Date/Time of Admission, Transfer, etc
21 ;
22 ;Optional Variables are: Event Code = (EVCODE):A string literal which is
23 ; inserted in the Event Reason
24 ; Code Field of the EVN segment
25 ; of the message. This serves to
26 ; indicate that the message might
27 ; need to be processed in a special
28 ; way. PIMS ADT software uses the
29 ; Event Code to indicate whether
30 ; the message is the most recent
31 ; "Snapshot" of the data "05" or
32 ; a "Snapshot" of data that is
33 ; followed by more recent data "04"
34 ;
35 ;
36 ; IEN = The IEN of the Patient Movement
37 ; that the HL7 message is being
38 ; built from. This is especially
39 ; useful for Discharge Movements
40 ; where date/time (VAFHDT) is not
41 ; enough information to retrieve
42 ; the movement
43 ;
44 ; PIVOT = The PIMS Pivot number that
45 ; uniquely identifies the ADMISSION
46 ;
47 ; PV1 = In the case of a "Deleted
48 ; Admission" the record in the
49 ; Patient Movement File has already
50 ; been deleted. But, a PV1 segment
51 ; can be built from the DGPMP
52 ; variable that has been saved off
53 ; by the DGPM Event Driver. This
54 ; PV1 segment is passed a string
55 ; literal that is built by a call
56 ; to DGBUILD^VAFHAPV1 previous to
57 ; calling this software.
58 ;
59 K HLA N VAFDIAG,LIN,VAFSTR,DGREL,DGINC,DGINR,DGDEP,VAFZEL
60 ;Q:($G(EVCODE)'="05")
61 ;
62 K HL
63 I EVENT="A08" D INIT^HLFNC2("VAFC ADT-A08-TSP SERVER",.HL)
64 I EVENT'="A08" D INIT^HLFNC2("VAFC ADT-"_EVENT_" SERVER",.HL)
65 I $D(HL)#2 G EXIT
66 S LIN=1
67 S VAFSTR=$$COMMANUM^VAFCADT2(2,9)_",10B,11PC,"_$$COMMANUM^VAFCADT2(13,21)_",22B,"_$$COMMANUM^VAFCADT2(23,30)
68 S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFCPID(DFN,VAFSTR)
69 I +HLA("HLS",LIN)=-1 K HLA("HLS",2) G EXIT
70 ;I $G(VAFPID(1))]"" S HLA("HLS",LIN,1)=VAFPID(1)
71 ;I $G(VAFPID(2))]"" S HLA("HLS",LIN,2)=VAFPID(2)
72 MERGE HLA("HLS",LIN)=VAFPID K VAFPID
73 S $P(HLA("HLS",LIN),HLFS,2)=1 ;SET ID
74 S VAFSTR=$$COMMANUM(1,12)
75 S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLPD1(DFN,VAFSTR)
76 S VAFSTR=$$COMMANUM(1,21)
77 S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZPD(DFN,VAFSTR)
78 S $P(HLA("HLS",LIN),HLFS,2)=1 ;SET ID
79 I EVENT="A11" D G NEXT
80 . S HLA("HLS",$$ADD(.LIN,1))=PV1
81 . S $P(HLA("HLS",LIN),HLFS,51)=$G(PIVOT) ; VISIT&SET ID'S
82 I EVENT="A01"!(EVENT="A03")!(EVENT="A08")!(EVENT="A12")!(EVENT="A13") D G NEXT
83 . S VAFSTR=$$COMMANUM(2,5)_","_$$COMMANUM(7,45)
84 . S HLA("HLS",$$ADD(.LIN,1))=$$IN^VAFHLPV1(DFN,VAFHDT,VAFSTR,$G(IEN),PIVOT,"",.VAFDIAG)
85 I EVENT="A02" D G NEXT
86 . S VAFSTR=$$COMMANUM(2,45)
87 . S HLA("HLS",$$ADD(.LIN,1))=$$IN^VAFHLPV1(DFN,VAFHDT,VAFSTR,$G(IEN),PIVOT,"",.VAFDIAG)
88 G EXIT
89NEXT ;
90 S $P(HLA("HLS",LIN),HLFS,2)=1 ;PV1 SET ID
91 S HLA("HLS",1)="EVN"_HLFS_EVENT_HLFS_$$HLDATE^HLFNC(VAFHDT,"TS")_HLFS
92 S HLA("HLS",1)=HLA("HLS",1)_HLFS_$G(EVCODE) ;,1
93 ;Get patient directory call center parameter
94 N VAFCCON
95 S VAFCCON=$$GET^XPAR("SYS","DG PT DIRECTORY CALL CENTER")
96 I VAFCCON S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLPV2(DFN,IEN,",22,")
97 S VAFSTR=$$COMMANUM(1,4)
98 N HLAROL
99 D BLDROL^VAFCROL("HLAROL",DFN,VAFHDT,VAFSTR,$G(PIVOT),$G(IEN))
100 N I,J,K
101 S I=""
102 F K=1:1 S I=+$O(HLAROL(I)) Q:('I) D
103 . S J=""
104 . F S J=$O(HLAROL(I,J)) Q:(J="") D
105 . . S:('J) HLA("HLS",LIN+K)=HLAROL(I,J)
106 . . S:(J) HLA("HLS",LIN+K,J)=HLAROL(I,J)
107 S LIN=LIN+K-1
108 I (EVENT="A01")!(EVENT="A08")!(EVENT="A11")!(EVENT="A12")!(EVENT="A13") DO
109 . S HLA("HLS",$$ADD(.LIN,1))="DG1"_HLFS_1_HLFS_HLFS_HLFS_$$HLQ^VAFHUTL($G(VAFDIAG))
110 S VAFSTR=$$COMMANUM(1,5)
111 S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZSP(DFN,1,1)
112 S VAFSTR=$$COMMANUM(1,22)
113 S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEL(DFN,VAFSTR,2)
114 S VAFSTR=$$COMMANUM(1,9)
115 S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZCT(DFN,VAFSTR,1)
116 S VAFSTR=$$COMMANUM(1,8)
117 S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEM(DFN,VAFSTR,1,1)
118 D ALL^DGMTU21(DFN,"V",VAFHDT,"R")
119 S VAFSTR=$$COMMANUM(1,13)
120 S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZIR(+$G(DGINR("V")),VAFSTR,1)
121 S VAFSTR=$$COMMANUM(1,10)
122 S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS"))
123 D:$D(VATRACE) LOOP
124 ;
125 S COUNTER=""
126 F S COUNTER=$O(HLA("HLS",COUNTER)) Q:COUNTER'>0 D
127 .; I +(HLA("HLS",COUNTER))=-1 S HLERR="Bad "_COUNTER_" Segment"
128 . I +(HLA("HLS",COUNTER))=-1 S HL="Bad "_COUNTER_" Segment"
129 .
130 ;
131EXIT ;
132 ;I $D(HL)=1 DO
133 ;. S HLERR(1)=HL
134 ;. D EBULL^VAFHUTL2(DFN,VAFHDT,PIVOT,"HLERR(")
135 I $D(HL)>1,$D(HLA("HLS")) DO
136 . I EVENT="A08" DO
137 . . D GENERATE^HLMA("VAFC ADT-A08-TSP SERVER","LM",1,.HLRST,"")
138 . E D GENERATE^HLMA("VAFC ADT-"_EVENT_" SERVER","LM",1,.HLRST,"")
139 .
140 D KVAR^VADPT,KVAR^VAFHLPV1 K HLA,HLERR
141 Q
142LOOP ;
143 ;
144 ;
145 W !!
146 N XX S XX=0
147 F S XX=$O(HLA("HLS",XX)) Q:XX="" W !,HLA("HLS",XX)
148 Q
149 ;
150COMMANUM(FROM,TO) ;Build comma separated list of numbers
151 ;Input : FROM - Starting number (default = 1)
152 ; TO - Ending number (default = FROM)
153 ;Output : Comma separated list of numbers between FROM and TO
154 ; (Ex: 1,2,3)
155 ;Notes : Call assumes FROM <= TO
156 ;
157 S FROM=$G(FROM) S:(FROM="") FROM=1
158 S TO=$G(TO) S:(TO="") TO=FROM
159 N OUTPUT,X
160 S OUTPUT=FROM
161 F X=(FROM+1):1:TO S OUTPUT=(OUTPUT_","_X)
162 Q OUTPUT
163 ;
164ADD(LINE,COUNTER) ;Increments Line = Line + Counter
165 ;Input : LINE - Line number
166 ; COUNTER - Increment number
167 ;Output : Updated LINE value
168 ;
169 S LINE=$G(LINE),COUNTER=$G(COUNTER)
170 S LINE=LINE+COUNTER
171 Q LINE
Note: See TracBrowser for help on using the repository browser.