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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUADT1 2933 printed Sep 23, 2025@20:33:55 Page 2
DGRUADT1 ;ALB/SCK - MAIN BUILDER FOR RAI/MDS ADT MESSAGING ; 7-8-1999
+1 ;;5.3;Registration;**190,480**;Aug 13, 1993
+2 ;
BLDMSG(DFN,EVCODE,DGIEN,VAFHDT,DGWARD,DGOLDT,DGDTYP) ;
+1 ; INPUT
+2 ; DFN - Ien in Patient File
+3 ; EVCODE - HL7 event code
+4 ; DGIEN - Ien of the Movement
+5 ; VAFHDT - Date of event
+6 ; DGWARD - Associated ward
+7 ; DGOLDT - Old date of ADT even for change to date [Optional]
+8 ; DGDTYP - Change Date type [Optional]
+9 ; A - Admission date
+10 ; T - Transfer Date
+11 ; D - Discharge Date
+12 ;
+13 if "A01,A02,A03,A08,A11,A12,A13,A21,A22"'[$GET(EVCODE)
QUIT
+14 ;
+15 KILL HL,HLA,XMTARRY,HLRST
+16 ;
+17 DO INIT^HLFNC2("DGRU-RAI-"_EVCODE_"-SERVER",.HL)
+18 IF $ORDER(HL(""))']""
Begin DoDot:1
+19 DO ERRBUL(DFN,DT,EVCODE,"-1^Server Protocol not found")
End DoDot:1
QUIT
+20 ;
+21 SET DGOLDT=$GET(DGOLDT)
SET DGDTYP=$GET(DGDTYP)
+22 if EVCODE="A01"
DO EN^DGRUGA01(DFN,DGIEN,"XMTARRY")
+23 if EVCODE="A02"
DO EN^DGRUGA02(DFN,DGIEN,"XMTARRY")
+24 if EVCODE="A03"
DO EN^DGRUGA03(DFN,DGIEN,"XMTARRY")
+25 ; The A11 message is a special case and requires sending the Ward.
+26 ;GRR 1/26/00 TEST
if EVCODE="A11"
DO EN^DGRUGA11(DFN,DGIEN,"XMTARRY",$GET(DGWARD),$GET(VAFHDT))
+27 if EVCODE="A12"
DO EN^DGRUGA12(DFN,DGIEN,"XMTARRY")
+28 if EVCODE="A13"
DO EN^DGRUGA13(DFN,DGIEN,"XMTARRY")
+29 if EVCODE="A21"
DO EN^DGRUGA21(DFN,DGIEN,"XMTARRY")
+30 if EVCODE="A22"
DO EN^DGRUGA22(DFN,DGIEN,"XMTARRY")
+31 if EVCODE="A08"
DO EN^DGRUGA08(DFN,DGIEN,"XMTARRY",DGDTYP_"^"_DGOLDT)
+32 ;
+33 IF '$ORDER(XMTARRY(0))
Begin DoDot:1
+34 DO ERRBUL(DFN,DT,EVCODE,"-1^Unable to build segment list to transmit")
End DoDot:1
QUIT
+35 ;
+36 NEW NDX
+37 SET NDX=0
+38 FOR
SET NDX=$ORDER(XMTARRY(NDX))
if 'NDX
QUIT
Begin DoDot:1
+39 IF +XMTARRY(NDX)<0
DO ERRBUL(DFN,DT,EVCODE,"-1^An error occurred in one of the segments")
End DoDot:1
if (+XMTARRY(NDX)<0)
QUIT
+40 ;
+41 ; Load data array
+42 MERGE HLA("HLS")=XMTARRY
+43 ;
+44 ; Write out message text if in trace mode
+45 IF $DATA(DGTRACE)
Begin DoDot:1
+46 NEW X
SET X=0
+47 FOR
SET X=+$ORDER(HLA("HLS",X))
if 'X
QUIT
WRITE !,HLA("HLS",X)
End DoDot:1
+48 ;
+49 IF $DATA(HLA("HLS"))
Begin DoDot:1
+50 DO GENERATE^HLMA("DGRU-RAI-"_EVCODE_"-SERVER","LM",1,.HLRST)
+51 DO MSGBUL(DFN,DT,EVCODE,HLRST)
+52 IF $DATA(DGTRACE)
IF $DATA(HLRST)
Begin DoDot:2
+53 WRITE !,"Message ID: ",+$GET(HLRST)
End DoDot:2
End DoDot:1
+54 ;
+55 IF +$PIECE(HLRST,"^",2)>0
Begin DoDot:1
+56 DO ERRBUL(DFN,DT,EVCODE,"-1^"_$PIECE(HLRST,"^",2,3))
End DoDot:1
QUIT
+57 ;
+58 KILL HLA,HLERR
+59 QUIT
+60 ;
MSGBUL(DFN,DT,EVCODE,MSGID) ;
+1 NEW XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
+2 ;
+3 SET XMCHAN=1
+4 SET XMSUB="RAI/MDS HL7 MESSAGE XMIT"
+5 SET (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
+6 ;
+7 SET XMB="DGRU HL7SND"
+8 SET XMB(1)=EVCODE
+9 SET XMB(2)=$$GET1^DIQ(2,DFN,.01)
+10 SET XMB(3)=+MSGID
+11 SET XMB(4)=$$FMTE^XLFDT(DT)
+12 ; p-480 mg
SET XMB(5)=$$GET1^DIQ(2,DFN,.09)
+13 SET XMDT=$$NOW^XLFDT
+14 DO ^XMB
+15 QUIT
+16 ;
ERRBUL(DFN,DT,EVCODE,ERRMSG) ;
+1 NEW XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
+2 ;
+3 SET XMCHAN=1
+4 SET XMSUB="RAI/MDS HL7 ADT ERROR"
+5 SET (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
+6 ;
+7 SET XMB="DGRU RAI ERROR"
+8 SET XMB(1)=$$GET1^DIQ(2,DFN,.01)
+9 SET XMB(2)=EVCODE
+10 SET XMB(3)=">>> "_$PIECE(ERRMSG,"^",2)
+11 SET XMB(4)=$SELECT($GET(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"")
+12 SET XMB(5)=$$FMTE^XLFDT($$NOW^XLFDT)
+13 SET XMDT=DT
+14 DO ^XMB
+15 QUIT
