VAQPAR60 ;ALB/JRP - MESSAGE PARSING;28-APR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MESSAGE(PRSARR,MESSNUM) ;PARSING OF VERSION 1.5 MESSAGE
;INPUT : PRSARR - Parsing array (full global reference)
; MESSNUM - Message number within transmission (not XMZ)
; (defaults to 1)
; (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(MESSNUM,BlockName,BlockSeq,LineNumber) = Value
; [BlockSeq used to keep blocks of same name from
; overwritting each other. This will typically be '1'
; except for DATA & DISPLAY blocks.]
; : Calling routine responsible for ARRAY clean up before
; and after call
;
;CHECK INPUT
I ($G(PRSARR)="") S XMER="-1^Did not pass reference to parsing array" Q
S:($G(MESSNUM)="") MESSNUM=1
;DECLARE VARIABLES
N STOP,BLOCK,BLOCKSEQ,TMP,CURRENT,LAST
S XMER=0
S STOP=0
;PARSE MESSAGE
F D Q:((XMER<0)!(STOP))
.S LAST=XMPOS
.X XMREC
.S CURRENT=XMPOS
.;END OF MESSAGE REACHED
.I (XMRG="$$MESSAGE") S XMER=0,STOP=1 Q
.;REACHED END OF MAILMAN MESSAGE
.I (XMER<0) S XMER="-1^End of message was not designated"
.;GET SEQUENCE NUMBER
.S BLOCK=$P(XMRG,"$",2)
.S BLOCKSEQ=0
.S TMP=""
.F S TMP=$O(@PRSARR@(MESSNUM,BLOCK,TMP)) Q:(TMP="") S BLOCKSEQ=TMP
.S BLOCKSEQ=BLOCKSEQ+1
.;PARSE VALID BLOCKS
.S XMPOS=LAST
.I (BLOCK="HEADER") D BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ) Q
.I (BLOCK="DOMAIN") D BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ) Q
.I (BLOCK="USER") D BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ) Q
.I (BLOCK="PATIENT") D BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ) Q
.I (BLOCK="SEGMENT") D BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ) Q
.I (BLOCK="COMMENT") D BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ) Q
.I (BLOCK="DATA") D BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ) Q
.I (BLOCK="DISPLAY") D BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ) Q
.S:(XMPOS=LAST) XMPOS=CURRENT
.;EVERYTHING ELSE IS IGNORED
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPAR60 2377 printed Jan 18, 2025@03:26:53 Page 2
VAQPAR60 ;ALB/JRP - MESSAGE PARSING;28-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MESSAGE(PRSARR,MESSNUM) ;PARSING OF VERSION 1.5 MESSAGE
+1 ;INPUT : PRSARR - Parsing array (full global reference)
+2 ; MESSNUM - Message number within transmission (not XMZ)
+3 ; (defaults to 1)
+4 ; (As defined by MailMan)
+5 ; XMFROM, XMREC, XMZ
+6 ; (Declared in SERVER^VAQADM2)
+7 ; XMER, XMRG, XMPOS
+8 ;OUTPUT : XMER - Exit condition
+9 ; 0 = Success
+10 ; -1^Error_Text = Error
+11 ; XMPOS - Last line [number] read in transmission
+12 ; (if NULL end of transmission reached)
+13 ;NOTES : Parsing array will have the following format
+14 ; ARRAY(MESSNUM,BlockName,BlockSeq,LineNumber) = Value
+15 ; [BlockSeq used to keep blocks of same name from
+16 ; overwritting each other. This will typically be '1'
+17 ; except for DATA & DISPLAY blocks.]
+18 ; : Calling routine responsible for ARRAY clean up before
+19 ; and after call
+20 ;
+21 ;CHECK INPUT
+22 IF ($GET(PRSARR)="")
SET XMER="-1^Did not pass reference to parsing array"
QUIT
+23 if ($GET(MESSNUM)="")
SET MESSNUM=1
+24 ;DECLARE VARIABLES
+25 NEW STOP,BLOCK,BLOCKSEQ,TMP,CURRENT,LAST
+26 SET XMER=0
+27 SET STOP=0
+28 ;PARSE MESSAGE
+29 FOR
Begin DoDot:1
+30 SET LAST=XMPOS
+31 XECUTE XMREC
+32 SET CURRENT=XMPOS
+33 ;END OF MESSAGE REACHED
+34 IF (XMRG="$$MESSAGE")
SET XMER=0
SET STOP=1
QUIT
+35 ;REACHED END OF MAILMAN MESSAGE
+36 IF (XMER<0)
SET XMER="-1^End of message was not designated"
+37 ;GET SEQUENCE NUMBER
+38 SET BLOCK=$PIECE(XMRG,"$",2)
+39 SET BLOCKSEQ=0
+40 SET TMP=""
+41 FOR
SET TMP=$ORDER(@PRSARR@(MESSNUM,BLOCK,TMP))
if (TMP="")
QUIT
SET BLOCKSEQ=TMP
+42 SET BLOCKSEQ=BLOCKSEQ+1
+43 ;PARSE VALID BLOCKS
+44 SET XMPOS=LAST
+45 IF (BLOCK="HEADER")
DO BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ)
QUIT
+46 IF (BLOCK="DOMAIN")
DO BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ)
QUIT
+47 IF (BLOCK="USER")
DO BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ)
QUIT
+48 IF (BLOCK="PATIENT")
DO BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ)
QUIT
+49 IF (BLOCK="SEGMENT")
DO BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ)
QUIT
+50 IF (BLOCK="COMMENT")
DO BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ)
QUIT
+51 IF (BLOCK="DATA")
DO BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ)
QUIT
+52 IF (BLOCK="DISPLAY")
DO BLOCK^VAQPAR61(PRSARR,MESSNUM,BLOCK,BLOCKSEQ)
QUIT
+53 if (XMPOS=LAST)
SET XMPOS=CURRENT
+54 ;EVERYTHING ELSE IS IGNORED
End DoDot:1
if ((XMER<0)!(STOP))
QUIT
+55 QUIT
