VAQPAR61 ;ALB/JRP - MESSAGE PARSING;28-APR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
BLOCK(PRSARR,MESSNUM,BLOCK,BLOCKNUM) ;PARSING OF VERSION 1.5 MESSAGE BLOCKS
;INPUT : PRSARR - Parsing array (full global reference)
; MESSNUM - Message number within transmission (not XMZ)
; (defaults to 1)
; BLOCK - Block name
; BLOCKNUM - Block number with message (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,BLOCK,BLOCKNUM,LineNumber) = Value
; : 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
I ($G(BLOCK)="") S XMER="-1^Did not pass block name" Q
S:($G(BLOCKNUM)="") BLOCKNUM=1
S XMER="-1^Block not supported"
Q:((BLOCK'="HEADER")&(BLOCK'="DOMAIN")&(BLOCK'="USER")&(BLOCK'="PATIENT")&(BLOCK'="SEGMENT")&(BLOCK'="COMMENT")&(BLOCK'="DATA")&(BLOCK'="DISPLAY"))
;DECLARE VARIABLES
N END,BLOCKEND,LINE
S XMER=0
S END=0
S BLOCKEND="$$"_BLOCK
;PARSE BLOCK
F LINE=1:1 D Q:((XMER<0)!(END))
.X XMREC
.;END OF BLOCK REACHED
.I (XMRG=BLOCKEND) S XMER=0,END=1 Q
.;REACHED END OF MAILMAN MESSAGE
.I (XMER<0) S XMER="-1^End of block was not designated"
.;STORE INFO IN PARSE ARRAY
.S @PRSARR@(MESSNUM,BLOCK,BLOCKNUM,LINE)=XMRG
S @PRSARR@(MESSNUM,BLOCK,BLOCKNUM,LINE)=XMRG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPAR61 1828 printed Oct 16, 2024@18:26:56 Page 2
VAQPAR61 ;ALB/JRP - MESSAGE PARSING;28-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
BLOCK(PRSARR,MESSNUM,BLOCK,BLOCKNUM) ;PARSING OF VERSION 1.5 MESSAGE BLOCKS
+1 ;INPUT : PRSARR - Parsing array (full global reference)
+2 ; MESSNUM - Message number within transmission (not XMZ)
+3 ; (defaults to 1)
+4 ; BLOCK - Block name
+5 ; BLOCKNUM - Block number with message (defaults to 1)
+6 ; (As defined by MailMan)
+7 ; XMFROM, XMREC, XMZ
+8 ; (Declared in SERVER^VAQADM2)
+9 ; XMER, XMRG, XMPOS
+10 ;OUTPUT : XMER - Exit condition
+11 ; 0 = Success
+12 ; -1^Error_Text = Error
+13 ; XMPOS - Last line [number] read in transmission
+14 ; (if NULL end of transmission reached)
+15 ;
+16 ;NOTES : Parsing array will have the following format
+17 ; ARRAY(MESSNUM,BLOCK,BLOCKNUM,LineNumber) = Value
+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 IF ($GET(BLOCK)="")
SET XMER="-1^Did not pass block name"
QUIT
+25 if ($GET(BLOCKNUM)="")
SET BLOCKNUM=1
+26 SET XMER="-1^Block not supported"
+27 if ((BLOCK'="HEADER")&(BLOCK'="DOMAIN")&(BLOCK'="USER")&(BLOCK'="PATIENT")&(BLOCK'="SEGMENT")&(BLOCK'="COMMENT")&(BLOCK'="DATA")&(BLOCK'="DISPLAY"))
QUIT
+28 ;DECLARE VARIABLES
+29 NEW END,BLOCKEND,LINE
+30 SET XMER=0
+31 SET END=0
+32 SET BLOCKEND="$$"_BLOCK
+33 ;PARSE BLOCK
+34 FOR LINE=1:1
Begin DoDot:1
+35 XECUTE XMREC
+36 ;END OF BLOCK REACHED
+37 IF (XMRG=BLOCKEND)
SET XMER=0
SET END=1
QUIT
+38 ;REACHED END OF MAILMAN MESSAGE
+39 IF (XMER<0)
SET XMER="-1^End of block was not designated"
+40 ;STORE INFO IN PARSE ARRAY
+41 SET @PRSARR@(MESSNUM,BLOCK,BLOCKNUM,LINE)=XMRG
End DoDot:1
if ((XMER<0)!(END))
QUIT
+42 SET @PRSARR@(MESSNUM,BLOCK,BLOCKNUM,LINE)=XMRG
+43 QUIT
