source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQADM50.m@ 1464

Last change on this file since 1464 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1VAQADM50 ;ALB/JRP - GENERATE PDX TRANSMISSIONS;10-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;**5,35**;NOV 17, 1993
3START ;START RESPONSE TIME MONITORING (TIME TO BUILD/SEND COMPLETE TRANSMISSION)
4 I ($D(XRTL)) D T0^%ZOSV
5 Q
6 ;
7STOP ;STOP RESPONSE TIME MONITORING
8 I ($D(XRT0)) S XRTN=$T(+0) D T1^%ZOSV K XRTN,XRT0
9 Q
10 ;
11GENXMIT ;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
Note: See TracBrowser for help on using the repository browser.