VAQCON5 ;ALB/JRP - MESSAGE CONSTRUCTION;2-SEP-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
SEGMENT(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT SEGMENT BLOCK
;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
; MESSNUM - Message number to place block into
; (if 0, block will be placed in ARRAY)
; ARRAY - Array to store block in (full global reference)
; OFFSET - Where to begin placing information (defaults to 0)
;OUTPUT : N - Number of lines in block
; -1^Error_Text - Error
;NOTES : If MESSNUM=0, then the block will be placed into
; ARRAY(LineNumber)=Line_of_info
; If MESSNUM>0 then the block will be placed into
; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
;
;CHECK INPUT
S TRANPTR=+$G(TRANPTR)
Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
S MESSNUM=+$G(MESSNUM)
I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number of reference to array"
I (MESSNUM) Q:('$D(^XMB(3.9,MESSNUM))) "-1^Valid message number not passed"
S OFFSET=+$G(OFFSET)
;DECLARE VARIABLES
N TMP,LINE,SEGABB,SEGPTR,TYPE,X,SEGMNT,TIMLIM,OCCLIM,LOOP
S LINE=OFFSET
;LINE 1
S TMP="$SEGMENT"
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;SEGMENTS
S SEGMNT=0
F S SEGMNT=$O(^VAT(394.61,TRANPTR,"SEG",SEGMNT)) Q:('SEGMNT) D
.S TMP=$G(^VAT(394.61,TRANPTR,"SEG",SEGMNT,0))
.S SEGPTR=+TMP
.S TIMLIM=$P(TMP,"^",2)
.S OCCLIM=$P(TMP,"^",3)
.Q:('SEGPTR)
.S SEGABB=$P($G(^VAT(394.71,SEGPTR,0)),"^",2)
.Q:(SEGABB="")
.F LOOP=SEGABB,TIMLIM,OCCLIM D
..S:('MESSNUM) @ARRAY@(LINE)=LOOP
..S:(MESSNUM) X=$$ADDLINE^VAQCON1(LOOP,MESSNUM,LINE)
..S LINE=LINE+1
;LINE Z
S TMP="$$SEGMENT"
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
Q (LINE-OFFSET)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQCON5 1943 printed Dec 13, 2024@02:24:47 Page 2
VAQCON5 ;ALB/JRP - MESSAGE CONSTRUCTION;2-SEP-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
SEGMENT(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT SEGMENT BLOCK
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
+2 ; MESSNUM - Message number to place block into
+3 ; (if 0, block will be placed in ARRAY)
+4 ; ARRAY - Array to store block in (full global reference)
+5 ; OFFSET - Where to begin placing information (defaults to 0)
+6 ;OUTPUT : N - Number of lines in block
+7 ; -1^Error_Text - Error
+8 ;NOTES : If MESSNUM=0, then the block will be placed into
+9 ; ARRAY(LineNumber)=Line_of_info
+10 ; If MESSNUM>0 then the block will be placed into
+11 ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
+12 ;
+13 ;CHECK INPUT
+14 SET TRANPTR=+$GET(TRANPTR)
+15 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
QUIT "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
+16 SET MESSNUM=+$GET(MESSNUM)
+17 IF (('MESSNUM)&($GET(ARRAY)=""))
QUIT "-1^Did not pass message number of reference to array"
+18 IF (MESSNUM)
if ('$DATA(^XMB(3.9,MESSNUM)))
QUIT "-1^Valid message number not passed"
+19 SET OFFSET=+$GET(OFFSET)
+20 ;DECLARE VARIABLES
+21 NEW TMP,LINE,SEGABB,SEGPTR,TYPE,X,SEGMNT,TIMLIM,OCCLIM,LOOP
+22 SET LINE=OFFSET
+23 ;LINE 1
+24 SET TMP="$SEGMENT"
+25 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+26 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+27 SET LINE=LINE+1
+28 ;SEGMENTS
+29 SET SEGMNT=0
+30 FOR
SET SEGMNT=$ORDER(^VAT(394.61,TRANPTR,"SEG",SEGMNT))
if ('SEGMNT)
QUIT
Begin DoDot:1
+31 SET TMP=$GET(^VAT(394.61,TRANPTR,"SEG",SEGMNT,0))
+32 SET SEGPTR=+TMP
+33 SET TIMLIM=$PIECE(TMP,"^",2)
+34 SET OCCLIM=$PIECE(TMP,"^",3)
+35 if ('SEGPTR)
QUIT
+36 SET SEGABB=$PIECE($GET(^VAT(394.71,SEGPTR,0)),"^",2)
+37 if (SEGABB="")
QUIT
+38 FOR LOOP=SEGABB,TIMLIM,OCCLIM
Begin DoDot:2
+39 if ('MESSNUM)
SET @ARRAY@(LINE)=LOOP
+40 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(LOOP,MESSNUM,LINE)
+41 SET LINE=LINE+1
End DoDot:2
End DoDot:1
+42 ;LINE Z
+43 SET TMP="$$SEGMENT"
+44 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+45 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+46 SET LINE=LINE+1
+47 QUIT (LINE-OFFSET)
