Routine: VAQADM50

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

STOP ;STOP RESPONSE TIME MONITORING

 I ($D(XRT0)) S XRTN=$T(+0) D T1^%ZOSV K XRTN,XRT0

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="@"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQADM50   3647     printed  Apr 23, 2025@18:38:31                                                                                                                                                                                                    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

VAQADM50.m