- 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 Jan 18, 2025@03:25:07 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