101 lines
3.7 KiB
Mathematica
101 lines
3.7 KiB
Mathematica
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)
|