source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUGBJ.m

Last change on this file was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 3.1 KB
Line 
1DGRUGBJ ; ALB/SCK - RAI/MDS COTS ADT Background job ; 8-10-99
2 ;;5.3;Registration;**190,312,357**;Aug 13, 1993
3 ;
4EN ; Main Entry point for patient demographic update to COTS system
5 ;
6 L +^XTMP("ADT/HL7 MDS COTS UPDATE"):3 E Q
7 ;
8 ; Check for HL7 send parameter
9 Q:'$P($$SEND^VAFHUTL(),"^",2)
10 ;
11 ; Look for patient demographic changes monitored by the COTS system
12 N PVTPTR,DGNODE,DFN,DGDATE,DGARRAY,DGUSR,DGRSLT
13 ;
14 S DGARRAY="^TMP(""DGRAI"",""EVNTINFO"","_$J_")"
15 K @DGARRAY
16 ;
17 ; Begin looking for entries needing transmission with a type of "COTS UPDATE", Code 6.
18 S PVTPTR=0
19 F S PVTPTR=+$O(^VAT(391.71,"AXMIT",6,PVTPTR)) Q:('PVTPTR) D
20 . ; If no entry for xref (out of sync) delete the xref and quit
21 . I ('$D(^VAT(391.71,PVTPTR))) K ^VAT(391.71,"AXMIT",6,PVTPTR) Q
22 . ; Get event date and pointer to patient for entry
23 . S DGNODE=$G(^VAT(391.71,PVTPTR,0))
24 . S DFN=+$P(DGNODE,"^",3)
25 . S EVNTDT=+DGNODE
26 . ; Check for patient, if not valid, then mark as transmitted and quit
27 . I ('$D(^DPT(DFN,0))) D XMITFLAG^VAFCDD01(PVTPTR,"",1) Q
28 . ;
29 . K @DGARRAY
30 . S @DGARRAY@("PIVOT")=PVTPTR
31 . S @DGARRAY@("REASON",1)=""
32 . I (+$G(^DPT(DFN,.35))) S @DGARRAY@("REASON",1)=99
33 . ;
34 . S @DGARRAY@("USER")=$$GET1^DIQ(200,+$P(DGNODE,"^",9),.01)
35 . ;
36 . S @DGARRAY@("EVENT-NUM")=$P(DGNODE,"^",2)
37 . S @DGARRAY@("VAR-PTR")=$P(DGNODE,"^",5)
38 . ;
39 . S DGRSLT=$$BLDA08(DFN,EVNTDT,DGARRAY)
40 . I (DGRSLT<0) D ERRBUL(DGARRAY,DGRSLT) ;deleted Q p-357
41 . ;
42 . ; Mark entry in pivot file as transmitted
43 . D XMITFLAG^VAFCDD01(PVTPTR,"",1)
44 ;
45 L -^XTMP("ADT/HL7 MDS COTS UPDATE")
46 Q
47 ;
48BLDA08(DFN,EVNTDT,EVNTINFO,DGDC,DGOSSN) ;
49 ;
50 N RESULT,DGTMP,GLOREF
51 ;
52 S DFN=+$G(DFN)
53 I ('$D(^DPT(DFN,0))) S RESULT="-1^Could not find entry in PATIENT file" G BLDQ
54 ;
55 S DGDC=$G(DGDC)
56 S DGOSSN=$G(DGOSSN)
57 S EVNTDT=$G(EVNTDT)
58 S:('EVNTDT) EVNTDT=$$NOW^XLFDT
59 ;
60 S GLOREF="^TMP(""HLS"","_$J_")"
61 K @GLOREF
62 ;
63 S @EVNTINFO@("DFN")=DFN
64 S @EVNTINFO@("EVENT")="A08"
65 S @EVNTINFO@("DATE")=EVNTDT
66 ;
67 N HLEID,HL,HLFS,HLECH,HLQ,NDX
68 ;
69 K HL
70 D INIT^HLFNC2("DGRU-PATIENT-A08-SERVER",.HL)
71 ;
72 I ($O(HL(""))']"") S RESULT="-1^Server Protocol not found" G BLDQ
73 ;
74 ; Build segment array
75 D EN^DGRUGA08(DFN,"","DGTMP",DGDC,DGOSSN)
76 I '$O(DGTMP(0)) S RESULT="-1^Unable to build segment list to transmit" G BLDQ
77 ;Check segment list for errors
78 S NDX=0
79 F S NDX=$O(DGTMP(NDX)) Q:'NDX D G:(+$G(RESULT)<0) BLDQ
80 . I +DGTMP(NDX)<0 S RESULT="-1^An error occurred in one of the segments"
81 ;
82 M @GLOREF=DGTMP
83 S RESULT=$$SENDMSG(GLOREF)
84 I +$P(RESULT,"^",2)>0 S RESULT="-1^"_$P(RESULT,"^",2,3)
85BLDQ Q $G(RESULT)
86 ;
87SENDMSG(GLOREF) ; Transmit the HL7 message
88 N HLA,HLRST
89 M HLA("HLS")=@GLOREF
90 I $D(HLA("HLS")) D
91 . D GENERATE^HLMA("DGRU-PATIENT-A08-SERVER","LM",1,.HLRST,"")
92 K HLA,HERR
93 Q (HLRST)
94 ;
95ERRBUL(EVNTINFO,RESULT) ; Generate bulliten if an error occurred while building the HL7 message.
96 ;
97 N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
98 ;
99 S XMCHAN=1
100 S XMSUB="RAI/MDS HL7 BUILD ERROR"
101 S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
102 ;
103 S XMB="DGRU RAI ERROR"
104 S XMB(1)=$$GET1^DIQ(2,@EVNTINFO@("DFN"),.01)
105 S XMB(2)=@EVNTINFO@("EVENT")
106 S XMB(3)=">>> "_$P(RESULT,"^",2)
107 S XMB(4)=@EVNTINFO@("USER")
108 S XMB(5)=$$FMTE^XLFDT(@EVNTINFO@("DATE"))
109 S XMDT=DT
110 D ^XMB
111 Q
Note: See TracBrowser for help on using the repository browser.