| [613] | 1 | VAQFIL10 ;ALB/JRP - MESSAGE FILING;12-MAY-93
 | 
|---|
 | 2 |  ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
 | 
|---|
 | 3 | HEADER(MESSNUM,PARSARR) ;FILE HEADER BLOCK
 | 
|---|
 | 4 |  ;INPUT  : MESSNUM - Message number in transmission (not XMZ)
 | 
|---|
 | 5 |  ;                   (defaults to 1)
 | 
|---|
 | 6 |  ;         PARSARR - Parsing array (full global reference)
 | 
|---|
 | 7 |  ;         (As defined by MailMan)
 | 
|---|
 | 8 |  ;         XMFROM, XMREC,XMZ
 | 
|---|
 | 9 |  ;OUTPUT : N^New_Flag - Success
 | 
|---|
 | 10 |  ;                      N = Transaction the header was filed in
 | 
|---|
 | 11 |  ;               New_Flag = 1 if a new transaction was created
 | 
|---|
 | 12 |  ;                        = 0 if an existing transaction was used
 | 
|---|
 | 13 |  ;         -1^Error_Text - Error
 | 
|---|
 | 14 |  ;NOTES  : If a new transaction is created and an error occurs, the
 | 
|---|
 | 15 |  ;         new transaction will be deleted.
 | 
|---|
 | 16 |  ;       : If an existing transaction is updated and an error occurs,
 | 
|---|
 | 17 |  ;         it is the responsibility of the calling program to correct
 | 
|---|
 | 18 |  ;         the transaction.
 | 
|---|
 | 19 |  ;
 | 
|---|
 | 20 |  ;CHECK INPUT
 | 
|---|
 | 21 |  S:($G(MESSNUM)="") MESSNUM=1
 | 
|---|
 | 22 |  Q:($G(PARSARR)="") "-1^Did not pass reference to parsing array"
 | 
