| 1 | RGADT1 ;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 | ;
|
|---|
| 5 | EN ; 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 | ;
|
|---|
| 134 | EVENT ; 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
|
|---|
| 144 | EXIT ; kill and quit
|
|---|
| 145 | K ^TMP("RGTRACE",$J),RGDATE,RGENVR,RGEVT,RGOK,RGLOCAL,RGMOV,RGPAT
|
|---|
| 146 | K RGRSLT,RGFSTR,RGTRACE,RGTYPE
|
|---|
| 147 | Q
|
|---|
| 148 | BUILD ; 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
|
|---|
| 171 | COMMANUM(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 | ;
|
|---|
| 186 | FAC(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
|
|---|
