- 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 Mar 13, 2025@21:30:14 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
