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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQADM2 3074 printed Apr 09, 2024@21:28:57 Page 2
VAQADM2 ;ALB/JRP - MESSAGE ADMINISTRATION;22-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**33**;NOV 17, 1993
START ;START RESPONSE TIME MONITORING (TIME TO PARSE A TRANSMISSION)
+1 IF ($DATA(XRTL))
DO T0^%ZOSV
+2 QUIT
+3 ;
STOP ;STOP RESPONSE TIME MONITORING
+1 IF ($DATA(XRT0))
SET XRTN=$TEXT(+0)
DO T1^%ZOSV
KILL XRTN,XRT0
+2 QUIT
+3 ;
SERVER ;PDX SERVER MAIN ENTRY POINT
+1 ;INPUT : (As defined by MailMan)
+2 ; XMFROM, XMREC, XMZ
+3 ; Actually, XMFROM and XMZ are not defined by MailMan,
+4 ; but by Kernel, in XQSRV* routines, and these variables only
+5 ; exist because this routine is executed immediately. If it
+6 ; were queued, only the following would exist:
+7 ; XQMSG - Msg IEN in file 3.9 (XMZ)
+8 ; XQSND - Msg sender (XMFROM)
+9 ;OUTPUT : None
+10 ;NOTES : Input is not checked (assume existence)
+11 ;
+12 ;CHECK FOR EXISTANCE OF TRANSMISSION
+13 if ('$DATA(^XMB(3.9,XMZ)))
QUIT
+14 ;DECLARE VARIABLES
+15 NEW VERSION,XMER,XMRG,XMPOS,TMP,PARSE,XMSER,XMXX,MESSAGE
+16 NEW TRANS,TYPE,STATUS,ERROR,XMIT,LOCSITE
+17 SET PARSE="^TMP(""VAQ-PARSE"","_$JOB_",""PARSE"","_XMZ_")"
+18 SET ERROR="^TMP(""VAQ-PARSE"","_$JOB_",""ERROR"","_XMZ_")"
+19 SET XMIT="^TMP(""VAQ-PARSE"","_$JOB_",""XMIT"","_XMZ_")"
+20 KILL @PARSE,@ERROR,@XMIT
+21 ;GET LOCAL SITE FROM PARAMETER FILE
+22 SET TMP=+$ORDER(^VAT(394.81,0))
+23 SET LOCSITE=+$GET(^VAT(394.81,TMP,0))
+24 SET TMP=$PIECE($GET(^DIC(4,LOCSITE,0)),"^",1)
+25 IF (TMP="")
SET TMP=$PIECE($$SITE^VASITE,"^",2)
if (TMP=-1)
SET TMP="Local Facility"
+26 SET LOCSITE=TMP
+27 IF $$CLOSED(XQSND)
Begin DoDot:1
+28 SET @ERROR@("GENERAL",1)="Sending domain closed. Message ignored and deleted."
+29 DO CLEANUP(1)
End DoDot:1
QUIT
+30 ;READ FIRST LINE OF TRANSMISSION
+31 SET XMPOS=0
+32 XECUTE XMREC
+33 IF (XMER<0)
Begin DoDot:1
+34 SET @ERROR@("GENERAL",1)="Unable to read first line of message"
+35 DO CLEANUP(1)
End DoDot:1
QUIT
+36 ;DETERMINE PDX VERSION NUMBER
+37 SET TMP=+$PIECE(XMRG,"^",11)
+38 SET VERSION=$SELECT((XMRG="$TRANSMIT"):1.5,((TMP=100)!(TMP=101)!($PIECE(XMRG,"^",1)="ACK")):1,1:0)
+39 IF ('VERSION)
Begin DoDot:1
+40 SET @ERROR@("GENERAL",1)="Unable to determine version of PDX used to generate transmission"
+41 DO CLEANUP(1)
End DoDot:1
QUIT
+42 ;PARSE TRANSMISSION
+43 SET XMPOS=0
+44 IF (VERSION=1)
DO START
Begin DoDot:1
+45 DO PREPRS10^VAQPAR1(PARSE)
+46 if (XMER<0)
QUIT
+47 DO PARSE10^VAQPAR1(PARSE)
End DoDot:1
KILL @PARSE@(1)
DO STOP
+48 IF (VERSION=1.5)
DO START
DO PARSE^VAQPAR6(PARSE)
DO STOP
+49 IF (XMER<0)
Begin DoDot:1
+50 SET @ERROR@("GENERAL",1)="Error occurred while parsing version "_VERSION_" transmission"
+51 SET @ERROR@("GENERAL",2)=$PIECE(XMER,"^",2)
+52 ; was (0) before patch 33
DO CLEANUP(1)
End DoDot:1
QUIT
+53 ;ACT ON MESSAGE
+54 DO ACTIONS^VAQADM21
+55 ;CLEAN UP & QUIT
+56 ; was (0) before patch 33
DO CLEANUP(1)
+57 QUIT
CLOSED(XMFROM) ; Is the domain from which this message was received closed?
+1 ; 1=yes, 0=no
+2 IF XMFROM'["@"
QUIT 0
+3 NEW VIEN
+4 SET VIEN=$$FIND1^DIC(4.2,"","M",$PIECE($PIECE(XMFROM,"@",2),">",1),"B^C")
+5 if 'VIEN
QUIT 0
+6 IF $PIECE(^DIC(4.2,VIEN,0),U,2)["C"
QUIT 1
+7 QUIT 0
+8 ;
CLEANUP(VDELMSG) ;CLEAN UP
+1 ; VDELMSG - Delete message if error? 1=yes; 0=no
+2 ;DELETE PARSING ARRAY
+3 KILL @PARSE,@XMIT
+4 ;SAVE TRANSMISSION & SEND ERROR MESSAGE
+5 IF ($DATA(@ERROR))
Begin DoDot:1
+6 ;SEND BULLETIN
+7 DO XMITERR^VAQBUL05
+8 KILL @ERROR
End DoDot:1
if 'VDELMSG
QUIT
+9 ;DELETE TRANSMISSION
+10 SET XMSER="S.VAQ-PDX-SERVER"
SET XMZ=XQMSG
+11 DO REMSBMSG^XMA1C
+12 QUIT
