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

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1DGRUGBJ ; ALB/SCK - RAI/MDS COTS ADT Background job ; 11/7/07 3:49pm
2 ;;5.3;Registration;**190,312,357,762**;Aug 13, 1993;Build 3
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 . N VAIN D INP^VADPT ; p-762
29 . I '$$CHKWARD^DGRUUTL(+VAIN(4)) D XMITFLAG^VAFCDD01(PVTPTR,"",1) K VAIN Q ; P-762
30 . K @DGARRAY
31 . S @DGARRAY@("PIVOT")=PVTPTR
32 . S @DGARRAY@("REASON",1)=""
33 . I (+$G(^DPT(DFN,.35))) S @DGARRAY@("REASON",1)=99
34 . ;
35 . S @DGARRAY@("USER")=$$GET1^DIQ(200,+$P(DGNODE,"^",9),.01)
36 . ;
37 . S @DGARRAY@("EVENT-NUM")=$P(DGNODE,"^",2)
38 . S @DGARRAY@("VAR-PTR")=$P(DGNODE,"^",5)
39 . ;
40 . S DGRSLT=$$BLDA08(DFN,EVNTDT,DGARRAY)
41 . I (DGRSLT<0) D ERRBUL(DGARRAY,DGRSLT) ;deleted Q p-357
42 . ;
43 . ; Mark entry in pivot file as transmitted
44 . D XMITFLAG^VAFCDD01(PVTPTR,"",1)
45 ;
46 L -^XTMP("ADT/HL7 MDS COTS UPDATE")
47 Q
48 ;
49BLDA08(DFN,EVNTDT,EVNTINFO,DGDC,DGOSSN) ;
50 ;
51 N RESULT,DGTMP,GLOREF
52 ;
53 S DFN=+$G(DFN)
54 I ('$D(^DPT(DFN,0))) S RESULT="-1^Could not find entry in PATIENT file" G BLDQ
55 ;
56 S DGDC=$G(DGDC)
57 S DGOSSN=$G(DGOSSN)
58 S EVNTDT=$G(EVNTDT)
59 S:('EVNTDT) EVNTDT=$$NOW^XLFDT
60 ;
61 S GLOREF="^TMP(""HLS"","_$J_")"
62 K @GLOREF
63 ;
64 S @EVNTINFO@("DFN")=DFN
65 S @EVNTINFO@("EVENT")="A08"
66 S @EVNTINFO@("DATE")=EVNTDT
67 ;
68 N HLEID,HL,HLFS,HLECH,HLQ,NDX
69 ;
70 K HL
71 D INIT^HLFNC2("DGRU-PATIENT-A08-SERVER",.HL)
72 ;
73 I ($O(HL(""))']"") S RESULT="-1^Server Protocol not found" G BLDQ
74 ;
75 ; Build segment array
76 D EN^DGRUGA08(DFN,"","DGTMP",DGDC,DGOSSN)
77 I '$O(DGTMP(0)) S RESULT="-1^Unable to build segment list to transmit" G BLDQ
78 ;Check segment list for errors
79 S NDX=0
80 F S NDX=$O(DGTMP(NDX)) Q:'NDX D G:(+$G(RESULT)<0) BLDQ
81 . I +DGTMP(NDX)<0 S RESULT="-1^An error occurred in one of the segments"
82 ;
83 M @GLOREF=DGTMP
84 S RESULT=$$SENDMSG(GLOREF)
85 I +$P(RESULT,"^",2)>0 S RESULT="-1^"_$P(RESULT,"^",2,3)
86BLDQ Q $G(RESULT)
87 ;
88SENDMSG(GLOREF) ; Transmit the HL7 message
89 N HLA,HLRST
90 M HLA("HLS")=@GLOREF
91 I $D(HLA("HLS")) D
92 . D GENERATE^HLMA("DGRU-PATIENT-A08-SERVER","LM",1,.HLRST,"")
93 K HLA,HERR
94 Q (HLRST)
95 ;
96ERRBUL(EVNTINFO,RESULT) ; Generate bulletin if an error occurred while building the HL7 message.
97 ;
98 N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
99 ;
100 S XMCHAN=1
101 S XMSUB="RAI/MDS HL7 BUILD ERROR"
102 S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
103 ;
104 S XMB="DGRU RAI ERROR"
105 S XMB(1)=$$GET1^DIQ(2,@EVNTINFO@("DFN"),.01)
106 S XMB(2)=@EVNTINFO@("EVENT")
107 S XMB(3)=">>> "_$P(RESULT,"^",2)
108 S XMB(4)=@EVNTINFO@("USER")
109 S XMB(5)=$$FMTE^XLFDT(@EVNTINFO@("DATE"))
110 S XMDT=DT
111 D ^XMB
112 Q
Note: See TracBrowser for help on using the repository browser.