| 1 | VAQFIL13 ;ALB/JRP - MESSAGE FILING;12-MAY-93 | 
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993 | 
|---|
| 3 | USER(MESSNUM,PARSARR,TRANPTR) ;FILE USER BLOCK | 
|---|
| 4 | ;INPUT  : MESSNUM - Message number in transmission (not XMZ) | 
|---|
| 5 | ;                   (defaults to 1) | 
|---|
| 6 | ;         PARSARR - Parsing array (full global reference) | 
|---|
| 7 | ;         TRANPTR - Pointer to VAQ - TRANSACTION file | 
|---|
| 8 | ;         (As defined by MailMan) | 
|---|
| 9 | ;         XMFROM, XMREC,XMZ | 
|---|
| 10 | ;OUTPUT : 0 - Success | 
|---|
| 11 | ;         -1^Error_Text - Error | 
|---|
| 12 | ;NOTES  : It is the responsibility of the calling program to correct | 
|---|
| 13 | ;         the transaction being updated if an error occurs. | 
|---|
| 14 | ; | 
|---|
| 15 | ;CHECK INPUT | 
|---|
| 16 | S:($G(MESSNUM)="") MESSNUM=1 | 
|---|
| 17 | Q:($G(PARSARR)="") "-1^Did not pass reference to parsing array" | 
|---|
| 18 | Q:('$D(@PARSARR@(MESSNUM))) "-1^Did not pass valid message number" | 
|---|
| 19 | Q:('$D(@PARSARR@(MESSNUM,"USER",1))) "-1^Message did not contain a user block" | 
|---|
| 20 | S TRANPTR=+$G(TRANPTR) | 
|---|
| 21 | Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid transaction" | 
|---|
| 22 | ;DECLARE VARIABLES | 
|---|
| 23 | N TMP,TYPE,USERNAME,USERSITE,ERR | 
|---|
| 24 | ;MAKE SURE IT'S A USER BLOCK | 
|---|
| 25 | S TMP=$G(@PARSARR@(MESSNUM,"USER",1,1)) | 
|---|
| 26 | S:(TMP=" ") TMP="" | 
|---|
| 27 | Q:((TMP="")!(TMP'="$USER")) "-1^Not a user block" | 
|---|
| 28 | S TMP=$G(@PARSARR@(MESSNUM,"USER",1,5)) | 
|---|
| 29 | S:(TMP=" ") TMP="" | 
|---|
| 30 | Q:((TMP="")!(TMP'="$$USER")) "-1^Not a valid user block" | 
|---|
| 31 | ;GET MESSAGE TYPE | 
|---|
| 32 | S TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR) | 
|---|
| 33 | Q:($P(TMP,"^",1)="-1") "-1^Could not determine message type" | 
|---|
| 34 | S TYPE=$P(TMP,"^",2) | 
|---|
| 35 | ;ACK OR RETRANSMIT DON'T HAVE USER BLOCKS | 
|---|
| 36 | Q:((TYPE="ACK")!(TYPE="RET")) "-1^Message type does not require user block" | 
|---|
| 37 | ;GET INFO | 
|---|
| 38 | S USERNAME=$G(@PARSARR@(MESSNUM,"USER",1,2)) | 
|---|
| 39 | S:(USERNAME=" ") USERNAME="" | 
|---|
| 40 | S USERSITE=$G(@PARSARR@(MESSNUM,"USER",1,4)) | 
|---|
| 41 | S:(USERSITE=" ") USERSITE="" | 
|---|
| 42 | ;FILE INFORMATION | 
|---|
| 43 | S ERR=0 | 
|---|
| 44 | ;FILE NAME | 
|---|
| 45 | S TMP=$S((TYPE="REQ"):21,1:51) | 
|---|
| 46 | S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,USERNAME) | 
|---|
| 47 | Q:(ERR) "-1^Unable to file sender of transmission ("_USERNAME_")" | 
|---|
| 48 | ;FILE SITE | 
|---|
| 49 | S TMP=$S((TYPE="REQ"):30,1:60) | 
|---|
| 50 | S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,USERSITE) | 
|---|
| 51 | Q:(ERR) "-1^Unable to file sending facility of transmission ("_USERSITE_")" | 
|---|
| 52 | Q 0 | 
|---|
| 53 | ; | 
|---|
| 54 | SENDER(MESSNUM,PARSARR) ;RETURN SENDER OF PARSED MESSAGE | 
|---|
| 55 | ;INPUT  : MESSNUM - Message number in transmission (not XMZ) | 
|---|
| 56 | ;                   (defaults to 1) | 
|---|
| 57 | ;         PARSARR - Parsing array (full global reference) | 
|---|
| 58 | ;OUTPUT : Name^DUZ - Success | 
|---|
| 59 | ;         -1^Error_Text - Error | 
|---|
| 60 | ; | 
|---|
| 61 | ;CHECK INPUT | 
|---|
| 62 | S:($G(MESSNUM)="") MESSNUM=1 | 
|---|
| 63 | Q:($G(PARSARR)="") "-1^Did not pass reference to parsing array" | 
|---|
| 64 | Q:('$D(@PARSARR@(MESSNUM))) "-1^Did not pass valid message number" | 
|---|
| 65 | Q:('$D(@PARSARR@(MESSNUM,"USER",1))) "-1^Message did not contain a user block" | 
|---|
| 66 | ;DECLARE VARIABLES | 
|---|
| 67 | N USERNAME,USERDUZ | 
|---|
| 68 | S USERNAME=$G(@PARSARR@(MESSNUM,"USER",1,2)) | 
|---|
| 69 | S:(USERNAME=" ") USERNAME="" | 
|---|
| 70 | Q:(USERNAME="") "-1^Could not determine sender of message" | 
|---|
| 71 | S USERDUZ=$G(@PARSARR@(MESSNUM,"USER",1,3)) | 
|---|
| 72 | S:(USERDUZ=" ") USERDUZ="" | 
|---|
| 73 | Q:(USERDUZ="") "-1^Could not determine sender of message" | 
|---|
| 74 | Q USERNAME_"^"_USERDUZ | 
|---|
| 75 | ; | 
|---|
| 76 | KEY(MESSNUM,PARSARR,PRIME) ;RETURN SENDER OF PARSED MESSAGE | 
|---|
| 77 | ;INPUT  : MESSNUM - Message number in transmission (not XMZ) | 
|---|
| 78 | ;                   (defaults to 1) | 
|---|
| 79 | ;         PARSARR - Parsing array (full global reference) | 
|---|
| 80 | ;         PRIME - Indicates which key to return | 
|---|
| 81 | ;           0 = Return secondary key (default) | 
|---|
| 82 | ;               Returns NULL on error | 
|---|
| 83 | ;           1 = Return primary key | 
|---|
| 84 | ;               Returns NULL on error | 
|---|
| 85 | ;OUTPUT : See definition of PRIME | 
|---|
| 86 | ; | 
|---|
| 87 | ;CHECK INPUT | 
|---|
| 88 | S:($G(MESSNUM)="") MESSNUM=1 | 
|---|
| 89 | Q:($G(PARSARR)="") "" | 
|---|
| 90 | Q:('$D(@PARSARR@(MESSNUM))) "" | 
|---|
| 91 | Q:('$D(@PARSARR@(MESSNUM,"USER",1))) "" | 
|---|
| 92 | S PRIME=+$G(PRIME) | 
|---|
| 93 | ;DECLARE VARIABLES | 
|---|
| 94 | N SENDER | 
|---|
| 95 | ;GET SENDER | 
|---|
| 96 | S SENDER=$$SENDER(MESSNUM,PARSARR) | 
|---|
| 97 | Q:($P(SENDER,"^",1)="-1") "" | 
|---|
| 98 | S SENDER=$P(SENDER,"^",1) | 
|---|
| 99 | ;RETURN KEY | 
|---|
| 100 | Q $$NAMEKEY^VAQUTL3(SENDER,PRIME) | 
|---|