source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPAR1.m@ 649

Last change on this file since 649 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1VAQPAR1 ;ALB/JRP - MESSAGE PARSING;28-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3PREPRS10(ARRAY) ;PRE-PARSE VERSION 1.0 TRANSMISSION
4 ;INPUT : ARRAY - Parsing array (full global reference)
5 ; (As defined by MailMan)
6 ; XMFROM, XMREC, XMZ
7 ; (Declared in SERVER^VAQADM2)
8 ; XMER, XMRG, XMPOS
9 ;OUTPUT : XMER - Exit condition
10 ; 0 = Success
11 ; -1^Error_Text = Error
12 ; XMPOS - Last line [number] read in transmission
13 ; (if NULL end of transmission reached)
14 ;
15 ;NOTES : Parsing array will have the following format
16 ; ARRAY(1,BlockName,LineNumber) = Value
17 ; : Calling routine responsible for ARRAY clean up before
18 ; and after call
19 ; : This is not a function
20 ;
21 ;CHECK INPUT
22 I ($G(ARRAY)="") S XMER="-1^Did not pass reference to parsing array" Q
23 ;DECLARE VARIABLES
24 N LINE,ERR,BLOCK,TMP,X
25 S XMER=0
26 S LINE=1
27 ;READ HEADER
28 S BLOCK="HEADER"
29 X XMREC
30 I ((XMER<0)!(XMRG="")) S XMER="-1^Transmission did not contain any information" Q
31 S @ARRAY@(1,BLOCK,LINE)=XMRG
32 S LINE=LINE+1
33 ;QUIT IF TRANSMISSION IS AN ACK
34 Q:($P(XMRG,"^",1)="ACK")
35 X XMREC
36 I ((XMER<0)!(XMRG="")) S XMER="-1^Transmission was not complete" Q
37 S @ARRAY@(1,BLOCK,LINE)=XMRG
38 S LINE=LINE+1
39 ;CHECK TRANSMISSION TYPE
40 S TMP=+$P(@ARRAY@(1,BLOCK,1),"^",12)
41 ;TRANSMISSION TYPE NOT SUPPORTED
42 I ((TMP=17)!(TMP=19)!(TMP=20)) S XMER="-1^Transmission type not supported" Q
43 F X=10:1:21 Q:(TMP=X)
44 I (X=21) S XMER="-1^Transmission type not supported" Q
45 ;NO DATA BLOCKS IN TRANSMISSION
46 Q:((TMP'=15)&(TMP'=16))
47 ;READ DATA BLOCKS
48 S XMER=0
49 F X XMREC Q:(XMER<0) D
50 .;GET DATA BLOCK TYPE
51 .S TMP=$P(XMRG,"^",1)
52 .;NEW DATA BLOCK TYPE
53 .S:(TMP'=BLOCK) LINE=1
54 .;BLOCK NOT SUPPORTED (SKIP)
55 .Q:((TMP'="MIN")&(TMP'="MAS")&(TMP'="PHA"))
56 .S BLOCK=TMP
57 .S @ARRAY@(1,BLOCK,LINE)=$P(XMRG,"^",2,($L(XMRG,"^")))
58 .S LINE=LINE+1
59 S XMER=0
60 Q
61 ;
62PARSE10(ARRAY) ;PARSE 1.0 MESSAGE
63 ;INPUT : ARRAY - Array containing pre-parsed version 1.0 transmission
64 ; (full global reference)
65 ; (As defined by MailMan)
66 ; XMFROM, XMREC, XMZ
67 ; (Declared in SERVER^VAQADM2)
68 ; XMER, XMRG, XMPOS
69 ;OUTPUT : XMER - Exit condition
70 ; 0 = Success
71 ; -1^Error_Text = Error
72 ;NOTES : Pre-parsed transmsission will be deleted from ARRAY
73 ; and replaced with parsed array. Parsed array will be same
74 ; as parsed array for version 1.5 message and have the format:
75 ; ARRAY(2,BlockName,BlockSeq,Line)
76 ; : This is not a function
77 ;
78 ;CHECK INPUT
79 I ($G(ARRAY)="") S XMER="-1^Did not pass reference to parsing array" Q
80 I ('$D(@ARRAY@(1))) S XMER="-1^Parsing array did not contain pre-parsed transmission" Q
81 ;DECLARE VARIABLES
82 N TMP,BLOCK,ACK,TYPE,STATUS,X,Y
83 S XMER=0
84 ;DETERMINE IF MESSAGE IS AN ACKNOWLEDGMENT
85 S TMP=$G(@ARRAY@(1,"HEADER",1))
86 I (TMP="") S XMER="-1^Header did not exist in pre-parsed message" Q
87 S ACK=($P(TMP,"^",1)="ACK")
88 ;ACK
89 I (ACK) D
90 .;MAKE HEADER BLOCK
91 .S @ARRAY@(2,"HEADER",1,1)="$HEADER"
92 .S @ARRAY@(2,"HEADER",1,2)="ACK"
93 .S @ARRAY@(2,"HEADER",1,3)="VAQ-RQACK"
94 .S @ARRAY@(2,"HEADER",1,4)=1.0
95 .S @ARRAY@(2,"HEADER",1,5)=$$NOW^VAQUTL99(0,0)
96 .S @ARRAY@(2,"HEADER",1,6)=$G(XMZ)
97 .S @ARRAY@(2,"HEADER",1,7)=$P($G(@ARRAY@(1,"HEADER",1)),"^",2)
98 .S @ARRAY@(2,"HEADER",1,8)=""
99 .S @ARRAY@(2,"HEADER",1,9)="$$HEADER"
100 ;NOT AN ACK
101 I ('ACK) D
102 .;DETERMINE STATUS & TYPE
103 .S TMP=$G(@ARRAY@(1,"HEADER",1))
104 .S X=$P(TMP,"^",12)
105 .S:(X=10) STATUS="VAQ-RQST",TYPE="REQ"
106 .S:(X=11) STATUS="VAQ-AMBIG",TYPE="RES"
107 .S:(X=12) STATUS="VAQ-NTFND",TYPE="RES"
108 .S:((X=13)!(X=14)!(X=18)) STATUS="VAQ-REJ",TYPE="RES"
109 .S:(X=15) STATUS="VAQ-RSLT",TYPE="RES"
110 .S:(X=16) STATUS="VAQ-UNSOL",TYPE="UNS"
111 .S @ARRAY@(2,"HEADER",1,1)="$HEADER"
112 .S @ARRAY@(2,"HEADER",1,2)=TYPE
113 .S @ARRAY@(2,"HEADER",1,3)=STATUS
114 .S @ARRAY@(2,"HEADER",1,4)=1.0
115 .S X=+$P(TMP,"^",9)
116 .S Y=$P(X,".",2)
117 .S Y=Y_"000000"
118 .S $P(X,".",2)=Y
119 .S Y=$$DOBFMT^VAQUTL99(X)
120 .I (Y'="") D
121 ..S X=$P(X,".",2)
122 ..S Y=Y_"@"_$E(X,1,2)_":"_$E(X,3,4)_":"_$E(X,5,6)
123 .S @ARRAY@(2,"HEADER",1,5)=Y
124 .S @ARRAY@(2,"HEADER",1,6)=$G(XMZ)
125 .S X=""
126 .S:((TYPE="RES")!(TYPE="REQ")) X=+TMP
127 .S @ARRAY@(2,"HEADER",1,7)=X
128 .S @ARRAY@(2,"HEADER",1,8)=""
129 .S @ARRAY@(2,"HEADER",1,9)="$$HEADER"
130 ;MAKE DOMAIN BLOCK
131 S @ARRAY@(2,"DOMAIN",1,1)="$DOMAIN"
132 S X=$P($G(@ARRAY@(1,"HEADER",2)),"^",1)
133 S:(X="") X=$P($G(XMFROM),"@",2)
134 S @ARRAY@(2,"DOMAIN",1,2)=X
135 S @ARRAY@(2,"DOMAIN",1,3)=""
136 S @ARRAY@(2,"DOMAIN",1,4)="$$DOMAIN"
137 ;DONE IF ACK
138 Q:(ACK)
139 ;GO TO CONTINUATION ROUTINE
140 D PARCON^VAQPAR10
141 Q
Note: See TracBrowser for help on using the repository browser.