98 lines
2.8 KiB
Mathematica
98 lines
2.8 KiB
Mathematica
DGRUADT1 ;ALB/SCK - MAIN BUILDER FOR RAI/MDS ADT MESSAGING ; 7-8-1999
|
|
;;5.3;Registration;**190,480**;Aug 13, 1993
|
|
;
|
|
BLDMSG(DFN,EVCODE,DGIEN,VAFHDT,DGWARD,DGOLDT,DGDTYP) ;
|
|
; INPUT
|
|
; DFN - Ien in Patient File
|
|
; EVCODE - HL7 event code
|
|
; DGIEN - Ien of the Movement
|
|
; VAFHDT - Date of event
|
|
; DGWARD - Associated ward
|
|
; DGOLDT - Old date of ADT even for change to date [Optional]
|
|
; DGDTYP - Change Date type [Optional]
|
|
; A - Admission date
|
|
; T - Transfer Date
|
|
; D - Discharge Date
|
|
;
|
|
Q:"A01,A02,A03,A08,A11,A12,A13,A21,A22"'[$G(EVCODE)
|
|
;
|
|
K HL,HLA,XMTARRY,HLRST
|
|
;
|
|
D INIT^HLFNC2("DGRU-RAI-"_EVCODE_"-SERVER",.HL)
|
|
I $O(HL(""))']"" D Q
|
|
. D ERRBUL(DFN,DT,EVCODE,"-1^Server Protocol not found")
|
|
;
|
|
S DGOLDT=$G(DGOLDT),DGDTYP=$G(DGDTYP)
|
|
D:EVCODE="A01" EN^DGRUGA01(DFN,DGIEN,"XMTARRY")
|
|
D:EVCODE="A02" EN^DGRUGA02(DFN,DGIEN,"XMTARRY")
|
|
D:EVCODE="A03" EN^DGRUGA03(DFN,DGIEN,"XMTARRY")
|
|
; The A11 message is a special case and requires sending the Ward.
|
|
D:EVCODE="A11" EN^DGRUGA11(DFN,DGIEN,"XMTARRY",$G(DGWARD),$G(VAFHDT)) ;GRR 1/26/00 TEST
|
|
D:EVCODE="A12" EN^DGRUGA12(DFN,DGIEN,"XMTARRY")
|
|
D:EVCODE="A13" EN^DGRUGA13(DFN,DGIEN,"XMTARRY")
|
|
D:EVCODE="A21" EN^DGRUGA21(DFN,DGIEN,"XMTARRY")
|
|
D:EVCODE="A22" EN^DGRUGA22(DFN,DGIEN,"XMTARRY")
|
|
D:EVCODE="A08" EN^DGRUGA08(DFN,DGIEN,"XMTARRY",DGDTYP_"^"_DGOLDT)
|
|
;
|
|
I '$O(XMTARRY(0)) D Q
|
|
. D ERRBUL(DFN,DT,EVCODE,"-1^Unable to build segment list to transmit")
|
|
;
|
|
N NDX
|
|
S NDX=0
|
|
F S NDX=$O(XMTARRY(NDX)) Q:'NDX D Q:(+XMTARRY(NDX)<0)
|
|
. I +XMTARRY(NDX)<0 D ERRBUL(DFN,DT,EVCODE,"-1^An error occurred in one of the segments")
|
|
;
|
|
; Load data array
|
|
M HLA("HLS")=XMTARRY
|
|
;
|
|
; Write out message text if in trace mode
|
|
I $D(DGTRACE) D
|
|
. N X S X=0
|
|
. F S X=+$O(HLA("HLS",X)) Q:'X W !,HLA("HLS",X)
|
|
;
|
|
I $D(HLA("HLS")) D
|
|
. D GENERATE^HLMA("DGRU-RAI-"_EVCODE_"-SERVER","LM",1,.HLRST)
|
|
. D MSGBUL(DFN,DT,EVCODE,HLRST)
|
|
. I $D(DGTRACE),$D(HLRST) D
|
|
. . W !,"Message ID: ",+$G(HLRST)
|
|
;
|
|
I +$P(HLRST,"^",2)>0 D Q
|
|
. D ERRBUL(DFN,DT,EVCODE,"-1^"_$P(HLRST,"^",2,3))
|
|
;
|
|
K HLA,HLERR
|
|
Q
|
|
;
|
|
MSGBUL(DFN,DT,EVCODE,MSGID) ;
|
|
N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
|
|
;
|
|
S XMCHAN=1
|
|
S XMSUB="RAI/MDS HL7 MESSAGE XMIT"
|
|
S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
|
|
;
|
|
S XMB="DGRU HL7SND"
|
|
S XMB(1)=EVCODE
|
|
S XMB(2)=$$GET1^DIQ(2,DFN,.01)
|
|
S XMB(3)=+MSGID
|
|
S XMB(4)=$$FMTE^XLFDT(DT)
|
|
S XMB(5)=$$GET1^DIQ(2,DFN,.09) ; p-480 mg
|
|
S XMDT=$$NOW^XLFDT
|
|
D ^XMB
|
|
Q
|
|
;
|
|
ERRBUL(DFN,DT,EVCODE,ERRMSG) ;
|
|
N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
|
|
;
|
|
S XMCHAN=1
|
|
S XMSUB="RAI/MDS HL7 ADT ERROR"
|
|
S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
|
|
;
|
|
S XMB="DGRU RAI ERROR"
|
|
S XMB(1)=$$GET1^DIQ(2,DFN,.01)
|
|
S XMB(2)=EVCODE
|
|
S XMB(3)=">>> "_$P(ERRMSG,"^",2)
|
|
S XMB(4)=$S($G(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"")
|
|
S XMB(5)=$$FMTE^XLFDT($$NOW^XLFDT)
|
|
S XMDT=DT
|
|
D ^XMB
|
|
Q
|