- 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 Feb 18, 2025@23:51:50 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