|---|
 | 23 |  Q:('$D(@PARSARR@(MESSNUM))) "-1^Did not pass valid message number"
 | 
|---|
 | 24 |  Q:('$D(@PARSARR@(MESSNUM,"HEADER",1))) "-1^Message did not contain a header block"
 | 
|---|
 | 25 |  ;DECLARE VARIABLES
 | 
|---|
 | 26 |  N TMP,TYPE,STATUS,VERSION,DATETIME,MESSXMZ,TRANSNUM,ENCMTHD
 | 
|---|
 | 27 |  N TRANPTR,ERR,NEWTRAN
 | 
|---|
 | 28 |  S NEWTRAN=0
 | 
|---|
 | 29 |  ;MAKE SURE IT'S A HEADER BLOCK
 | 
|---|
 | 30 |  S TMP=$G(@PARSARR@(MESSNUM,"HEADER",1,1))
 | 
|---|
 | 31 |  S:(TMP=" ") TMP=""
 | 
|---|
 | 32 |  Q:((TMP="")!(TMP'="$HEADER")) "-1^Not a header block"
 | 
|---|
 | 33 |  S TMP=$G(@PARSARR@(MESSNUM,"HEADER",1,9))
 | 
|---|
 | 34 |  S:(TMP=" ") TMP=""
 | 
|---|
 | 35 |  Q:((TMP="")!(TMP'="$$HEADER")) "-1^Not a valid header block"
 | 
|---|
 | 36 |  ;GET MESSAGE TYPE
 | 
|---|
 | 37 |  S TYPE=$G(@PARSARR@(MESSNUM,"HEADER",1,2))
 | 
|---|
 | 38 |  S:(TYPE=" ") TYPE=""
 | 
|---|
 | 39 |  Q:(TYPE="") "-1^Header did not contain message type"
 | 
|---|
 | 40 |  S TMP="^REQ^RES^UNS^ACK^RET^"
 | 
|---|
 | 41 |  Q:(TMP'[("^"_TYPE_"^")) "-1^Header did not contain valid message type"
 | 
|---|
 | 42 |  ;GET STATUS
 | 
|---|
 | 43 |  S STATUS=$G(@PARSARR@(MESSNUM,"HEADER",1,3))
 | 
|---|
 | 44 |  S:(STATUS=" ") STATUS=""
 | 
|---|
 | 45 |  Q:(STATUS="") "-1^Header did not contain status"
 | 
|---|
 | 46 |  S TMP="^VAQ-AMBIG^VAQ-NTFND^VAQ-REJ^VAQ-RQACK^VAQ-RQST^VAQ-RSLT^VAQ-RTRNS^VAQ-UNACK^VAQ-UNSOL^"
 | 
|---|
 | 47 |  Q:(TMP'[("^"_STATUS_"^")) "-1^Header did not contain valid status"
 | 
|---|
 | 48 |  ;GET VERSION NUMBER (DEFAULTS TO 1.5)
 | 
|---|
 | 49 |  S VERSION=$G(@PARSARR@(MESSNUM,"HEADER",1,4))
 | 
|---|
 | 50 |  S:(VERSION=" ") VERSION=""
 | 
|---|
 | 51 |  S:(VERSION="") VERSION=1.5
 | 
|---|
 | 52 |  ;GET DATE/TIME OF TRANSMISSION (DEFAULT TO NOW)
 | 
|---|
 | 53 |  S DATETIME=$G(@PARSARR@(MESSNUM,"HEADER",1,5))
 | 
|---|
 | 54 |  S:(DATETIME=" ") DATETIME=""
 | 
|---|
 | 55 |  I (DATETIME="") S DATETIME=$$NOW^VAQUTL99() Q:($P(DATETIME,"^",1)="-1") "-1^Could not determine transmission time of message"
 | 
|---|
 | 56 |  ;CHECK DATE/TIME FOR CORRECTNESS
 | 
|---|
 | 57 |  S DATETIME=$$CHCKDT^VAQUTL95(DATETIME)
 | 
|---|
 | 58 |  Q:(DATETIME="-1") "-1^Could not determine transmission time of message"
 | 
|---|
 | 59 |  ;GET MESSXMZ OF MESSAGE (DEFAULTS TO XMZ)
 | 
|---|
 | 60 |  S MESSXMZ=$G(@PARSARR@(MESSNUM,"HEADER",1,6))
 | 
|---|
 | 61 |  S:(MESSXMZ=" ") MESSXMZ=""
 | 
|---|
 | 62 |  S:(MESSXMZ="") MESSXMZ=$G(XMZ)
 | 
|---|
 | 63 |  ;GET TRANSACTION NUMBER
 | 
|---|
 | 64 |  S TRANSNUM=$G(@PARSARR@(MESSNUM,"HEADER",1,7))
 | 
|---|
 | 65 |  S:(TRANSNUM=" ") TRANSNUM=""
 | 
|---|
 | 66 |  Q:((TRANSNUM="")&(VERSION'=1)) "-1^Transaction number not passed in header block"
 | 
|---|
 | 67 |  ;GET ENCRYPTION METHOD
 | 
|---|
 | 68 |  S ENCMTHD=$G(@PARSARR@(MESSNUM,"HEADER",1,8))
 | 
|---|
 | 69 |  S:(ENCMTHD=" ") ENCMTHD=""
 | 
|---|
 | 70 |  I (ENCMTHD'="") Q:('$D(^VAT(394.72,"B",ENCMTHD))) "-1^Encryption method used not supported at this facility"
 | 
|---|
 | 71 |  ;MAKE ENTRY IN TRANSACTION FILE
 | 
|---|
 | 72 |  I ((TYPE="REQ")!(TYPE="UNS")) D  Q:((+TRANPTR)<0) "-1^Unable to create entry in transaction file"
 | 
|---|
 | 73 |  .S NEWTRAN=1
 | 
|---|
 | 74 |  .S TRANPTR=$$NEWTRAN^VAQFILE
 | 
|---|
 | 75 |  .Q:((+TRANPTR)<0)
 | 
|---|
 | 76 |  .S TRANPTR=+TRANPTR
 | 
|---|
 | 77 |  ;FIND ENTRY IN TRANSACTION FILE
 | 
|---|
 | 78 |  I ((TYPE="RES")!(TYPE="ACK")!(TYPE="RET")) D  Q:('TRANPTR) "-1^Could not find entry in transaction file"
 | 
|---|
 | 79 |  .S TRANPTR=+$O(^VAT(394.61,"B",TRANSNUM,""))
 | 
|---|
 | 80 |  Q:('$G(TRANPTR)) "-1^Unable to create/find entry in transaction file"
 | 
|---|
 | 81 |  ;FILE INFORMATION
 | 
|---|
 | 82 |  S ERR=0
 | 
|---|
 | 83 |  D HEADER^VAQFIL11
 | 
|---|
 | 84 |  Q:(ERR) ERR
 | 
|---|
 | 85 |  Q TRANPTR_"^"_NEWTRAN
 | 
|---|