Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQADM21

VAQADM21.m

Go to the documentation of this file.
  1. VAQADM21 ;ALB/JRP - MESSAGE ADMINISTRATION;20-MAY-93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. START ;START RESPONSE TIME MONITORING (TIME TO FILE A SINGLE MESSAGE)
  1. I ($D(XRTL)) D T0^%ZOSV
  1. Q
  1. ;
  1. STOP ;STOP RESPONSE TIME MONITORING
  1. I ($D(XRT0)) S XRTN=$T(+0) D T1^%ZOSV K XRTN,XRT0
  1. Q
  1. ;
  1. ACTIONS ;ACTIONS FOR PDX SERVER (CONTINUATION FOR VAQADM2)
  1. ; DECLARATIONS DONE IN SERVER^VAQADM2
  1. S MESSAGE=""
  1. F S MESSAGE=$O(@PARSE@(MESSAGE)) Q:(MESSAGE="") D START D D STOP
  1. .S TRANS=""
  1. .S STATUS=""
  1. .S TYPE=""
  1. .;FILE HEADER BLOCK
  1. .S XMER=$$HEADER^VAQFIL10(MESSAGE,PARSE)
  1. .I ($P(XMER,"^",1)="-1") S $P(XMER,"^",1)="header" D ERROR Q
  1. .S TRANS=+XMER
  1. .S XMER=$$STATYPE^VAQFIL11(MESSAGE,PARSE)
  1. .I ($P(XMER,"^",1)="-1") S $P(XMER,"^",1)="header" D ERROR Q
  1. .S STATUS=$P(XMER,"^",1)
  1. .S TYPE=$P(XMER,"^",2)
  1. .;FILE DOMAIN BLOCK
  1. .S XMER=$$DOMAIN^VAQFIL12(MESSAGE,PARSE,TRANS)
  1. .I (XMER) S $P(XMER,"^",1)="domain" D ERROR Q
  1. .;DONE IF ACK
  1. .I (TYPE="ACK") D Q
  1. ..;FILE STATUS
  1. ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
  1. ..;RESET PURGE FLAGE
  1. ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
  1. .;DONE IF RETRANSMIT
  1. .I (TYPE="RET") D Q
  1. ..;FILE STATUS
  1. ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
  1. ..;RESET PURGE FLAGE
  1. ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
  1. ..;QUEUE TRANSMISSION
  1. ..K @XMIT
  1. ..S @XMIT@(TRANS)=""
  1. ..S XMER=$$GENTASK^VAQADM5(XMIT) S:(XMER>0) XMER=0
  1. ..K @XMIT
  1. ..I (XMER) D
  1. ...S @ERROR@(MESSAGE,1)="Unable to queue retransmission (IFN: "_TRANS_")"
  1. ...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
  1. .;FILE USER BLOCK
  1. .S XMER=$$USER^VAQFIL13(MESSAGE,PARSE,TRANS)
  1. .I (XMER) S $P(XMER,"^",1)="user" D ERROR Q
  1. .;FILE LOCAL FACILITY NAME FOR REQUESTS & UNSOLICITED PDXS RECEIVED
  1. .I (TYPE="REQ") S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,60,LOCSITE)
  1. .I (TYPE="UNS") S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,30,LOCSITE)
  1. .;FILE PATIENT BLOCK
  1. .S XMER=$$PATIENT^VAQFIL15(MESSAGE,PARSE,TRANS)
  1. .I (XMER) S $P(XMER,"^",1)="patient" D ERROR Q
  1. .;FILE SEGMENT BLOCK
  1. .S XMER=$$SEGMENT^VAQFIL16(MESSAGE,PARSE,TRANS)
  1. .I (XMER) S $P(XMER,"^",1)="segment" D ERROR Q
  1. .;DONE IF REQUEST
  1. .I (TYPE="REQ") D Q
  1. ..S XMER=$$AUTO^VAQADM22(TRANS)
  1. ..I (XMER) D
  1. ...S @ERROR@(MESSAGE,1)="Unable to complete automatic processing"
  1. ...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
  1. .;FILE COMMENT BLOCK
  1. .S XMER=$$COMMENT^VAQFIL14(MESSAGE,PARSE,TRANS)
  1. .I (XMER) S $P(XMER,"^",1)="comment" D ERROR Q
  1. .;FILE ALL DATA BLOCKS
  1. .S XMER=$$DATA^VAQFIL18(MESSAGE,PARSE,TRANS)
  1. .I (XMER) S $P(XMER,"^",1)="data" D ERROR Q
  1. .;FILE ALL DISPLAY BLOCKS
  1. .S XMER=$$DISPLAY^VAQFIL17(MESSAGE,PARSE,TRANS)
  1. .I (XMER) S $P(XMER,"^",1)="display" D ERROR Q
  1. .;SEND RESULTS RECEIVED BULLETIN
  1. .I (TYPE="RES") D Q
  1. ..;FILE STATUS
  1. ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
  1. ..;RESET PURGE FLAGE
  1. ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
  1. ..;SEND BULLETIN
  1. ..S XMER=$$RESULTS^VAQBUL03(TRANS)
  1. ..I (XMER) D
  1. ...S @ERROR@(MESSAGE,1)="Unable to send results received bulletin"
  1. ...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
  1. ...S @ERROR@(MESSAGE,3)="Was able to file transaction (IFN:"_TRANS_")"
  1. .;COMPLETE UNSOLICITED
  1. .I (TYPE="UNS") D Q
  1. ..;FILE STATUS
  1. ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,.02,STATUS)
  1. ..;RESET PURGE FLAGE
  1. ..S TMP=$$FILEINFO^VAQFILE(394.61,TRANS,90,"NO")
  1. ..;SEND BULLETIN
  1. ..S XMER=$$UNSOL^VAQBUL06(TRANS)
  1. ..I (XMER) D
  1. ...S @ERROR@(MESSAGE,1)="Unable to send Unsolicited PDX received bulletin"
  1. ...S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
  1. ..;QUEUE ACK
  1. ..S XMER=$$FILEINFO^VAQFILE(394.61,TRANS,.05,"VAQ-UNACK")
  1. ..I (XMER) D
  1. ...S @ERROR@(MESSAGE,5)="Unable to acknowledge receipt of Unsolicited PDX"
  1. ...S @ERROR@(MESSAGE,6)=$P(XMER,"^",2)
  1. ..K @XMIT
  1. ..S @XMIT@(TRANS)=""
  1. ..I (('XMER)&(VERSION'=1)) S XMER=$$GENTASK^VAQADM5(XMIT) S:(XMER>0) XMER=0
  1. ..K @XMIT
  1. ..I (XMER) D
  1. ...S @ERROR@(MESSAGE,10)="Unable to queue acknowledgement for receipt of Unsolicited PDX"
  1. ...S @ERROR@(MESSAGE,11)=$P(XMER,"^",2)
  1. ..S:(+$O(@ERROR@(MESSAGE,""))) @ERROR@(MESSAGE,15)="Was able to file transaction (IFN:"_TRANS_")",XMER="-1^Error completing receipt of Unsolicited PDX"
  1. S XMER=0
  1. Q
  1. ;
  1. ERROR ;MAKE ENTRY IN ERROR ARRAY
  1. S @ERROR@(MESSAGE,1)="Error occurred while filing "_$P(XMER,"^",1)_" block"
  1. S @ERROR@(MESSAGE,2)=$P(XMER,"^",2)
  1. S XMER=-1
  1. ;TRANSACTION NOT CREATED
  1. I ('TRANS) S @ERROR@(MESSAGE,3)="(Transaction was not created)" Q
  1. ;DELETE TRANSACTION
  1. S TMP=$$DELTRAN^VAQFILE(TRANS)
  1. S @ERROR@(MESSAGE,3)="Transaction "_$S(TMP:"not ",1:"")_"deleted (IFN: "_TRANS_")"
  1. Q