142 lines
4.5 KiB
Mathematica
142 lines
4.5 KiB
Mathematica
VAQPAR1 ;ALB/JRP - MESSAGE PARSING;28-APR-93
|
|
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|
PREPRS10(ARRAY) ;PRE-PARSE VERSION 1.0 TRANSMISSION
|
|
;INPUT : ARRAY - Parsing array (full global reference)
|
|
; (As defined by MailMan)
|
|
; XMFROM, XMREC, XMZ
|
|
; (Declared in SERVER^VAQADM2)
|
|
; XMER, XMRG, XMPOS
|
|
;OUTPUT : XMER - Exit condition
|
|
; 0 = Success
|
|
; -1^Error_Text = Error
|
|
; XMPOS - Last line [number] read in transmission
|
|
; (if NULL end of transmission reached)
|
|
;
|
|
;NOTES : Parsing array will have the following format
|
|
; ARRAY(1,BlockName,LineNumber) = Value
|
|
; : Calling routine responsible for ARRAY clean up before
|
|
; and after call
|
|
; : This is not a function
|
|
;
|
|
;CHECK INPUT
|
|
I ($G(ARRAY)="") S XMER="-1^Did not pass reference to parsing array" Q
|
|
;DECLARE VARIABLES
|
|
N LINE,ERR,BLOCK,TMP,X
|
|
S XMER=0
|
|
S LINE=1
|
|
;READ HEADER
|
|
S BLOCK="HEADER"
|
|
X XMREC
|
|
I ((XMER<0)!(XMRG="")) S XMER="-1^Transmission did not contain any information" Q
|
|
S @ARRAY@(1,BLOCK,LINE)=XMRG
|
|
S LINE=LINE+1
|
|
;QUIT IF TRANSMISSION IS AN ACK
|
|
Q:($P(XMRG,"^",1)="ACK")
|
|
X XMREC
|
|
I ((XMER<0)!(XMRG="")) S XMER="-1^Transmission was not complete" Q
|
|
S @ARRAY@(1,BLOCK,LINE)=XMRG
|
|
S LINE=LINE+1
|
|
;CHECK TRANSMISSION TYPE
|
|
S TMP=+$P(@ARRAY@(1,BLOCK,1),"^",12)
|
|
;TRANSMISSION TYPE NOT SUPPORTED
|
|
I ((TMP=17)!(TMP=19)!(TMP=20)) S XMER="-1^Transmission type not supported" Q
|
|
F X=10:1:21 Q:(TMP=X)
|
|
I (X=21) S XMER="-1^Transmission type not supported" Q
|
|
;NO DATA BLOCKS IN TRANSMISSION
|
|
Q:((TMP'=15)&(TMP'=16))
|
|
;READ DATA BLOCKS
|
|
S XMER=0
|
|
F X XMREC Q:(XMER<0) D
|
|
.;GET DATA BLOCK TYPE
|
|
.S TMP=$P(XMRG,"^",1)
|
|
.;NEW DATA BLOCK TYPE
|
|
.S:(TMP'=BLOCK) LINE=1
|
|
.;BLOCK NOT SUPPORTED (SKIP)
|
|
.Q:((TMP'="MIN")&(TMP'="MAS")&(TMP'="PHA"))
|
|
.S BLOCK=TMP
|
|
.S @ARRAY@(1,BLOCK,LINE)=$P(XMRG,"^",2,($L(XMRG,"^")))
|
|
.S LINE=LINE+1
|
|
S XMER=0
|
|
Q
|
|
;
|
|
PARSE10(ARRAY) ;PARSE 1.0 MESSAGE
|
|
;INPUT : ARRAY - Array containing pre-parsed version 1.0 transmission
|
|
; (full global reference)
|
|
; (As defined by MailMan)
|
|
; XMFROM, XMREC, XMZ
|
|
; (Declared in SERVER^VAQADM2)
|
|
; XMER, XMRG, XMPOS
|
|
;OUTPUT : XMER - Exit condition
|
|
; 0 = Success
|
|
; -1^Error_Text = Error
|
|
;NOTES : Pre-parsed transmsission will be deleted from ARRAY
|
|
; and replaced with parsed array. Parsed array will be same
|
|
; as parsed array for version 1.5 message and have the format:
|
|
; ARRAY(2,BlockName,BlockSeq,Line)
|
|
; : This is not a function
|
|
;
|
|
;CHECK INPUT
|
|
I ($G(ARRAY)="") S XMER="-1^Did not pass reference to parsing array" Q
|
|
I ('$D(@ARRAY@(1))) S XMER="-1^Parsing array did not contain pre-parsed transmission" Q
|
|
;DECLARE VARIABLES
|
|
N TMP,BLOCK,ACK,TYPE,STATUS,X,Y
|
|
S XMER=0
|
|
;DETERMINE IF MESSAGE IS AN ACKNOWLEDGMENT
|
|
S TMP=$G(@ARRAY@(1,"HEADER",1))
|
|
I (TMP="") S XMER="-1^Header did not exist in pre-parsed message" Q
|
|
S ACK=($P(TMP,"^",1)="ACK")
|
|
;ACK
|
|
I (ACK) D
|
|
.;MAKE HEADER BLOCK
|
|
.S @ARRAY@(2,"HEADER",1,1)="$HEADER"
|
|
.S @ARRAY@(2,"HEADER",1,2)="ACK"
|
|
.S @ARRAY@(2,"HEADER",1,3)="VAQ-RQACK"
|
|
.S @ARRAY@(2,"HEADER",1,4)=1.0
|
|
.S @ARRAY@(2,"HEADER",1,5)=$$NOW^VAQUTL99(0,0)
|
|
.S @ARRAY@(2,"HEADER",1,6)=$G(XMZ)
|
|
.S @ARRAY@(2,"HEADER",1,7)=$P($G(@ARRAY@(1,"HEADER",1)),"^",2)
|
|
.S @ARRAY@(2,"HEADER",1,8)=""
|
|
.S @ARRAY@(2,"HEADER",1,9)="$$HEADER"
|
|
;NOT AN ACK
|
|
I ('ACK) D
|
|
.;DETERMINE STATUS & TYPE
|
|
.S TMP=$G(@ARRAY@(1,"HEADER",1))
|
|
.S X=$P(TMP,"^",12)
|
|
.S:(X=10) STATUS="VAQ-RQST",TYPE="REQ"
|
|
.S:(X=11) STATUS="VAQ-AMBIG",TYPE="RES"
|
|
.S:(X=12) STATUS="VAQ-NTFND",TYPE="RES"
|
|
.S:((X=13)!(X=14)!(X=18)) STATUS="VAQ-REJ",TYPE="RES"
|
|
.S:(X=15) STATUS="VAQ-RSLT",TYPE="RES"
|
|
.S:(X=16) STATUS="VAQ-UNSOL",TYPE="UNS"
|
|
.S @ARRAY@(2,"HEADER",1,1)="$HEADER"
|
|
.S @ARRAY@(2,"HEADER",1,2)=TYPE
|
|
.S @ARRAY@(2,"HEADER",1,3)=STATUS
|
|
.S @ARRAY@(2,"HEADER",1,4)=1.0
|
|
.S X=+$P(TMP,"^",9)
|
|
.S Y=$P(X,".",2)
|
|
.S Y=Y_"000000"
|
|
.S $P(X,".",2)=Y
|
|
.S Y=$$DOBFMT^VAQUTL99(X)
|
|
.I (Y'="") D
|
|
..S X=$P(X,".",2)
|
|
..S Y=Y_"@"_$E(X,1,2)_":"_$E(X,3,4)_":"_$E(X,5,6)
|
|
.S @ARRAY@(2,"HEADER",1,5)=Y
|
|
.S @ARRAY@(2,"HEADER",1,6)=$G(XMZ)
|
|
.S X=""
|
|
.S:((TYPE="RES")!(TYPE="REQ")) X=+TMP
|
|
.S @ARRAY@(2,"HEADER",1,7)=X
|
|
.S @ARRAY@(2,"HEADER",1,8)=""
|
|
.S @ARRAY@(2,"HEADER",1,9)="$$HEADER"
|
|
;MAKE DOMAIN BLOCK
|
|
S @ARRAY@(2,"DOMAIN",1,1)="$DOMAIN"
|
|
S X=$P($G(@ARRAY@(1,"HEADER",2)),"^",1)
|
|
S:(X="") X=$P($G(XMFROM),"@",2)
|
|
S @ARRAY@(2,"DOMAIN",1,2)=X
|
|
S @ARRAY@(2,"DOMAIN",1,3)=""
|
|
S @ARRAY@(2,"DOMAIN",1,4)="$$DOMAIN"
|
|
;DONE IF ACK
|
|
Q:(ACK)
|
|
;GO TO CONTINUATION ROUTINE
|
|
D PARCON^VAQPAR10
|
|
Q
|