VAQFIL12 ;ALB/JRP - MESSAGE FILING;12-MAY-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DOMAIN(MESSNUM,PARSARR,TRANPTR) ;FILE DOMAIN BLOCK
;INPUT : MESSNUM - Message number in transmission (not XMZ)
; (defaults to 1)
; PARSARR - Parsing array (full global reference)
; TRANPTR - Pointer to VAQ - TRANSACTION file
; (As defined by MailMan)
; XMFROM, XMREC,XMZ
;OUTPUT : 0 - Success
; -1^Error_Text - Error
;NOTES : It is the responsibility of the calling program to correct
; the transaction being updated if an error occurs.
;
;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,"DOMAIN",1))) "-1^Message did not contain a domain block"
S TRANPTR=+$G(TRANPTR)
Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid transaction"
;DECLARE VARIABLES
N TMP,TYPE,SENDER,RECEIVER,ERR
;MAKE SURE IT'S A DOMAIN BLOCK
S TMP=$G(@PARSARR@(MESSNUM,"DOMAIN",1,1))
S:(TMP=" ") TMP=""
Q:((TMP="")!(TMP'="$DOMAIN")) "-1^Not a domain block"
S TMP=$G(@PARSARR@(MESSNUM,"DOMAIN",1,4))
S:(TMP=" ") TMP=""
Q:((TMP="")!(TMP'="$$DOMAIN")) "-1^Not a valid domain block"
;GET MESSAGE TYPE
S TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR)
Q:($P(TMP,"^",1)="-1") "-1^Could not determine message type"
S TYPE=$P(TMP,"^",2)
;DONE IF ACK OR RETRANSMIT (DOMAINS NOT FILED)
Q:((TYPE="ACK")!(TYPE="RET")) 0
;GET INFO
S SENDER=$G(@PARSARR@(MESSNUM,"DOMAIN",1,2))
S RECEIVER=$G(@PARSARR@(MESSNUM,"DOMAIN",1,3))
;FILE INFORMATION
S ERR=0
;FILE SENDER
S TMP=$S((TYPE="REQ"):31,1:61)
S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,SENDER)
Q:(ERR) "-1^Unable to file sending domain of transmission ("_SENDER_")"
;FILE RECEIVER
S TMP=$S((TYPE="REQ"):61,1:31)
S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,RECEIVER)
Q:(ERR) "-1^Unable to file receiving domain of transmission ("_RECEIVER_")"
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFIL12 2067 printed Dec 13, 2024@02:25:47 Page 2
VAQFIL12 ;ALB/JRP - MESSAGE FILING;12-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DOMAIN(MESSNUM,PARSARR,TRANPTR) ;FILE DOMAIN BLOCK
+1 ;INPUT : MESSNUM - Message number in transmission (not XMZ)
+2 ; (defaults to 1)
+3 ; PARSARR - Parsing array (full global reference)
+4 ; TRANPTR - Pointer to VAQ - TRANSACTION file
+5 ; (As defined by MailMan)
+6 ; XMFROM, XMREC,XMZ
+7 ;OUTPUT : 0 - Success
+8 ; -1^Error_Text - Error
+9 ;NOTES : It is the responsibility of the calling program to correct
+10 ; the transaction being updated if an error occurs.
+11 ;
+12 ;CHECK INPUT
+13 if ($GET(MESSNUM)="")
SET MESSNUM=1
+14 if ($GET(PARSARR)="")
QUIT "-1^Did not pass reference to parsing array"
+15 if ('$DATA(@PARSARR@(MESSNUM)))
QUIT "-1^Did not pass valid message number"
+16 if ('$DATA(@PARSARR@(MESSNUM,"DOMAIN",1)))
QUIT "-1^Message did not contain a domain block"
+17 SET TRANPTR=+$GET(TRANPTR)
+18 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
QUIT "-1^Did not pass a valid transaction"
+19 ;DECLARE VARIABLES
+20 NEW TMP,TYPE,SENDER,RECEIVER,ERR
+21 ;MAKE SURE IT'S A DOMAIN BLOCK
+22 SET TMP=$GET(@PARSARR@(MESSNUM,"DOMAIN",1,1))
+23 if (TMP=" ")
SET TMP=""
+24 if ((TMP="")!(TMP'="$DOMAIN"))
QUIT "-1^Not a domain block"
+25 SET TMP=$GET(@PARSARR@(MESSNUM,"DOMAIN",1,4))
+26 if (TMP=" ")
SET TMP=""
+27 if ((TMP="")!(TMP'="$$DOMAIN"))
QUIT "-1^Not a valid domain block"
+28 ;GET MESSAGE TYPE
+29 SET TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR)
+30 if ($PIECE(TMP,"^",1)="-1")
QUIT "-1^Could not determine message type"
+31 SET TYPE=$PIECE(TMP,"^",2)
+32 ;DONE IF ACK OR RETRANSMIT (DOMAINS NOT FILED)
+33 if ((TYPE="ACK")!(TYPE="RET"))
QUIT 0
+34 ;GET INFO
+35 SET SENDER=$GET(@PARSARR@(MESSNUM,"DOMAIN",1,2))
+36 SET RECEIVER=$GET(@PARSARR@(MESSNUM,"DOMAIN",1,3))
+37 ;FILE INFORMATION
+38 SET ERR=0
+39 ;FILE SENDER
+40 SET TMP=$SELECT((TYPE="REQ"):31,1:61)
+41 SET ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,SENDER)
+42 if (ERR)
QUIT "-1^Unable to file sending domain of transmission ("_SENDER_")"
+43 ;FILE RECEIVER
+44 SET TMP=$SELECT((TYPE="REQ"):61,1:31)
+45 SET ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,RECEIVER)
+46 if (ERR)
QUIT "-1^Unable to file receiving domain of transmission ("_RECEIVER_")"
+47 QUIT 0
