VAQADM50 ;ALB/JRP - GENERATE PDX TRANSMISSIONS;10-MAR-93
;;1.5;PATIENT DATA EXCHANGE;**5,35**;NOV 17, 1993
START ;START RESPONSE TIME MONITORING (TIME TO BUILD/SEND COMPLETE 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
;
GENXMIT ;MAIN ENTRY POINT FOR GENERATING PDX TRANSMISSIONS
;INPUT : VAQTRN - Array of pointers to VAQ - TRANSACTION file
;OUTPUT : None
;NOTE : This module builds/transmits the PDX transmissions, it
; does not prompt the user for information. Messages
; stating any errors that may occur will be sent to the
; current user & the mail group 'VAQ PDX ERRORS'
;
;CHECK INPUT
Q:('$D(VAQTRN))
Q:('$O(VAQTRN("")))
;DECLARE VARIABLES
N ARRAY1,ARRAY2,ARRAY3,ARRAY4,ARRAY5,TMP,XMZ,XMY,TYPE
N TMPARR,XMDUN,DOMAIN,TRANS,SITE,X,ERRNUM,VERSION,LINE,XMCHAN
N DEFENCON,DEFTYPE
S ARRAY1="^TMP(""VAQ-XMIT"","_$J_",""BLD"")"
S ARRAY2="^TMP(""VAQ-XMIT"","_$J_",""DOM"")"
S ARRAY3="^TMP(""VAQ-XMIT"","_$J_",""ERR"")"
S ARRAY4="^TMP(""VAQ-XMIT"","_$J_",""V1.0"")"
S ARRAY5="^TMP(""VAQ-XMIT"","_$J_",""XTRCT"")"
S XMCHAN=1
K @ARRAY1,@ARRAY2,@ARRAY3,@ARRAY4,@ARRAY5
;GET SITE NAME FROM PARAMETER FILE
S TMP=+$O(^VAT(394.81,0))
S SITE=+$G(^VAT(394.81,TMP,0))
S TMP=$P($G(^DIC(4,SITE,0)),"^",1)
I (TMP="") S TMP=$P($$SITE^VASITE,"^",2) S:(TMP=-1) TMP="UNKNOWN"
S SITE=TMP
;DETERMINE DEFAULT ENCRYPTION VALUES
S DEFENCON=0
S DEFTYPE=$$NCRYPTON^VAQUTL2(2)
S:(DEFTYPE'="") DEFENCON=1
;"COMBINE" TRANSMISSIONS TO SAME DOMAIN & SCREEN OUT V1.0 MESSAGES
S TRANS=""
F S TRANS=$O(VAQTRN(TRANS)) Q:('TRANS) D
.I ('$D(^VAT(394.61,TRANS,0))) S @ARRAY3@(TRANS,0)="Transaction does not exist" Q
.;GET VERSION NUMBER
.S VERSION=+$P($G(^VAT(394.61,TRANS,0)),"^",7)
.;GET MESSAGE TYPE
.S TMP=$$STATYPE^VAQCON1(TRANS)
.I ($P(TMP,"^",1)="-1") D Q
..S @ARRAY3@(TRANS,0)="Could not determine message type"
..S @ARRAY3@(TRANS,1)=$P(TMP,"^",2)
.S TYPE=$P(TMP,"^",2)
.S:(TYPE="ACK") TYPE=$P(TMP,"^",1)
.;GET DOMAIN
.S DOMAIN=""
.S:((TYPE="VAQ-UNACK")!(TYPE="REQ")) DOMAIN=$P($G(^VAT(394.61,TRANS,"ATHR2")),"^",2)
.S:((TYPE="RES")!(TYPE="UNS")!(TYPE="VAQ-RQACK")) DOMAIN=$P($G(^VAT(394.61,TRANS,"RQST2")),"^",2)
.I (TYPE="REC") S @ARRAY3@(TRANS,0)="Can not transmit a transaction that is being received" Q
.I (DOMAIN="") S @ARRAY3@(TRANS,0)="Transaction did not contain a domain to transmit message to" Q
.I $$CLOSDOM^VAQUTL97(TRANS,DOMAIN) D Q ; Don't send transactions to closed domains. (And mark such transactions for purging.)
. .S @ARRAY3@(TRANS,0)="Domain is closed: "_DOMAIN
.;SCREEN OUT VERSION 1.0 MESSAGE
.I (VERSION=1) S @ARRAY4@(TRANS)="" Q
.;COMBINE 1.5 MESSAGES TO SAME DOMAIN
.S TMP=$P(DOMAIN,".",1)
.S @ARRAY1@(TMP,TRANS)=""
.S @ARRAY2@(TMP)=DOMAIN
.;FILE ENCRYPTION VALUES FOR REQUESTS & UNSOLICITED PDXS
.I ((TYPE="REQ")!(TYPE="UNS")) D
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,40,$S(DEFENCON:"YES",1:"NO"))
..Q:('DEFENCON)
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,41,DEFTYPE)
;GENERATE & SEND VERSION 1.0 MESSAGES
S TRANS=""
F S TRANS=$O(@ARRAY4@(TRANS)) Q:(TRANS="") D START D D STOP
.S TMP=$$SEND10^VAQCON93(TRANS)
.I (+TMP) D
..S @ARRAY3@(TRANS,0)="Error occurred while building transmission(1)"
..S @ARRAY3@(TRANS,1)=$P(TMP,"^",2)
;GENERATE & SEND VERSION 1.0 MESSAGES
D XMIT15^VAQADM51
;SEND ERROR MESSAGES (IF NEEDED)
I (+$O(@ARRAY3@(""))) D
.D ERR2USR^VAQBUL01
.D ERR2IRM^VAQBUL01
K @ARRAY1,@ARRAY2,@ARRAY3,@ARRAY4,@ARRAY5
S:($D(ZTQUEUED)) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQADM50 3647 printed Apr 09, 2024@21:28:49 Page 2
VAQADM50 ;ALB/JRP - GENERATE PDX TRANSMISSIONS;10-MAR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**5,35**;NOV 17, 1993
START ;START RESPONSE TIME MONITORING (TIME TO BUILD/SEND COMPLETE 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 ;
GENXMIT ;MAIN ENTRY POINT FOR GENERATING PDX TRANSMISSIONS
+1 ;INPUT : VAQTRN - Array of pointers to VAQ - TRANSACTION file
+2 ;OUTPUT : None
+3 ;NOTE : This module builds/transmits the PDX transmissions, it
+4 ; does not prompt the user for information. Messages
+5 ; stating any errors that may occur will be sent to the
+6 ; current user & the mail group 'VAQ PDX ERRORS'
+7 ;
+8 ;CHECK INPUT
+9 if ('$DATA(VAQTRN))
QUIT
+10 if ('$ORDER(VAQTRN("")))
QUIT
+11 ;DECLARE VARIABLES
+12 NEW ARRAY1,ARRAY2,ARRAY3,ARRAY4,ARRAY5,TMP,XMZ,XMY,TYPE
+13 NEW TMPARR,XMDUN,DOMAIN,TRANS,SITE,X,ERRNUM,VERSION,LINE,XMCHAN
+14 NEW DEFENCON,DEFTYPE
+15 SET ARRAY1="^TMP(""VAQ-XMIT"","_$JOB_",""BLD"")"
+16 SET ARRAY2="^TMP(""VAQ-XMIT"","_$JOB_",""DOM"")"
+17 SET ARRAY3="^TMP(""VAQ-XMIT"","_$JOB_",""ERR"")"
+18 SET ARRAY4="^TMP(""VAQ-XMIT"","_$JOB_",""V1.0"")"
+19 SET ARRAY5="^TMP(""VAQ-XMIT"","_$JOB_",""XTRCT"")"
+20 SET XMCHAN=1
+21 KILL @ARRAY1,@ARRAY2,@ARRAY3,@ARRAY4,@ARRAY5
+22 ;GET SITE NAME FROM PARAMETER FILE
+23 SET TMP=+$ORDER(^VAT(394.81,0))
+24 SET SITE=+$GET(^VAT(394.81,TMP,0))
+25 SET TMP=$PIECE($GET(^DIC(4,SITE,0)),"^",1)
+26 IF (TMP="")
SET TMP=$PIECE($$SITE^VASITE,"^",2)
if (TMP=-1)
SET TMP="UNKNOWN"
+27 SET SITE=TMP
+28 ;DETERMINE DEFAULT ENCRYPTION VALUES
+29 SET DEFENCON=0
+30 SET DEFTYPE=$$NCRYPTON^VAQUTL2(2)
+31 if (DEFTYPE'="")
SET DEFENCON=1
+32 ;"COMBINE" TRANSMISSIONS TO SAME DOMAIN & SCREEN OUT V1.0 MESSAGES
+33 SET TRANS=""
+34 FOR
SET TRANS=$ORDER(VAQTRN(TRANS))
if ('TRANS)
QUIT
Begin DoDot:1
+35 IF ('$DATA(^VAT(394.61,TRANS,0)))
SET @ARRAY3@(TRANS,0)="Transaction does not exist"
QUIT
+36 ;GET VERSION NUMBER
+37 SET VERSION=+$PIECE($GET(^VAT(394.61,TRANS,0)),"^",7)
+38 ;GET MESSAGE TYPE
+39 SET TMP=$$STATYPE^VAQCON1(TRANS)
+40 IF ($PIECE(TMP,"^",1)="-1")
Begin DoDot:2
+41 SET @ARRAY3@(TRANS,0)="Could not determine message type"
+42 SET @ARRAY3@(TRANS,1)=$PIECE(TMP,"^",2)
End DoDot:2
QUIT
+43 SET TYPE=$PIECE(TMP,"^",2)
+44 if (TYPE="ACK")
SET TYPE=$PIECE(TMP,"^",1)
+45 ;GET DOMAIN
+46 SET DOMAIN=""
+47 if ((TYPE="VAQ-UNACK")!(TYPE="REQ"))
SET DOMAIN=$PIECE($GET(^VAT(394.61,TRANS,"ATHR2")),"^",2)
+48 if ((TYPE="RES")!(TYPE="UNS")!(TYPE="VAQ-RQACK"))
SET DOMAIN=$PIECE($GET(^VAT(394.61,TRANS,"RQST2")),"^",2)
+49 IF (TYPE="REC")
SET @ARRAY3@(TRANS,0)="Can not transmit a transaction that is being received"
QUIT
+50 IF (DOMAIN="")
SET @ARRAY3@(TRANS,0)="Transaction did not contain a domain to transmit message to"
QUIT
+51 ; Don't send transactions to closed domains. (And mark such transactions for purging.)
IF $$CLOSDOM^VAQUTL97(TRANS,DOMAIN)
Begin DoDot:2
+52 SET @ARRAY3@(TRANS,0)="Domain is closed: "_DOMAIN
End DoDot:2
QUIT
+53 ;SCREEN OUT VERSION 1.0 MESSAGE
+54 IF (VERSION=1)
SET @ARRAY4@(TRANS)=""
QUIT
+55 ;COMBINE 1.5 MESSAGES TO SAME DOMAIN
+56 SET TMP=$PIECE(DOMAIN,".",1)
+57 SET @ARRAY1@(TMP,TRANS)=""
+58 SET @ARRAY2@(TMP)=DOMAIN
+59 ;FILE ENCRYPTION VALUES FOR REQUESTS & UNSOLICITED PDXS
+60 IF ((TYPE="REQ")!(TYPE="UNS"))
Begin DoDot:2
+61 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,40,$SELECT(DEFENCON:"YES",1:"NO"))
+62 if ('DEFENCON)
QUIT
+63 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,41,DEFTYPE)
End DoDot:2
End DoDot:1
+64 ;GENERATE & SEND VERSION 1.0 MESSAGES
+65 SET TRANS=""
+66 FOR
SET TRANS=$ORDER(@ARRAY4@(TRANS))
if (TRANS="")
QUIT
DO START
Begin DoDot:1
+67 SET TMP=$$SEND10^VAQCON93(TRANS)
+68 IF (+TMP)
Begin DoDot:2
+69 SET @ARRAY3@(TRANS,0)="Error occurred while building transmission(1)"
+70 SET @ARRAY3@(TRANS,1)=$PIECE(TMP,"^",2)
End DoDot:2
End DoDot:1
DO STOP
+71 ;GENERATE & SEND VERSION 1.0 MESSAGES
+72 DO XMIT15^VAQADM51
+73 ;SEND ERROR MESSAGES (IF NEEDED)
+74 IF (+$ORDER(@ARRAY3@("")))
Begin DoDot:1
+75 DO ERR2USR^VAQBUL01
+76 DO ERR2IRM^VAQBUL01
End DoDot:1
+77 KILL @ARRAY1,@ARRAY2,@ARRAY3,@ARRAY4,@ARRAY5
+78 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
+79 QUIT
