- 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 Mar 13, 2025@21:30:41 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
