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