193 lines
8.0 KiB
Mathematica
193 lines
8.0 KiB
Mathematica
|
RGADT1 ;HIRMFO/GJC-BUILD ADT MESSAGES (A01/A03) ;09/21/99
|
||
|
|
;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,14,17,27,28,31,34,45**;30 Apr 99;Build 9
|
||
|
|
Q ; quit if called from the top
|
||
|
|
;
|
||
|
|
EN ; entry point to build/transmit ADT messages
|
||
|
|
; Messages built by this software are fired off by server protocols:
|
||
|
|
; RG ADT-A01 SERVER -or- RG ADT-A03 SERVER
|
||
|
|
;
|
||
|
|
; This code is called from the RG ADT INPATIENT ENCOUNTER DRIVER &
|
||
|
|
; RG ADT OUTPATIENT ENCOUNTER DRIVER protocols.
|
||
|
|
;
|
||
|
|
; RG ADT OUTPATIENT ENCOUNTER DRIVER is an item protocol under the
|
||
|
|
; SDAM APPOINTMENTS EVENTS protocol & RG ADT INPATIENT ENCOUNTER DRIVER
|
||
|
|
; hangs off of the DGPM MOVEMENT EVENTS protocol.
|
||
|
|
;
|
||
|
|
; RG ADT OUTPATIENT ENCOUNTER DRIVER hangs off of SDAM APPOINTMENTS
|
||
|
|
; EVENTS because of DBIA: 1320; RG ADT INPATIENT ENCOUNTER DRIVER
|
||
|
|
; hangs off of DGPM MOVEMENT EVENTS because of DBIA: 1181.
|
||
|
|
;
|
||
|
|
; Integration Agreements (IAs) utilized in this application:
|
||
|
|
; #1181-subscribers for the DGPM MOVEMENT EVENTS event driver
|
||
|
|
; #1320-subscribers for the SDAM APPOINTMENT EVENTS event driver
|
||
|
|
; #2070-check for a national ICN 1st piece, "MPI" node (global read)
|
||
|
|
; #2161-INIT^HLFNC2
|
||
|
|
; #2164-GENERATE^HLMA
|
||
|
|
; #2171-$$WHAT^XUAF4 (Name_"^"_Station Number, we're after Station #)
|
||
|
|
; #2541-$$KSP^XUPARAM (facility ien, file 4)
|
||
|
|
; #2624-$$SEND^VAFHUTL()
|
||
|
|
; #3015-PID segment generation (CIRN PD)
|
||
|
|
; #3016-EVN segment generation (CIRN PD)
|
||
|
|
; #3017-PD1 segment generator (CIRN PD)
|
||
|
|
; #3018-PV1 segment generator (CIRN PD)
|
||
|
|
; #3072-assign a local ICN to a patient
|
||
|
|
; #3630-BLDEVN^VAFCQRY, BLDPD1^VAFCQRY & BLDPID^VAFCQRY
|
||
|
|
; #2988-FILE^VAFCTFU
|
||
|
|
;
|
||
|
|
; I $D(RGDG101) then we know we've dropped into this software
|
||
|
|
; from the DGPM MOVEMENT EVENTS protocol (RG ADT INPATIENT
|
||
|
|
; ENCOUNTER DRIVER)
|
||
|
|
;
|
||
|
|
; Note: DFN is a supported variable in the case of admissions and
|
||
|
|
; discharges within the Registration package. (part of the discovery
|
||
|
|
; in the development of RG*1.0*14)
|
||
|
|
;
|
||
|
|
; first check if HL7 2.3 messaging has been disabled. DBIA: 2624
|
||
|
|
I '$P($$SEND^VAFHUTL(),"^",2) Q
|
||
|
|
S RGOK=0,RGDATE=""
|
||
|
|
I $D(RGDG101) D
|
||
|
|
. I $G(DFN)'=+$G(DFN) Q ; DFN must be valid
|
||
|
|
.; if an national ICN is missing, assign a local then quit
|
||
|
|
. I '$P($G(^DPT(DFN,"MPI")),"^") S RGLOCAL=$$ICNLC^MPIF001(DFN) Q
|
||
|
|
. Q:$$IFLOCAL^MPIF001(DFN) ; IA 2701, patient has local icn, quit
|
||
|
|
. N %,VAERR,VAIP
|
||
|
|
. S VAIP("D")="LAST" D IN5^VADPT ; dfn should be defined at this point
|
||
|
|
. S RGTYPE=+$G(VAIP(2)) ; RGTYPE=movement type
|
||
|
|
. I RGTYPE'=1&(RGTYPE'=3) Q ; admission or discharges only
|
||
|
|
. S RGENVR=$S(RGTYPE=1:"A1",1:"A2") ; A1=admission, A2=discharge
|
||
|
|
. S RGDATE=$P($G(VAIP(3)),"^"),RGMOV=$G(VAIP(1))
|
||
|
|
. ; RGDATE=movement date/time, RGMOV=ien #405
|
||
|
|
. S:RGDATE]"" RGOK=1
|
||
|
|
. Q
|
||
|
|
;
|
||
|
|
; I $D(RGSD101) then we know we've dropped into this software
|
||
|
|
; from the SDAM APPOINTMENT EVENTS protocol (RG ADT OUTPATIENT
|
||
|
|
; ENCOUNTER DRIVER)
|
||
|
|
;
|
||
|
|
; Check SDAMEVT for values between five and nine inclusive. See if
|
||
|
|
; this particular outpatient encounter has a status of CHECKED OUT.
|
||
|
|
; gjc@Hines OI for patch 14
|
||
|
|
;
|
||
|
|
; Note: DFN is not a supported variable in the case of clinic
|
||
|
|
; appointments and workload crediting for count clinics within the
|
||
|
|
; Scheduling package. (part of the discovery in the development of
|
||
|
|
; RG*1.0*14)
|
||
|
|
;
|
||
|
|
; check-out, stop code add/edit, disp add/edit?
|
||
|
|
N I
|
||
|
|
I $D(RGSD101),($D(SDAMEVT))#2 N DFN D
|
||
|
|
. ; Note: DFN is unstable; it's up to us to define it...
|
||
|
|
. ;chk-out, stop code add, stop code change, disp add & disp change
|
||
|
|
. I SDAMEVT<5!(SDAMEVT>9) Q
|
||
|
|
. S RGTYPE=SDAMEVT,RGENVR="A3"
|
||
|
|
. N RGSDOE,RGPARSE,RGPROC,RGTMP S RGPROC=0
|
||
|
|
. F S RGPROC=$O(^TMP("SDEVT",$J,SDHDL,RGPROC)) Q:'RGPROC D
|
||
|
|
.. S RGSDOE=0
|
||
|
|
.. F S RGSDOE=$O(^TMP("SDEVT",$J,SDHDL,RGPROC,"SDOE",RGSDOE)) Q:'RGSDOE D
|
||
|
|
... S RGSDOE(0)=$G(^TMP("SDEVT",$J,SDHDL,RGPROC,"SDOE",RGSDOE,0,"AFTER"))
|
||
|
|
... ; Note: RGSDOE(0)=zero node of 409.68, DFN is the second piece
|
||
|
|
... S DFN=$P(RGSDOE(0),"^",2) Q:'DFN ; DFN must exist
|
||
|
|
... ; ignore current inpatients
|
||
|
|
... Q:$L($G(^DPT(DFN,.1))) ; ward location check IA: 10035
|
||
|
|
...; if an national ICN is missing, assign a local then quit
|
||
|
|
... I '$P($G(^DPT(DFN,"MPI")),"^") S RGLOCAL=$$ICNLC^MPIF001(DFN) Q
|
||
|
|
... Q:$$IFLOCAL^MPIF001(DFN) ; IA 2701, patient has local icn, quit
|
||
|
|
... K RGPARSE D PARSE^SDOE(.RGSDOE,"EXTERNAL","RGPARSE")
|
||
|
|
... I $G(RGPARSE(.12))="CHECKED OUT" S RGTMP=$P(RGSDOE(0),U)
|
||
|
|
... S:$G(RGTMP)>RGDATE RGDATE=RGTMP
|
||
|
|
... Q
|
||
|
|
.. Q
|
||
|
|
. S:$G(RGDATE)]"" RGOK=1
|
||
|
|
. Q
|
||
|
|
; S ^TMP("RGTRACE",$J)=1
|
||
|
|
I 'RGOK K RGLOCAL,RGTYPE,RGMOV,RGDATE,RGENVR,RGOK Q ; quit if not A01 or A03
|
||
|
|
I '($G(DGQUIET)) S:$D(^TMP("RGTRACE",$J)) RGTRACE=1
|
||
|
|
N RGSITE S RGSITE=+$$SITE^VASITE
|
||
|
|
;before updating and broadcasting check to see if the date and/or event changed
|
||
|
|
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
|
||
|
|
. S RGDATE=$P(RGDATE,"."),RGDLT=$P(LIST(X),"^",3),RGDLT=$P(RGDLT,"."),RGEVN=$P(LIST(X),"^",4)
|
||
|
|
. I $P(LIST(X),"^")=$P($$SITE^VASITE,"^",3) S OUT=1 D
|
||
|
|
.. I RGDATE'=RGDLT D Q
|
||
|
|
... I RGDATE>RGDLT S RGCHNG=1
|
||
|
|
.. I RGDATE=RGDLT D
|
||
|
|
.. I $E(RGENVR,2)'=RGEVN D
|
||
|
|
... I RGENVR="A3" S RGCHNG=0
|
||
|
|
... I RGENVR="A1" S RGCHNG=1
|
||
|
|
... I RGENVR="A2" S RGCHNG=1
|
||
|
|
;if no change in DLT or Event Reason quit
|
||
|
|
Q:RGCHNG=0
|
||
|
|
D FILE^VAFCTFU(DFN,RGSITE_"^"_$G(RGDATE)_"^"_$G(RGENVR),1)
|
||
|
|
;do FILE^VAFCTFU to update DLT and event reason
|
||
|
|
I $D(RGTRACE) D EVENT,EXIT Q
|
||
|
|
N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH
|
||
|
|
S ZTDESC="CIRN HL7 ADT-"_$S(RGTYPE=1:"A01",1:"A03")_" Messaging"
|
||
|
|
S ZTRTN="EVENT^RGADT1",ZTIO="",ZTDTH=$H
|
||
|
|
F I="DFN","RGDATE","RGTYPE","RGENVR" S ZTSAVE(I)=""
|
||
|
|
; check for $D of RGDG101 & RGSD101 need to know protocol executed
|
||
|
|
S:$D(RGDG101) ZTSAVE("RGDG101")="" S:$D(RGSD101) ZTSAVE("RGSD101")=""
|
||
|
|
S:$D(RGMOV) ZTSAVE("RGMOV")="" ; defined for admissions & discharges
|
||
|
|
S:$D(SDOE) ZTSAVE("SDOE")="" ; file ien: 409.68, clinic check out
|
||
|
|
D ^%ZTLOAD,EXIT
|
||
|
|
K DGQUIET
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EVENT ; build the HL7 message
|
||
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
||
|
|
S RGEVT=$S(RGTYPE=1:"A01",1:"A03") K HL
|
||
|
|
D INIT^HLFNC2("RG ADT-"_RGEVT_" 2.4 SERVER",.HL)
|
||
|
|
I $G(HL) Q ; error
|
||
|
|
D BUILD
|
||
|
|
D GENERATE^HLMA("RG ADT-"_RGEVT_" 2.4 SERVER","LM",1,.RGRSLT,"",.HL)
|
||
|
|
D KILL^HLTRANS
|
||
|
|
K HLA("HLS"),RGDATE,RGDG101,RGENVR,RGEVT,RGSD101,RGTYPE
|
||
|
|
Q
|
||
|
|
EXIT ; kill and quit
|
||
|
|
K ^TMP("RGTRACE",$J),RGDATE,RGENVR,RGEVT,RGOK,RGLOCAL,RGMOV,RGPAT
|
||
|
|
K RGRSLT,RGFSTR,RGTRACE,RGTYPE
|
||
|
|
Q
|
||
|
|
BUILD ; build the ADT message
|
||
|
|
; EVN segment
|
||
|
|
N CNT,ERR,EVN,RGCNT,SEQ
|
||
|
|
S RGCNT=1
|
||
|
|
D BLDEVN^VAFCQRY(DFN,"1,2,4,5,6,7",.EVN,.HL,$G(HL("ETN")))
|
||
|
|
S HLA("HLS",RGCNT)=$G(EVN(1)) S RGCNT=RGCNT+1
|
||
|
|
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
|
||
|
|
S RGCNT=RGCNT+1
|
||
|
|
; PD1 segment
|
||
|
|
N PD1
|
||
|
|
S SEQ="3" D BLDPD1^VAFCQRY(DFN,.SEQ,.PD1,.HL,.ERR) S HLA("HLS",RGCNT)=PD1(1)
|
||
|
|
S RGCNT=RGCNT+1
|
||
|
|
; PV1 segment
|
||
|
|
S RGFSTR="2,3,4,5,"_$$COMMANUM(7,45)
|
||
|
|
;for admission/discharges (registration)
|
||
|
|
I RGTYPE=1!(RGTYPE=3) S HLA("HLS",4)=$$IN^VAFHLPV1(DFN,RGDATE,RGFSTR,RGMOV,"","")
|
||
|
|
;for scheduling events: checkout
|
||
|
|
I RGTYPE'=1&(RGTYPE'=3) S HLA("HLS",4)=$$EN^VAFHLPV1("",,RGFSTR,,HL("Q"),HL("FS"))
|
||
|
|
S HLA("HLS",4)=$$FAC(HLA("HLS",4))
|
||
|
|
; adding ZPD segment for POW Status - patch P
|
||
|
|
S HLA("HLS",5)=$$EN1^VAFHLZPD(DFN,"1,17,21,34") ;**45 changed to EN1 call and added PSEUDO SSN REASON TO ZPD SEGMENT
|
||
|
|
;**45 added 21 and 1 to ZPD call also
|
||
|
|
Q
|
||
|
|
COMMANUM(FROM,TO) ;Build comma seperated list of numbers
|
||
|
|
;Input : FROM - Starting number (default = 1)
|
||
|
|
; TO - Ending number (default = FROM)
|
||
|
|
;Output : Comma separated list of numbers between FROM and TO
|
||
|
|
; (Ex: 1,2,3)
|
||
|
|
;Notes : Call assumes FROM <= TO
|
||
|
|
; copied from COMMANUM^VAFCADT2
|
||
|
|
;
|
||
|
|
S FROM=$G(FROM) S:(FROM="") FROM=1
|
||
|
|
S TO=$G(TO) S:(TO="") TO=FROM
|
||
|
|
N OUTPUT,X
|
||
|
|
S OUTPUT=FROM
|
||
|
|
F X=(FROM+1):1:TO S OUTPUT=(OUTPUT_","_X)
|
||
|
|
Q OUTPUT
|
||
|
|
;
|
||
|
|
FAC(X) ; set facility information, in the form of the Station Number, into
|
||
|
|
; PV1(3).
|
||
|
|
; input: the entire PV1 segment
|
||
|
|
; yield: updated PV1 segment; PV1(3) has facility information (Sta. #)
|
||
|
|
N Y0,Y1 S Y0=$E(HL("ECH"),$L(HL("ECH")))_$$WHAT^XUAF4(+$$KSP^XUPARAM("INST"),99)
|
||
|
|
S Y1=$P(X,HL("FS"),4),$P(Y1,$E(HL("ECH")),4)=Y0,$P(X,HL("FS"),4)=Y1
|
||
|
|
Q X
|