source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQADM2.m@ 1553

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

initial load of FOIAVistA 6/30/08 version
File size: 2.9 KB
Line 
1VAQADM2 ;ALB/JRP - MESSAGE ADMINISTRATION;22-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;**33**;NOV 17, 1993
3START ;START RESPONSE TIME MONITORING (TIME TO PARSE A TRANSMISSION)
4 I ($D(XRTL)) D T0^%ZOSV
5 Q
6 ;
7STOP ;STOP RESPONSE TIME MONITORING
8 I ($D(XRT0)) S XRTN=$T(+0) D T1^%ZOSV K XRTN,XRT0
9 Q
10 ;
11SERVER ;PDX SERVER MAIN ENTRY POINT
12 ;INPUT : (As defined by MailMan)
13 ; XMFROM, XMREC, XMZ
14 ; Actually, XMFROM and XMZ are not defined by MailMan,
15 ; but by Kernel, in XQSRV* routines, and these variables only
16 ; exist because this routine is executed immediately. If it
17 ; were queued, only the following would exist:
18 ; XQMSG - Msg IEN in file 3.9 (XMZ)
19 ; XQSND - Msg sender (XMFROM)
20 ;OUTPUT : None
21 ;NOTES : Input is not checked (assume existence)
22 ;
23 ;CHECK FOR EXISTANCE OF TRANSMISSION
24 Q:('$D(^XMB(3.9,XMZ)))
25 ;DECLARE VARIABLES
26 N VERSION,XMER,XMRG,XMPOS,TMP,PARSE,XMSER,XMXX,MESSAGE
27 N TRANS,TYPE,STATUS,ERROR,XMIT,LOCSITE
28 S PARSE="^TMP(""VAQ-PARSE"","_$J_",""PARSE"","_XMZ_")"
29 S ERROR="^TMP(""VAQ-PARSE"","_$J_",""ERROR"","_XMZ_")"
30 S XMIT="^TMP(""VAQ-PARSE"","_$J_",""XMIT"","_XMZ_")"
31 K @PARSE,@ERROR,@XMIT
32 ;GET LOCAL SITE FROM PARAMETER FILE
33 S TMP=+$O(^VAT(394.81,0))
34 S LOCSITE=+$G(^VAT(394.81,TMP,0))
35 S TMP=$P($G(^DIC(4,LOCSITE,0)),"^",1)
36 I (TMP="") S TMP=$P($$SITE^VASITE,"^",2) S:(TMP=-1) TMP="Local Facility"
37 S LOCSITE=TMP
38 I $$CLOSED(XQSND) D Q
39 .S @ERROR@("GENERAL",1)="Sending domain closed. Message ignored and deleted."
40 .D CLEANUP(1)
41 ;READ FIRST LINE OF TRANSMISSION
42 S XMPOS=0
43 X XMREC
44 I (XMER<0) D Q
45 .S @ERROR@("GENERAL",1)="Unable to read first line of message"
46 .D CLEANUP(1)
47 ;DETERMINE PDX VERSION NUMBER
48 S TMP=+$P(XMRG,"^",11)
49 S VERSION=$S((XMRG="$TRANSMIT"):1.5,((TMP=100)!(TMP=101)!($P(XMRG,"^",1)="ACK")):1,1:0)
50 I ('VERSION) D Q
51 .S @ERROR@("GENERAL",1)="Unable to determine version of PDX used to generate transmission"
52 .D CLEANUP(1)
53 ;PARSE TRANSMISSION
54 S XMPOS=0
55 I (VERSION=1) D START D K @PARSE@(1) D STOP
56 .D PREPRS10^VAQPAR1(PARSE)
57 .Q:(XMER<0)
58 .D PARSE10^VAQPAR1(PARSE)
59 I (VERSION=1.5) D START D PARSE^VAQPAR6(PARSE) D STOP
60 I (XMER<0) D Q
61 .S @ERROR@("GENERAL",1)="Error occurred while parsing version "_VERSION_" transmission"
62 .S @ERROR@("GENERAL",2)=$P(XMER,"^",2)
63 .D CLEANUP(1) ; was (0) before patch 33
64 ;ACT ON MESSAGE
65 D ACTIONS^VAQADM21
66 ;CLEAN UP & QUIT
67 D CLEANUP(1) ; was (0) before patch 33
68 Q
69CLOSED(XMFROM) ; Is the domain from which this message was received closed?
70 ; 1=yes, 0=no
71 I XMFROM'["@" Q 0
72 N VIEN
73 S VIEN=$$FIND1^DIC(4.2,"","M",$P($P(XMFROM,"@",2),">",1),"B^C")
74 Q:'VIEN 0
75 I $P(^DIC(4.2,VIEN,0),U,2)["C" Q 1
76 Q 0
77 ;
78CLEANUP(VDELMSG) ;CLEAN UP
79 ; VDELMSG - Delete message if error? 1=yes; 0=no
80 ;DELETE PARSING ARRAY
81 K @PARSE,@XMIT
82 ;SAVE TRANSMISSION & SEND ERROR MESSAGE
83 I ($D(@ERROR)) D Q:'VDELMSG
84 .;SEND BULLETIN
85 .D XMITERR^VAQBUL05
86 .K @ERROR
87 ;DELETE TRANSMISSION
88 S XMSER="S.VAQ-PDX-SERVER",XMZ=XQMSG
89 D REMSBMSG^XMA1C
90 Q
Note: See TracBrowser for help on using the repository browser.