source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQFIL13.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.7 KB
Line 
1VAQFIL13 ;ALB/JRP - MESSAGE FILING;12-MAY-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3USER(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 ;
54SENDER(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 ;
76KEY(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)
Note: See TracBrowser for help on using the repository browser.