91 lines
2.9 KiB
Mathematica
91 lines
2.9 KiB
Mathematica
VAQADM2 ;ALB/JRP - MESSAGE ADMINISTRATION;22-APR-93
|
|
;;1.5;PATIENT DATA EXCHANGE;**33**;NOV 17, 1993
|
|
START ;START RESPONSE TIME MONITORING (TIME TO PARSE A TRANSMISSION)
|
|
I ($D(XRTL)) D T0^%ZOSV
|
|
Q
|
|
;
|
|
STOP ;STOP RESPONSE TIME MONITORING
|
|
I ($D(XRT0)) S XRTN=$T(+0) D T1^%ZOSV K XRTN,XRT0
|
|
Q
|
|
;
|
|
SERVER ;PDX SERVER MAIN ENTRY POINT
|
|
;INPUT : (As defined by MailMan)
|
|
; XMFROM, XMREC, XMZ
|
|
; Actually, XMFROM and XMZ are not defined by MailMan,
|
|
; but by Kernel, in XQSRV* routines, and these variables only
|
|
; exist because this routine is executed immediately. If it
|
|
; were queued, only the following would exist:
|
|
; XQMSG - Msg IEN in file 3.9 (XMZ)
|
|
; XQSND - Msg sender (XMFROM)
|
|
;OUTPUT : None
|
|
;NOTES : Input is not checked (assume existence)
|
|
;
|
|
;CHECK FOR EXISTANCE OF TRANSMISSION
|
|
Q:('$D(^XMB(3.9,XMZ)))
|
|
;DECLARE VARIABLES
|
|
N VERSION,XMER,XMRG,XMPOS,TMP,PARSE,XMSER,XMXX,MESSAGE
|
|
N TRANS,TYPE,STATUS,ERROR,XMIT,LOCSITE
|
|
S PARSE="^TMP(""VAQ-PARSE"","_$J_",""PARSE"","_XMZ_")"
|
|
S ERROR="^TMP(""VAQ-PARSE"","_$J_",""ERROR"","_XMZ_")"
|
|
S XMIT="^TMP(""VAQ-PARSE"","_$J_",""XMIT"","_XMZ_")"
|
|
K @PARSE,@ERROR,@XMIT
|
|
;GET LOCAL SITE FROM PARAMETER FILE
|
|
S TMP=+$O(^VAT(394.81,0))
|
|
S LOCSITE=+$G(^VAT(394.81,TMP,0))
|
|
S TMP=$P($G(^DIC(4,LOCSITE,0)),"^",1)
|
|
I (TMP="") S TMP=$P($$SITE^VASITE,"^",2) S:(TMP=-1) TMP="Local Facility"
|
|
S LOCSITE=TMP
|
|
I $$CLOSED(XQSND) D Q
|
|
.S @ERROR@("GENERAL",1)="Sending domain closed. Message ignored and deleted."
|
|
.D CLEANUP(1)
|
|
;READ FIRST LINE OF TRANSMISSION
|
|
S XMPOS=0
|
|
X XMREC
|
|
I (XMER<0) D Q
|
|
.S @ERROR@("GENERAL",1)="Unable to read first line of message"
|
|
.D CLEANUP(1)
|
|
;DETERMINE PDX VERSION NUMBER
|
|
S TMP=+$P(XMRG,"^",11)
|
|
S VERSION=$S((XMRG="$TRANSMIT"):1.5,((TMP=100)!(TMP=101)!($P(XMRG,"^",1)="ACK")):1,1:0)
|
|
I ('VERSION) D Q
|
|
.S @ERROR@("GENERAL",1)="Unable to determine version of PDX used to generate transmission"
|
|
.D CLEANUP(1)
|
|
;PARSE TRANSMISSION
|
|
S XMPOS=0
|
|
I (VERSION=1) D START D K @PARSE@(1) D STOP
|
|
.D PREPRS10^VAQPAR1(PARSE)
|
|
.Q:(XMER<0)
|
|
.D PARSE10^VAQPAR1(PARSE)
|
|
I (VERSION=1.5) D START D PARSE^VAQPAR6(PARSE) D STOP
|
|
I (XMER<0) D Q
|
|
.S @ERROR@("GENERAL",1)="Error occurred while parsing version "_VERSION_" transmission"
|
|
.S @ERROR@("GENERAL",2)=$P(XMER,"^",2)
|
|
.D CLEANUP(1) ; was (0) before patch 33
|
|
;ACT ON MESSAGE
|
|
D ACTIONS^VAQADM21
|
|
;CLEAN UP & QUIT
|
|
D CLEANUP(1) ; was (0) before patch 33
|
|
Q
|
|
CLOSED(XMFROM) ; Is the domain from which this message was received closed?
|
|
; 1=yes, 0=no
|
|
I XMFROM'["@" Q 0
|
|
N VIEN
|
|
S VIEN=$$FIND1^DIC(4.2,"","M",$P($P(XMFROM,"@",2),">",1),"B^C")
|
|
Q:'VIEN 0
|
|
I $P(^DIC(4.2,VIEN,0),U,2)["C" Q 1
|
|
Q 0
|
|
;
|
|
CLEANUP(VDELMSG) ;CLEAN UP
|
|
; VDELMSG - Delete message if error? 1=yes; 0=no
|
|
;DELETE PARSING ARRAY
|
|
K @PARSE,@XMIT
|
|
;SAVE TRANSMISSION & SEND ERROR MESSAGE
|
|
I ($D(@ERROR)) D Q:'VDELMSG
|
|
.;SEND BULLETIN
|
|
.D XMITERR^VAQBUL05
|
|
.K @ERROR
|
|
;DELETE TRANSMISSION
|
|
S XMSER="S.VAQ-PDX-SERVER",XMZ=XQMSG
|
|
D REMSBMSG^XMA1C
|
|
Q
|