VAQCON5.m

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 ---VAQCON5   1943     printed  Apr 09, 2024@21:29:34                                                                                                                                                                                                     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)