VAQADM21 ;ALB/JRP - MESSAGE ADMINISTRATION;20-MAY-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
START ;START RESPONSE TIME MONITORING (TIME TO FILE A SINGLE MESSAGE)
I ($D(XRTL)) D T0^%ZOSV
Q
;
STOP ;STOP RESPONSE TIME MONITORING
I ($D(XRT0)) S XRTN=$T(+0) D T1^%ZOSV K XRTN,XRT0
Q
;
ACTIONS ;ACTIONS FOR PDX SERVER (CONTINUATION FOR VAQADM2)
; DECLARATIONS DONE IN SERVER^VAQADM2
S MESSAGE=""
F S MESSAGE=$O(@PARSE@(MESSAGE)) Q:(MESSAGE="") D START D D STOP
.S TRANS=""
.S STATUS=""
.S TYPE=""
.;FILE HEADER BLOCK
.S XMER=$$HEADER^VAQFIL10(MESSAGE,PARSE)
.I ($P(XMER,"^",1)="-1") S $P(XMER,"^",1)="header" D ERROR Q
.S TRANS=+XMER
.S XMER=$$STATYPE^VAQFIL11(MESSAGE,PARSE)
.I ($P(XMER,"^",1)="-1") S $P(XMER,"^",1)="header" D ERROR Q
.S STATUS=$P(XMER,"^",1)
.S TYPE=$P(XMER,"^",2)
.;FILE DOMAIN BLOCK
.S XMER=$$DOMAIN^VAQFIL12(MESSAGE,PARSE,TRANS)
.I (XMER) S $P(XMER,"^",1)="domain" D ERROR Q
.;DONE IF ACK
.I (TYPE="ACK") D Q
..;FILE STATUS
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
..;RESET PURGE FLAGE
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
.;DONE IF RETRANSMIT
.I (TYPE="RET") D Q
..;FILE STATUS
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
..;RESET PURGE FLAGE
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
..;QUEUE TRANSMISSION
..K @XMIT
..S @XMIT@(TRANS)=""
..S XMER=$$GENTASK^VAQADM5(XMIT) S:(XMER>0) XMER=0
..K @XMIT
..I (XMER) D
...S @ERROR@(MESSAGE,1)="Unable to queue retransmission (IFN: "_TRANS_")"
...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
.;FILE USER BLOCK
.S XMER=$$USER^VAQFIL13(MESSAGE,PARSE,TRANS)
.I (XMER) S $P(XMER,"^",1)="user" D ERROR Q
.;FILE LOCAL FACILITY NAME FOR REQUESTS & UNSOLICITED PDXS RECEIVED
.I (TYPE="REQ") S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,60,LOCSITE)
.I (TYPE="UNS") S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,30,LOCSITE)
.;FILE PATIENT BLOCK
.S XMER=$$PATIENT^VAQFIL15(MESSAGE,PARSE,TRANS)
.I (XMER) S $P(XMER,"^",1)="patient" D ERROR Q
.;FILE SEGMENT BLOCK
.S XMER=$$SEGMENT^VAQFIL16(MESSAGE,PARSE,TRANS)
.I (XMER) S $P(XMER,"^",1)="segment" D ERROR Q
.;DONE IF REQUEST
.I (TYPE="REQ") D Q
..S XMER=$$AUTO^VAQADM22(TRANS)
..I (XMER) D
...S @ERROR@(MESSAGE,1)="Unable to complete automatic processing"
...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
.;FILE COMMENT BLOCK
.S XMER=$$COMMENT^VAQFIL14(MESSAGE,PARSE,TRANS)
.I (XMER) S $P(XMER,"^",1)="comment" D ERROR Q
.;FILE ALL DATA BLOCKS
.S XMER=$$DATA^VAQFIL18(MESSAGE,PARSE,TRANS)
.I (XMER) S $P(XMER,"^",1)="data" D ERROR Q
.;FILE ALL DISPLAY BLOCKS
.S XMER=$$DISPLAY^VAQFIL17(MESSAGE,PARSE,TRANS)
.I (XMER) S $P(XMER,"^",1)="display" D ERROR Q
.;SEND RESULTS RECEIVED BULLETIN
.I (TYPE="RES") D Q
..;FILE STATUS
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
..;RESET PURGE FLAGE
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
..;SEND BULLETIN
..S XMER=$$RESULTS^VAQBUL03(TRANS)
..I (XMER) D
...S @ERROR@(MESSAGE,1)="Unable to send results received bulletin"
...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
...S @ERROR@(MESSAGE,3)="Was able to file transaction (IFN:"_TRANS_")"
.;COMPLETE UNSOLICITED
.I (TYPE="UNS") D Q
..;FILE STATUS
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
..;RESET PURGE FLAGE
..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
..;SEND BULLETIN
..S XMER=$$UNSOL^VAQBUL06(TRANS)
..I (XMER) D
...S @ERROR@(MESSAGE,1)="Unable to send Unsolicited PDX received bulletin"
...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
..;QUEUE ACK
..S XMER=$$FILEINFO^VAQFILE(394.61,TRANS,.05,"VAQ-UNACK")
..I (XMER) D
...S @ERROR@(MESSAGE,5)="Unable to acknowledge receipt of Unsolicited PDX"
...S @ERROR@(MESSAGE,6)=$P(XMER,"^",2)
..K @XMIT
..S @XMIT@(TRANS)=""
..I (('XMER)&(VERSION'=1)) S XMER=$$GENTASK^VAQADM5(XMIT) S:(XMER>0) XMER=0
..K @XMIT
..I (XMER) D
...S @ERROR@(MESSAGE,10)="Unable to queue acknowledgement for receipt of Unsolicited PDX"
...S @ERROR@(MESSAGE,11)=$P(XMER,"^",2)
..S:(+$O(@ERROR@(MESSAGE,""))) @ERROR@(MESSAGE,15)="Was able to file transaction (IFN:"_TRANS_")",XMER="-1^Error completing receipt of Unsolicited PDX"
S XMER=0
Q
;
ERROR ;MAKE ENTRY IN ERROR ARRAY
S @ERROR@(MESSAGE,1)="Error occurred while filing "_$P(XMER,"^",1)_" block"
S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
S XMER=-1
;TRANSACTION NOT CREATED
I ('TRANS) S @ERROR@(MESSAGE,3)="(Transaction was not created)" Q
;DELETE TRANSACTION
S TMP=$$DELTRAN^VAQFILE(TRANS)
S @ERROR@(MESSAGE,3)="Transaction "_$S(TMP:"not ",1:"")_"deleted (IFN: "_TRANS_")"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQADM21 4608 printed Apr 09, 2024@21:27:18 Page 2
VAQADM21 ;ALB/JRP - MESSAGE ADMINISTRATION;20-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
START ;START RESPONSE TIME MONITORING (TIME TO FILE A SINGLE MESSAGE)
+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 ;
ACTIONS ;ACTIONS FOR PDX SERVER (CONTINUATION FOR VAQADM2)
+1 ; DECLARATIONS DONE IN SERVER^VAQADM2
+2 SET MESSAGE=""
+3 FOR
SET MESSAGE=$ORDER(@PARSE@(MESSAGE))
if (MESSAGE="")
QUIT
DO START
Begin DoDot:1
+4 SET TRANS=""
+5 SET STATUS=""
+6 SET TYPE=""
+7 ;FILE HEADER BLOCK
+8 SET XMER=$$HEADER^VAQFIL10(MESSAGE,PARSE)
+9 IF ($PIECE(XMER,"^",1)="-1")
SET $PIECE(XMER,"^",1)="header"
DO ERROR
QUIT
+10 SET TRANS=+XMER
+11 SET XMER=$$STATYPE^VAQFIL11(MESSAGE,PARSE)
+12 IF ($PIECE(XMER,"^",1)="-1")
SET $PIECE(XMER,"^",1)="header"
DO ERROR
QUIT
+13 SET STATUS=$PIECE(XMER,"^",1)
+14 SET TYPE=$PIECE(XMER,"^",2)
+15 ;FILE DOMAIN BLOCK
+16 SET XMER=$$DOMAIN^VAQFIL12(MESSAGE,PARSE,TRANS)
+17 IF (XMER)
SET $PIECE(XMER,"^",1)="domain"
DO ERROR
QUIT
+18 ;DONE IF ACK
+19 IF (TYPE="ACK")
Begin DoDot:2
+20 ;FILE STATUS
+21 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
+22 ;RESET PURGE FLAGE
+23 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
End DoDot:2
QUIT
+24 ;DONE IF RETRANSMIT
+25 IF (TYPE="RET")
Begin DoDot:2
+26 ;FILE STATUS
+27 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
+28 ;RESET PURGE FLAGE
+29 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
+30 ;QUEUE TRANSMISSION
+31 KILL @XMIT
+32 SET @XMIT@(TRANS)=""
+33 SET XMER=$$GENTASK^VAQADM5(XMIT)
if (XMER>0)
SET XMER=0
+34 KILL @XMIT
+35 IF (XMER)
Begin DoDot:3
+36 SET @ERROR@(MESSAGE,1)="Unable to queue retransmission (IFN: "_TRANS_")"
+37 SET @ERROR@(MESSAGE,2)=$PIECE(XMER,"^",2)
End DoDot:3
End DoDot:2
QUIT
+38 ;FILE USER BLOCK
+39 SET XMER=$$USER^VAQFIL13(MESSAGE,PARSE,TRANS)
+40 IF (XMER)
SET $PIECE(XMER,"^",1)="user"
DO ERROR
QUIT
+41 ;FILE LOCAL FACILITY NAME FOR REQUESTS & UNSOLICITED PDXS RECEIVED
+42 IF (TYPE="REQ")
SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,60,LOCSITE)
+43 IF (TYPE="UNS")
SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,30,LOCSITE)
+44 ;FILE PATIENT BLOCK
+45 SET XMER=$$PATIENT^VAQFIL15(MESSAGE,PARSE,TRANS)
+46 IF (XMER)
SET $PIECE(XMER,"^",1)="patient"
DO ERROR
QUIT
+47 ;FILE SEGMENT BLOCK
+48 SET XMER=$$SEGMENT^VAQFIL16(MESSAGE,PARSE,TRANS)
+49 IF (XMER)
SET $PIECE(XMER,"^",1)="segment"
DO ERROR
QUIT
+50 ;DONE IF REQUEST
+51 IF (TYPE="REQ")
Begin DoDot:2
+52 SET XMER=$$AUTO^VAQADM22(TRANS)
+53 IF (XMER)
Begin DoDot:3
+54 SET @ERROR@(MESSAGE,1)="Unable to complete automatic processing"
+55 SET @ERROR@(MESSAGE,2)=$PIECE(XMER,"^",2)
End DoDot:3
End DoDot:2
QUIT
+56 ;FILE COMMENT BLOCK
+57 SET XMER=$$COMMENT^VAQFIL14(MESSAGE,PARSE,TRANS)
+58 IF (XMER)
SET $PIECE(XMER,"^",1)="comment"
DO ERROR
QUIT
+59 ;FILE ALL DATA BLOCKS
+60 SET XMER=$$DATA^VAQFIL18(MESSAGE,PARSE,TRANS)
+61 IF (XMER)
SET $PIECE(XMER,"^",1)="data"
DO ERROR
QUIT
+62 ;FILE ALL DISPLAY BLOCKS
+63 SET XMER=$$DISPLAY^VAQFIL17(MESSAGE,PARSE,TRANS)
+64 IF (XMER)
SET $PIECE(XMER,"^",1)="display"
DO ERROR
QUIT
+65 ;SEND RESULTS RECEIVED BULLETIN
+66 IF (TYPE="RES")
Begin DoDot:2
+67 ;FILE STATUS
+68 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
+69 ;RESET PURGE FLAGE
+70 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
+71 ;SEND BULLETIN
+72 SET XMER=$$RESULTS^VAQBUL03(TRANS)
+73 IF (XMER)
Begin DoDot:3
+74 SET @ERROR@(MESSAGE,1)="Unable to send results received bulletin"
+75 SET @ERROR@(MESSAGE,2)=$PIECE(XMER,"^",2)
+76 SET @ERROR@(MESSAGE,3)="Was able to file transaction (IFN:"_TRANS_")"
End DoDot:3
End DoDot:2
QUIT
+77 ;COMPLETE UNSOLICITED
+78 IF (TYPE="UNS")
Begin DoDot:2
+79 ;FILE STATUS
+80 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
+81 ;RESET PURGE FLAGE
+82 SET TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
+83 ;SEND BULLETIN
+84 SET XMER=$$UNSOL^VAQBUL06(TRANS)
+85 IF (XMER)
Begin DoDot:3
+86 SET @ERROR@(MESSAGE,1)="Unable to send Unsolicited PDX received bulletin"
+87 SET @ERROR@(MESSAGE,2)=$PIECE(XMER,"^",2)
End DoDot:3
+88 ;QUEUE ACK
+89 SET XMER=$$FILEINFO^VAQFILE(394.61,TRANS,.05,"VAQ-UNACK")
+90 IF (XMER)
Begin DoDot:3
+91 SET @ERROR@(MESSAGE,5)="Unable to acknowledge receipt of Unsolicited PDX"
+92 SET @ERROR@(MESSAGE,6)=$PIECE(XMER,"^",2)
End DoDot:3
+93 KILL @XMIT
+94 SET @XMIT@(TRANS)=""
+95 IF (('XMER)&(VERSION'=1))
SET XMER=$$GENTASK^VAQADM5(XMIT)
if (XMER>0)
SET XMER=0
+96 KILL @XMIT
+97 IF (XMER)
Begin DoDot:3
+98 SET @ERROR@(MESSAGE,10)="Unable to queue acknowledgement for receipt of Unsolicited PDX"
+99 SET @ERROR@(MESSAGE,11)=$PIECE(XMER,"^",2)
End DoDot:3
+100 if (+$ORDER(@ERROR@(MESSAGE,"")))
SET @ERROR@(MESSAGE,15)="Was able to file transaction (IFN:"_TRANS_")"
SET XMER="-1^Error completing receipt of Unsolicited PDX"
End DoDot:2
QUIT
End DoDot:1
DO STOP
+101 SET XMER=0
+102 QUIT
+103 ;
ERROR ;MAKE ENTRY IN ERROR ARRAY
+1 SET @ERROR@(MESSAGE,1)="Error occurred while filing "_$PIECE(XMER,"^",1)_" block"
+2 SET @ERROR@(MESSAGE,2)=$PIECE(XMER,"^",2)
+3 SET XMER=-1
+4 ;TRANSACTION NOT CREATED
+5 IF ('TRANS)
SET @ERROR@(MESSAGE,3)="(Transaction was not created)"
QUIT
+6 ;DELETE TRANSACTION
+7 SET TMP=$$DELTRAN^VAQFILE(TRANS)
+8 SET @ERROR@(MESSAGE,3)="Transaction "_$SELECT(TMP:"not ",1:"")_"deleted (IFN: "_TRANS_")"
+9 QUIT
