source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUADT1.m@ 1704

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

initial load of WorldVistAEHR
File size: 2.8 KB
Line 
1DGRUADT1 ;ALB/SCK - MAIN BUILDER FOR RAI/MDS ADT MESSAGING ; 7-8-1999
2 ;;5.3;Registration;**190,480**;Aug 13, 1993
3 ;
4BLDMSG(DFN,EVCODE,DGIEN,VAFHDT,DGWARD,DGOLDT,DGDTYP) ;
5 ; INPUT
6 ; DFN - Ien in Patient File
7 ; EVCODE - HL7 event code
8 ; DGIEN - Ien of the Movement
9 ; VAFHDT - Date of event
10 ; DGWARD - Associated ward
11 ; DGOLDT - Old date of ADT even for change to date [Optional]
12 ; DGDTYP - Change Date type [Optional]
13 ; A - Admission date
14 ; T - Transfer Date
15 ; D - Discharge Date
16 ;
17 Q:"A01,A02,A03,A08,A11,A12,A13,A21,A22"'[$G(EVCODE)
18 ;
19 K HL,HLA,XMTARRY,HLRST
20 ;
21 D INIT^HLFNC2("DGRU-RAI-"_EVCODE_"-SERVER",.HL)
22 I $O(HL(""))']"" D Q
23 . D ERRBUL(DFN,DT,EVCODE,"-1^Server Protocol not found")
24 ;
25 S DGOLDT=$G(DGOLDT),DGDTYP=$G(DGDTYP)
26 D:EVCODE="A01" EN^DGRUGA01(DFN,DGIEN,"XMTARRY")
27 D:EVCODE="A02" EN^DGRUGA02(DFN,DGIEN,"XMTARRY")
28 D:EVCODE="A03" EN^DGRUGA03(DFN,DGIEN,"XMTARRY")
29 ; The A11 message is a special case and requires sending the Ward.
30 D:EVCODE="A11" EN^DGRUGA11(DFN,DGIEN,"XMTARRY",$G(DGWARD),$G(VAFHDT)) ;GRR 1/26/00 TEST
31 D:EVCODE="A12" EN^DGRUGA12(DFN,DGIEN,"XMTARRY")
32 D:EVCODE="A13" EN^DGRUGA13(DFN,DGIEN,"XMTARRY")
33 D:EVCODE="A21" EN^DGRUGA21(DFN,DGIEN,"XMTARRY")
34 D:EVCODE="A22" EN^DGRUGA22(DFN,DGIEN,"XMTARRY")
35 D:EVCODE="A08" EN^DGRUGA08(DFN,DGIEN,"XMTARRY",DGDTYP_"^"_DGOLDT)
36 ;
37 I '$O(XMTARRY(0)) D Q
38 . D ERRBUL(DFN,DT,EVCODE,"-1^Unable to build segment list to transmit")
39 ;
40 N NDX
41 S NDX=0
42 F S NDX=$O(XMTARRY(NDX)) Q:'NDX D Q:(+XMTARRY(NDX)<0)
43 . I +XMTARRY(NDX)<0 D ERRBUL(DFN,DT,EVCODE,"-1^An error occurred in one of the segments")
44 ;
45 ; Load data array
46 M HLA("HLS")=XMTARRY
47 ;
48 ; Write out message text if in trace mode
49 I $D(DGTRACE) D
50 . N X S X=0
51 . F S X=+$O(HLA("HLS",X)) Q:'X W !,HLA("HLS",X)
52 ;
53 I $D(HLA("HLS")) D
54 . D GENERATE^HLMA("DGRU-RAI-"_EVCODE_"-SERVER","LM",1,.HLRST)
55 . D MSGBUL(DFN,DT,EVCODE,HLRST)
56 . I $D(DGTRACE),$D(HLRST) D
57 . . W !,"Message ID: ",+$G(HLRST)
58 ;
59 I +$P(HLRST,"^",2)>0 D Q
60 . D ERRBUL(DFN,DT,EVCODE,"-1^"_$P(HLRST,"^",2,3))
61 ;
62 K HLA,HLERR
63 Q
64 ;
65MSGBUL(DFN,DT,EVCODE,MSGID) ;
66 N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
67 ;
68 S XMCHAN=1
69 S XMSUB="RAI/MDS HL7 MESSAGE XMIT"
70 S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
71 ;
72 S XMB="DGRU HL7SND"
73 S XMB(1)=EVCODE
74 S XMB(2)=$$GET1^DIQ(2,DFN,.01)
75 S XMB(3)=+MSGID
76 S XMB(4)=$$FMTE^XLFDT(DT)
77 S XMB(5)=$$GET1^DIQ(2,DFN,.09) ; p-480 mg
78 S XMDT=$$NOW^XLFDT
79 D ^XMB
80 Q
81 ;
82ERRBUL(DFN,DT,EVCODE,ERRMSG) ;
83 N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
84 ;
85 S XMCHAN=1
86 S XMSUB="RAI/MDS HL7 ADT ERROR"
87 S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
88 ;
89 S XMB="DGRU RAI ERROR"
90 S XMB(1)=$$GET1^DIQ(2,DFN,.01)
91 S XMB(2)=EVCODE
92 S XMB(3)=">>> "_$P(ERRMSG,"^",2)
93 S XMB(4)=$S($G(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"")
94 S XMB(5)=$$FMTE^XLFDT($$NOW^XLFDT)
95 S XMDT=DT
96 D ^XMB
97 Q
Note: See TracBrowser for help on using the repository browser.