source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQFIL12.m@ 1000

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1VAQFIL12 ;ALB/JRP - MESSAGE FILING;12-MAY-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3DOMAIN(MESSNUM,PARSARR,TRANPTR) ;FILE DOMAIN 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,"DOMAIN",1))) "-1^Message did not contain a domain 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,SENDER,RECEIVER,ERR
24 ;MAKE SURE IT'S A DOMAIN BLOCK
25 S TMP=$G(@PARSARR@(MESSNUM,"DOMAIN",1,1))
26 S:(TMP=" ") TMP=""
27 Q:((TMP="")!(TMP'="$DOMAIN")) "-1^Not a domain block"
28 S TMP=$G(@PARSARR@(MESSNUM,"DOMAIN",1,4))
29 S:(TMP=" ") TMP=""
30 Q:((TMP="")!(TMP'="$$DOMAIN")) "-1^Not a valid domain 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 ;DONE IF ACK OR RETRANSMIT (DOMAINS NOT FILED)
36 Q:((TYPE="ACK")!(TYPE="RET")) 0
37 ;GET INFO
38 S SENDER=$G(@PARSARR@(MESSNUM,"DOMAIN",1,2))
39 S RECEIVER=$G(@PARSARR@(MESSNUM,"DOMAIN",1,3))
40 ;FILE INFORMATION
41 S ERR=0
42 ;FILE SENDER
43 S TMP=$S((TYPE="REQ"):31,1:61)
44 S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,SENDER)
45 Q:(ERR) "-1^Unable to file sending domain of transmission ("_SENDER_")"
46 ;FILE RECEIVER
47 S TMP=$S((TYPE="REQ"):61,1:31)
48 S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,TMP,RECEIVER)
49 Q:(ERR) "-1^Unable to file receiving domain of transmission ("_RECEIVER_")"
50 Q 0
Note: See TracBrowser for help on using the repository browser.