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