| 1 | VAQADM21 ;ALB/JRP - MESSAGE ADMINISTRATION;20-MAY-93
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
---|
| 3 | START ;START RESPONSE TIME MONITORING (TIME TO FILE A SINGLE MESSAGE)
|
---|
| 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 | ACTIONS ;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 | ;
|
---|
| 115 | ERROR ;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
|
---|