- 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 Jan 18, 2025@03:25:08 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