source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQADM21.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1VAQADM21 ;ALB/JRP - MESSAGE ADMINISTRATION;20-MAY-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3START ;START RESPONSE TIME MONITORING (TIME TO FILE A SINGLE MESSAGE)
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 ;
11ACTIONS ;ACTIONS FOR PDX SERVER (CONTINUATION FOR VAQADM2)
12 ; DECLARATIONS DONE IN SERVER^VAQADM2
13 S MESSAGE=""
14 F S MESSAGE=$O(@PARSE@(MESSAGE)) Q:(MESSAGE="") D START D D STOP
15 .S TRANS=""
16 .S STATUS=""
17 .S TYPE=""
18 .;FILE HEADER BLOCK
19 .S XMER=$$HEADER^VAQFIL10(MESSAGE,PARSE)
20 .I ($P(XMER,"^",1)="-1") S $P(XMER,"^",1)="header" D ERROR Q
21 .S TRANS=+XMER
22 .S XMER=$$STATYPE^VAQFIL11(MESSAGE,PARSE)
23 .I ($P(XMER,"^",1)="-1") S $P(XMER,"^",1)="header" D ERROR Q
24 .S STATUS=$P(XMER,"^",1)
25 .S TYPE=$P(XMER,"^",2)
26 .;FILE DOMAIN BLOCK
27 .S XMER=$$DOMAIN^VAQFIL12(MESSAGE,PARSE,TRANS)
28 .I (XMER) S $P(XMER,"^",1)="domain" D ERROR Q
29 .;DONE IF ACK
30 .I (TYPE="ACK") D Q
31 ..;FILE STATUS
32 ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
33 ..;RESET PURGE FLAGE
34 ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
35 .;DONE IF RETRANSMIT
36 .I (TYPE="RET") D Q
37 ..;FILE STATUS
38 ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
39 ..;RESET PURGE FLAGE
40 ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
41 ..;QUEUE TRANSMISSION
42 ..K @XMIT
43 ..S @XMIT@(TRANS)=""
44 ..S XMER=$$GENTASK^VAQADM5(XMIT) S:(XMER>0) XMER=0
45 ..K @XMIT
46 ..I (XMER) D
47 ...S @ERROR@(MESSAGE,1)="Unable to queue retransmission (IFN: "_TRANS_")"
48 ...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
49 .;FILE USER BLOCK
50 .S XMER=$$USER^VAQFIL13(MESSAGE,PARSE,TRANS)
51 .I (XMER) S $P(XMER,"^",1)="user" D ERROR Q
52 .;FILE LOCAL FACILITY NAME FOR REQUESTS & UNSOLICITED PDXS RECEIVED
53 .I (TYPE="REQ") S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,60,LOCSITE)
54 .I (TYPE="UNS") S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,30,LOCSITE)
55 .;FILE PATIENT BLOCK
56 .S XMER=$$PATIENT^VAQFIL15(MESSAGE,PARSE,TRANS)
57 .I (XMER) S $P(XMER,"^",1)="patient" D ERROR Q
58 .;FILE SEGMENT BLOCK
59 .S XMER=$$SEGMENT^VAQFIL16(MESSAGE,PARSE,TRANS)
60 .I (XMER) S $P(XMER,"^",1)="segment" D ERROR Q
61 .;DONE IF REQUEST
62 .I (TYPE="REQ") D Q
63 ..S XMER=$$AUTO^VAQADM22(TRANS)
64 ..I (XMER) D
65 ...S @ERROR@(MESSAGE,1)="Unable to complete automatic processing"
66 ...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
67 .;FILE COMMENT BLOCK
68 .S XMER=$$COMMENT^VAQFIL14(MESSAGE,PARSE,TRANS)
69 .I (XMER) S $P(XMER,"^",1)="comment" D ERROR Q
70 .;FILE ALL DATA BLOCKS
71 .S XMER=$$DATA^VAQFIL18(MESSAGE,PARSE,TRANS)
72 .I (XMER) S $P(XMER,"^",1)="data" D ERROR Q
73 .;FILE ALL DISPLAY BLOCKS
74 .S XMER=$$DISPLAY^VAQFIL17(MESSAGE,PARSE,TRANS)
75 .I (XMER) S $P(XMER,"^",1)="display" D ERROR Q
76 .;SEND RESULTS RECEIVED BULLETIN
77 .I (TYPE="RES") D Q
78 ..;FILE STATUS
79 ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
80 ..;RESET PURGE FLAGE
81 ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
82 ..;SEND BULLETIN
83 ..S XMER=$$RESULTS^VAQBUL03(TRANS)
84 ..I (XMER) D
85 ...S @ERROR@(MESSAGE,1)="Unable to send results received bulletin"
86 ...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
87 ...S @ERROR@(MESSAGE,3)="Was able to file transaction (IFN:"_TRANS_")"
88 .;COMPLETE UNSOLICITED
89 .I (TYPE="UNS") D Q
90 ..;FILE STATUS
91 ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
92 ..;RESET PURGE FLAGE
93 ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
94 ..;SEND BULLETIN
95 ..S XMER=$$UNSOL^VAQBUL06(TRANS)
96 ..I (XMER) D
97 ...S @ERROR@(MESSAGE,1)="Unable to send Unsolicited PDX received bulletin"
98 ...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
99 ..;QUEUE ACK
100 ..S XMER=$$FILEINFO^VAQFILE(394.61,TRANS,.05,"VAQ-UNACK")
101 ..I (XMER) D
102 ...S @ERROR@(MESSAGE,5)="Unable to acknowledge receipt of Unsolicited PDX"
103 ...S @ERROR@(MESSAGE,6)=$P(XMER,"^",2)
104 ..K @XMIT
105 ..S @XMIT@(TRANS)=""
106 ..I (('XMER)&(VERSION'=1)) S XMER=$$GENTASK^VAQADM5(XMIT) S:(XMER>0) XMER=0
107 ..K @XMIT
108 ..I (XMER) D
109 ...S @ERROR@(MESSAGE,10)="Unable to queue acknowledgement for receipt of Unsolicited PDX"
110 ...S @ERROR@(MESSAGE,11)=$P(XMER,"^",2)
111 ..S:(+$O(@ERROR@(MESSAGE,""))) @ERROR@(MESSAGE,15)="Was able to file transaction (IFN:"_TRANS_")",XMER="-1^Error completing receipt of Unsolicited PDX"
112 S XMER=0
113 Q
114 ;
115ERROR ;MAKE ENTRY IN ERROR ARRAY
116 S @ERROR@(MESSAGE,1)="Error occurred while filing "_$P(XMER,"^",1)_" block"
117 S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
118 S XMER=-1
119 ;TRANSACTION NOT CREATED
120 I ('TRANS) S @ERROR@(MESSAGE,3)="(Transaction was not created)" Q
121 ;DELETE TRANSACTION
122 S TMP=$$DELTRAN^VAQFILE(TRANS)
123 S @ERROR@(MESSAGE,3)="Transaction "_$S(TMP:"not ",1:"")_"deleted (IFN: "_TRANS_")"
124 Q
Note: See TracBrowser for help on using the repository browser.