source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQADM2.m@ 1464

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