VAQFIL13 ;ALB/JRP - MESSAGE FILING;12-MAY-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
USER(MESSNUM,PARSARR,TRANPTR) ;FILE USER 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,"USER",1))) "-1^Message did not contain a user block"
S TRANPTR=+$G(TRANPTR)
Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid transaction"
;DECLARE VARIABLES
N TMP,TYPE,USERNAME,USERSITE,ERR
;MAKE SURE IT'S A USER BLOCK
S TMP=$G(@PARSARR@(MESSNUM,"USER",1,1))
S:(TMP=" ") TMP=""
Q:((TMP="")!(TMP'="$USER")) "-1^Not a user block"
S TMP=$G(@PARSARR@(MESSNUM,"USER",1,5))
S:(TMP=" ") TMP=""
Q:((TMP="")!(TMP'="$$USER")) "-1^Not a valid user 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)
;ACK OR RETRANSMIT DON'T HAVE USER BLOCKS
Q:((TYPE="ACK")!(TYPE="RET")) "-1^Message type does not require user block"
;GET INFO
S USERNAME=$G(@PARSARR@(MESSNUM,"USER",1,2))
S:(USERNAME=" ") USERNAME=""
S USERSITE=$G(@PARSARR@(MESSNUM,"USER",1,4))
S:(USERSITE=" ") USERSITE=""
;FILE INFORMATION
S ERR=0
;FILE NAME
S TMP=$S((TYPE="REQ"):21,1:51)
S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,USERNAME)
Q:(ERR) "-1^Unable to file sender of transmission ("_USERNAME_")"
;FILE SITE
S TMP=$S((TYPE="REQ"):30,1:60)
S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,USERSITE)
Q:(ERR) "-1^Unable to file sending facility of transmission ("_USERSITE_")"
Q 0
;
SENDER(MESSNUM,PARSARR) ;RETURN SENDER OF PARSED MESSAGE
;INPUT : MESSNUM - Message number in transmission (not XMZ)
; (defaults to 1)
; PARSARR - Parsing array (full global reference)
;OUTPUT : Name^DUZ - Success
; -1^Error_Text - Error
;
;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,"USER",1))) "-1^Message did not contain a user block"
;DECLARE VARIABLES
N USERNAME,USERDUZ
S USERNAME=$G(@PARSARR@(MESSNUM,"USER",1,2))
S:(USERNAME=" ") USERNAME=""
Q:(USERNAME="") "-1^Could not determine sender of message"
S USERDUZ=$G(@PARSARR@(MESSNUM,"USER",1,3))
S:(USERDUZ=" ") USERDUZ=""
Q:(USERDUZ="") "-1^Could not determine sender of message"
Q USERNAME_"^"_USERDUZ
;
KEY(MESSNUM,PARSARR,PRIME) ;RETURN SENDER OF PARSED MESSAGE
;INPUT : MESSNUM - Message number in transmission (not XMZ)
; (defaults to 1)
; PARSARR - Parsing array (full global reference)
; PRIME - Indicates which key to return
; 0 = Return secondary key (default)
; Returns NULL on error
; 1 = Return primary key
; Returns NULL on error
;OUTPUT : See definition of PRIME
;
;CHECK INPUT
S:($G(MESSNUM)="") MESSNUM=1
Q:($G(PARSARR)="") ""
Q:('$D(@PARSARR@(MESSNUM))) ""
Q:('$D(@PARSARR@(MESSNUM,"USER",1))) ""
S PRIME=+$G(PRIME)
;DECLARE VARIABLES
N SENDER
;GET SENDER
S SENDER=$$SENDER(MESSNUM,PARSARR)
Q:($P(SENDER,"^",1)="-1") ""
S SENDER=$P(SENDER,"^",1)
;RETURN KEY
Q $$NAMEKEY^VAQUTL3(SENDER,PRIME)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFIL13 3871 printed Dec 13, 2024@02:25:48 Page 2
VAQFIL13 ;ALB/JRP - MESSAGE FILING;12-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
USER(MESSNUM,PARSARR,TRANPTR) ;FILE USER 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,"USER",1)))
QUIT "-1^Message did not contain a user 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,USERNAME,USERSITE,ERR
+21 ;MAKE SURE IT'S A USER BLOCK
+22 SET TMP=$GET(@PARSARR@(MESSNUM,"USER",1,1))
+23 if (TMP=" ")
SET TMP=""
+24 if ((TMP="")!(TMP'="$USER"))
QUIT "-1^Not a user block"
+25 SET TMP=$GET(@PARSARR@(MESSNUM,"USER",1,5))
+26 if (TMP=" ")
SET TMP=""
+27 if ((TMP="")!(TMP'="$$USER"))
QUIT "-1^Not a valid user 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 ;ACK OR RETRANSMIT DON'T HAVE USER BLOCKS
+33 if ((TYPE="ACK")!(TYPE="RET"))
QUIT "-1^Message type does not require user block"
+34 ;GET INFO
+35 SET USERNAME=$GET(@PARSARR@(MESSNUM,"USER",1,2))
+36 if (USERNAME=" ")
SET USERNAME=""
+37 SET USERSITE=$GET(@PARSARR@(MESSNUM,"USER",1,4))
+38 if (USERSITE=" ")
SET USERSITE=""
+39 ;FILE INFORMATION
+40 SET ERR=0
+41 ;FILE NAME
+42 SET TMP=$SELECT((TYPE="REQ"):21,1:51)
+43 SET ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,USERNAME)
+44 if (ERR)
QUIT "-1^Unable to file sender of transmission ("_USERNAME_")"
+45 ;FILE SITE
+46 SET TMP=$SELECT((TYPE="REQ"):30,1:60)
+47 SET ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,USERSITE)
+48 if (ERR)
QUIT "-1^Unable to file sending facility of transmission ("_USERSITE_")"
+49 QUIT 0
+50 ;
SENDER(MESSNUM,PARSARR) ;RETURN SENDER OF PARSED MESSAGE
+1 ;INPUT : MESSNUM - Message number in transmission (not XMZ)
+2 ; (defaults to 1)
+3 ; PARSARR - Parsing array (full global reference)
+4 ;OUTPUT : Name^DUZ - Success
+5 ; -1^Error_Text - Error
+6 ;
+7 ;CHECK INPUT
+8 if ($GET(MESSNUM)="")
SET MESSNUM=1
+9 if ($GET(PARSARR)="")
QUIT "-1^Did not pass reference to parsing array"
+10 if ('$DATA(@PARSARR@(MESSNUM)))
QUIT "-1^Did not pass valid message number"
+11 if ('$DATA(@PARSARR@(MESSNUM,"USER",1)))
QUIT "-1^Message did not contain a user block"
+12 ;DECLARE VARIABLES
+13 NEW USERNAME,USERDUZ
+14 SET USERNAME=$GET(@PARSARR@(MESSNUM,"USER",1,2))
+15 if (USERNAME=" ")
SET USERNAME=""
+16 if (USERNAME="")
QUIT "-1^Could not determine sender of message"
+17 SET USERDUZ=$GET(@PARSARR@(MESSNUM,"USER",1,3))
+18 if (USERDUZ=" ")
SET USERDUZ=""
+19 if (USERDUZ="")
QUIT "-1^Could not determine sender of message"
+20 QUIT USERNAME_"^"_USERDUZ
+21 ;
KEY(MESSNUM,PARSARR,PRIME) ;RETURN SENDER OF PARSED MESSAGE
+1 ;INPUT : MESSNUM - Message number in transmission (not XMZ)
+2 ; (defaults to 1)
+3 ; PARSARR - Parsing array (full global reference)
+4 ; PRIME - Indicates which key to return
+5 ; 0 = Return secondary key (default)
+6 ; Returns NULL on error
+7 ; 1 = Return primary key
+8 ; Returns NULL on error
+9 ;OUTPUT : See definition of PRIME
+10 ;
+11 ;CHECK INPUT
+12 if ($GET(MESSNUM)="")
SET MESSNUM=1
+13 if ($GET(PARSARR)="")
QUIT ""
+14 if ('$DATA(@PARSARR@(MESSNUM)))
QUIT ""
+15 if ('$DATA(@PARSARR@(MESSNUM,"USER",1)))
QUIT ""
+16 SET PRIME=+$GET(PRIME)
+17 ;DECLARE VARIABLES
+18 NEW SENDER
+19 ;GET SENDER
+20 SET SENDER=$$SENDER(MESSNUM,PARSARR)
+21 if ($PIECE(SENDER,"^",1)="-1")
QUIT ""
+22 SET SENDER=$PIECE(SENDER,"^",1)
+23 ;RETURN KEY
+24 QUIT $$NAMEKEY^VAQUTL3(SENDER,PRIME)
