source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGADT1.m@ 658

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

initial load of FOIAVistA 6/30/08 version

File size: 8.0 KB
Line 
1RGADT1 ;HIRMFO/GJC-BUILD ADT MESSAGES (A01/A03) ;09/21/99
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,14,17,27,28,31,34,45**;30 Apr 99;Build 9
3 Q ; quit if called from the top
4 ;
5EN ; entry point to build/transmit ADT messages
6 ; Messages built by this software are fired off by server protocols:
7 ; RG ADT-A01 SERVER -or- RG ADT-A03 SERVER
8 ;
9 ; This code is called from the RG ADT INPATIENT ENCOUNTER DRIVER &
10 ; RG ADT OUTPATIENT ENCOUNTER DRIVER protocols.
11 ;
12 ; RG ADT OUTPATIENT ENCOUNTER DRIVER is an item protocol under the
13 ; SDAM APPOINTMENTS EVENTS protocol & RG ADT INPATIENT ENCOUNTER DRIVER
14 ; hangs off of the DGPM MOVEMENT EVENTS protocol.
15 ;
16 ; RG ADT OUTPATIENT ENCOUNTER DRIVER hangs off of SDAM APPOINTMENTS
17 ; EVENTS because of DBIA: 1320; RG ADT INPATIENT ENCOUNTER DRIVER
18 ; hangs off of DGPM MOVEMENT EVENTS because of DBIA: 1181.
19 ;
20 ; Integration Agreements (IAs) utilized in this application:
21 ; #1181-subscribers for the DGPM MOVEMENT EVENTS event driver
22 ; #1320-subscribers for the SDAM APPOINTMENT EVENTS event driver
23 ; #2070-check for a national ICN 1st piece, "MPI" node (global read)
24 ; #2161-INIT^HLFNC2
25 ; #2164-GENERATE^HLMA
26 ; #2171-$$WHAT^XUAF4 (Name_"^"_Station Number, we're after Station #)
27 ; #2541-$$KSP^XUPARAM (facility ien, file 4)
28 ; #2624-$$SEND^VAFHUTL()
29 ; #3015-PID segment generation (CIRN PD)
30 ; #3016-EVN segment generation (CIRN PD)
31 ; #3017-PD1 segment generator (CIRN PD)
32 ; #3018-PV1 segment generator (CIRN PD)
33 ; #3072-assign a local ICN to a patient
34 ; #3630-BLDEVN^VAFCQRY, BLDPD1^VAFCQRY & BLDPID^VAFCQRY
35 ; #2988-FILE^VAFCTFU
36 ;
37 ; I $D(RGDG101) then we know we've dropped into this software
38 ; from the DGPM MOVEMENT EVENTS protocol (RG ADT INPATIENT
39 ; ENCOUNTER DRIVER)
40 ;
41 ; Note: DFN is a supported variable in the case of admissions and
42 ; discharges within the Registration package. (part of the discovery
43 ; in the development of RG*1.0*14)
44 ;
45 ; first check if HL7 2.3 messaging has been disabled. DBIA: 2624
46 I '$P($$SEND^VAFHUTL(),"^",2) Q
47 S RGOK=0,RGDATE=""
48 I $D(RGDG101) D
49 . I $G(DFN)'=+$G(DFN) Q ; DFN must be valid
50 .; if an national ICN is missing, assign a local then quit
51 . I '$P($G(^DPT(DFN,"MPI")),"^") S RGLOCAL=$$ICNLC^MPIF001(DFN) Q
52 . Q:$$IFLOCAL^MPIF001(DFN) ; IA 2701, patient has local icn, quit
53 . N %,VAERR,VAIP
54 . S VAIP("D")="LAST" D IN5^VADPT ; dfn should be defined at this point
55 . S RGTYPE=+$G(VAIP(2)) ; RGTYPE=movement type
56 . I RGTYPE'=1&(RGTYPE'=3) Q ; admission or discharges only
57 . S RGENVR=$S(RGTYPE=1:"A1",1:"A2") ; A1=admission, A2=discharge
58 . S RGDATE=$P($G(VAIP(3)),"^"),RGMOV=$G(VAIP(1))
59 . ; RGDATE=movement date/time, RGMOV=ien #405
60 . S:RGDATE]"" RGOK=1
61 . Q
62 ;
63 ; I $D(RGSD101) then we know we've dropped into this software
64 ; from the SDAM APPOINTMENT EVENTS protocol (RG ADT OUTPATIENT
65 ; ENCOUNTER DRIVER)
66 ;
67 ; Check SDAMEVT for values between five and nine inclusive. See if
68 ; this particular outpatient encounter has a status of CHECKED OUT.
69 ; gjc@Hines OI for patch 14
70 ;
71 ; Note: DFN is not a supported variable in the case of clinic
72 ; appointments and workload crediting for count clinics within the
73 ; Scheduling package. (part of the discovery in the development of
74 ; RG*1.0*14)
75 ;
76 ; check-out, stop code add/edit, disp add/edit?
77 N I
78 I $D(RGSD101),($D(SDAMEVT))#2 N DFN D
79 . ; Note: DFN is unstable; it's up to us to define it...
80 . ;chk-out, stop code add, stop code change, disp add & disp change
81 . I SDAMEVT<5!(SDAMEVT>9) Q
82 . S RGTYPE=SDAMEVT,RGENVR="A3"
83 . N RGSDOE,RGPARSE,RGPROC,RGTMP S RGPROC=0
84 . F S RGPROC=$O(^TMP("SDEVT",$J,SDHDL,RGPROC)) Q:'RGPROC D
85 .. S RGSDOE=0
86 .. F S RGSDOE=$O(^TMP("SDEVT",$J,SDHDL,RGPROC,"SDOE",RGSDOE)) Q:'RGSDOE D
87 ... S RGSDOE(0)=$G(^TMP("SDEVT",$J,SDHDL,RGPROC,"SDOE",RGSDOE,0,"AFTER"))
88 ... ; Note: RGSDOE(0)=zero node of 409.68, DFN is the second piece
89 ... S DFN=$P(RGSDOE(0),"^",2) Q:'DFN ; DFN must exist
90 ... ; ignore current inpatients
91 ... Q:$L($G(^DPT(DFN,.1))) ; ward location check IA: 10035
92 ...; if an national ICN is missing, assign a local then quit
93 ... I '$P($G(^DPT(DFN,"MPI")),"^") S RGLOCAL=$$ICNLC^MPIF001(DFN) Q
94 ... Q:$$IFLOCAL^MPIF001(DFN) ; IA 2701, patient has local icn, quit
95 ... K RGPARSE D PARSE^SDOE(.RGSDOE,"EXTERNAL","RGPARSE")
96 ... I $G(RGPARSE(.12))="CHECKED OUT" S RGTMP=$P(RGSDOE(0),U)
97 ... S:$G(RGTMP)>RGDATE RGDATE=RGTMP
98 ... Q
99 .. Q
100 . S:$G(RGDATE)]"" RGOK=1
101 . Q
102 ; S ^TMP("RGTRACE",$J)=1
103 I 'RGOK K RGLOCAL,RGTYPE,RGMOV,RGDATE,RGENVR,RGOK Q ; quit if not A01 or A03
104 I '($G(DGQUIET)) S:$D(^TMP("RGTRACE",$J)) RGTRACE=1
105 N RGSITE S RGSITE=+$$SITE^VASITE
106 ;before updating and broadcasting check to see if the date and/or event changed
107 N LIST,X,OUT,RGCHNG,RGDLT,RGEVN D TFL^VAFCTFU1(.LIST,DFN) S (RGCHNG,OUT,X)=0 F S X=$O(LIST(X)) Q:'X!(OUT=1) D
108 . S RGDATE=$P(RGDATE,"."),RGDLT=$P(LIST(X),"^",3),RGDLT=$P(RGDLT,"."),RGEVN=$P(LIST(X),"^",4)
109 . I $P(LIST(X),"^")=$P($$SITE^VASITE,"^",3) S OUT=1 D
110 .. I RGDATE'=RGDLT D Q
111 ... I RGDATE>RGDLT S RGCHNG=1
112 .. I RGDATE=RGDLT D
113 .. I $E(RGENVR,2)'=RGEVN D
114 ... I RGENVR="A3" S RGCHNG=0
115 ... I RGENVR="A1" S RGCHNG=1
116 ... I RGENVR="A2" S RGCHNG=1
117 ;if no change in DLT or Event Reason quit
118 Q:RGCHNG=0
119 D FILE^VAFCTFU(DFN,RGSITE_"^"_$G(RGDATE)_"^"_$G(RGENVR),1)
120 ;do FILE^VAFCTFU to update DLT and event reason
121 I $D(RGTRACE) D EVENT,EXIT Q
122 N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH
123 S ZTDESC="CIRN HL7 ADT-"_$S(RGTYPE=1:"A01",1:"A03")_" Messaging"
124 S ZTRTN="EVENT^RGADT1",ZTIO="",ZTDTH=$H
125 F I="DFN","RGDATE","RGTYPE","RGENVR" S ZTSAVE(I)=""
126 ; check for $D of RGDG101 & RGSD101 need to know protocol executed
127 S:$D(RGDG101) ZTSAVE("RGDG101")="" S:$D(RGSD101) ZTSAVE("RGSD101")=""
128 S:$D(RGMOV) ZTSAVE("RGMOV")="" ; defined for admissions & discharges
129 S:$D(SDOE) ZTSAVE("SDOE")="" ; file ien: 409.68, clinic check out
130 D ^%ZTLOAD,EXIT
131 K DGQUIET
132 Q
133 ;
134EVENT ; build the HL7 message
135 S:$D(ZTQUEUED) ZTREQ="@"
136 S RGEVT=$S(RGTYPE=1:"A01",1:"A03") K HL
137 D INIT^HLFNC2("RG ADT-"_RGEVT_" 2.4 SERVER",.HL)
138 I $G(HL) Q ; error
139 D BUILD
140 D GENERATE^HLMA("RG ADT-"_RGEVT_" 2.4 SERVER","LM",1,.RGRSLT,"",.HL)
141 D KILL^HLTRANS
142 K HLA("HLS"),RGDATE,RGDG101,RGENVR,RGEVT,RGSD101,RGTYPE
143 Q
144EXIT ; kill and quit
145 K ^TMP("RGTRACE",$J),RGDATE,RGENVR,RGEVT,RGOK,RGLOCAL,RGMOV,RGPAT
146 K RGRSLT,RGFSTR,RGTRACE,RGTYPE
147 Q
148BUILD ; build the ADT message
149 ; EVN segment
150 N CNT,ERR,EVN,RGCNT,SEQ
151 S RGCNT=1
152 D BLDEVN^VAFCQRY(DFN,"1,2,4,5,6,7",.EVN,.HL,$G(HL("ETN")))
153 S HLA("HLS",RGCNT)=$G(EVN(1)) S RGCNT=RGCNT+1
154 N PID S SEQ="ALL" D BLDPID^VAFCQRY(DFN,1,.SEQ,.PID,.HL,.ERR) S HLA("HLS",RGCNT)=PID(1) S X=1,CNT=1 F S X=$O(PID(X)) Q:'X I $D(PID(X)) S HLA("HLS",RGCNT,CNT)=PID(X),CNT=CNT+1
155 S RGCNT=RGCNT+1
156 ; PD1 segment
157 N PD1
158 S SEQ="3" D BLDPD1^VAFCQRY(DFN,.SEQ,.PD1,.HL,.ERR) S HLA("HLS",RGCNT)=PD1(1)
159 S RGCNT=RGCNT+1
160 ; PV1 segment
161 S RGFSTR="2,3,4,5,"_$$COMMANUM(7,45)
162 ;for admission/discharges (registration)
163 I RGTYPE=1!(RGTYPE=3) S HLA("HLS",4)=$$IN^VAFHLPV1(DFN,RGDATE,RGFSTR,RGMOV,"","")
164 ;for scheduling events: checkout
165 I RGTYPE'=1&(RGTYPE'=3) S HLA("HLS",4)=$$EN^VAFHLPV1("",,RGFSTR,,HL("Q"),HL("FS"))
166 S HLA("HLS",4)=$$FAC(HLA("HLS",4))
167 ; adding ZPD segment for POW Status - patch P
168 S HLA("HLS",5)=$$EN1^VAFHLZPD(DFN,"1,17,21,34") ;**45 changed to EN1 call and added PSEUDO SSN REASON TO ZPD SEGMENT
169 ;**45 added 21 and 1 to ZPD call also
170 Q
171COMMANUM(FROM,TO) ;Build comma seperated list of numbers
172 ;Input : FROM - Starting number (default = 1)
173 ; TO - Ending number (default = FROM)
174 ;Output : Comma separated list of numbers between FROM and TO
175 ; (Ex: 1,2,3)
176 ;Notes : Call assumes FROM <= TO
177 ; copied from COMMANUM^VAFCADT2
178 ;
179 S FROM=$G(FROM) S:(FROM="") FROM=1
180 S TO=$G(TO) S:(TO="") TO=FROM
181 N OUTPUT,X
182 S OUTPUT=FROM
183 F X=(FROM+1):1:TO S OUTPUT=(OUTPUT_","_X)
184 Q OUTPUT
185 ;
186FAC(X) ; set facility information, in the form of the Station Number, into
187 ; PV1(3).
188 ; input: the entire PV1 segment
189 ; yield: updated PV1 segment; PV1(3) has facility information (Sta. #)
190 N Y0,Y1 S Y0=$E(HL("ECH"),$L(HL("ECH")))_$$WHAT^XUAF4(+$$KSP^XUPARAM("INST"),99)
191 S Y1=$P(X,HL("FS"),4),$P(Y1,$E(HL("ECH")),4)=Y0,$P(X,HL("FS"),4)=Y1
192 Q X
Note: See TracBrowser for help on using the repository browser.