Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQADM2

VAQADM2.m

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