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