VAQCON7 ;ALB/JRP - MESSAGE CONSTRUCTION;13-APR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DATA(TRANPTR,SEGABB,DATARR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT DATA BLOCK
;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
; SEGABB - Segment abbreviation for segment
; DATARR - Location of Extraction Array (full global reference)
; 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"
Q:($G(SEGABB)="") "-1^Did not pass segment abbreviation"
Q:($G(DATARR)="") "-1^Did not pass location of Extraction Array"
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,ID,FILE,FIELD,SEQ,NCRYPTON,X
S LINE=OFFSET
;DETERMINE IF ENCRYPTION WAS TURNED ON
S NCRYPTON=$$TRANENC^VAQUTL3(TRANPTR,0)
;LINE 1
S TMP="$DATA"
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 2
S TMP=SEGABB
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LOOP THROUGH EACH FILE
S FILE=""
F S FILE=$O(@DATARR@("VALUE",FILE)) Q:(FILE="") D
.;LOOP THROUGH EACH FIELD
.S FIELD=""
.F S FIELD=$O(@DATARR@("VALUE",FILE,FIELD)) Q:(FIELD="") D
..;COUNT NUMBER OF VALUES (IF MORE THAN ONE)
..S SEQ=1
..I (+$O(@DATARR@("VALUE",FILE,FIELD,0))) D
...S SEQ=0
...S X=""
...F S X=$O(@DATARR@("VALUE",FILE,FIELD,X)) Q:(X="") S SEQ=SEQ+1
..;STORE NON-REPEATED INFO
..;DETERMINE IF FIELD WAS ENCRYPTED
..S X=0
..S:(NCRYPTON) X=+$$NCRPFLD^VAQUTL2(FILE,FIELD)
..S TMP=X_"^"_FILE_"^"_FIELD_"^"_SEQ
..S:('MESSNUM) @ARRAY@(LINE)=TMP
..S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
..S LINE=LINE+1
..;LOOP THROUGH EACH VALUE
..S SEQ=""
..F S SEQ=$O(@DATARR@("VALUE",FILE,FIELD,SEQ)) Q:(SEQ="") D
...S TMP=$G(@DATARR@("VALUE",FILE,FIELD,SEQ))
...S:('MESSNUM) @ARRAY@(LINE)=TMP
...S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
...S LINE=LINE+1
...S TMP=$G(@DATARR@("ID",FILE,FIELD,SEQ))
...S:('MESSNUM) @ARRAY@(LINE)=TMP
...S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
...S LINE=LINE+1
;LINE Z
S TMP="$$DATA"
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[HVAQCON7 3047 printed Sep 23, 2025@20:00:28 Page 2
VAQCON7 ;ALB/JRP - MESSAGE CONSTRUCTION;13-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DATA(TRANPTR,SEGABB,DATARR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT DATA BLOCK
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
+2 ; SEGABB - Segment abbreviation for segment
+3 ; DATARR - Location of Extraction Array (full global reference)
+4 ; MESSNUM - Message number to place block into
+5 ; (if 0, block will be placed in ARRAY)
+6 ; ARRAY - Array to store block in (full global reference)
+7 ; OFFSET - Where to begin placing information (defaults to 0)
+8 ;OUTPUT : N - Number of lines in block
+9 ; -1^Error_Text - Error
+10 ;NOTES : If MESSNUM=0, then the block will be placed into
+11 ; ARRAY(LineNumber)=Line_of_info
+12 ; If MESSNUM>0 then the block will be placed into
+13 ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
+14 ;
+15 ;CHECK INPUT
+16 SET TRANPTR=+$GET(TRANPTR)
+17 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
QUIT "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
+18 if ($GET(SEGABB)="")
QUIT "-1^Did not pass segment abbreviation"
+19 if ($GET(DATARR)="")
QUIT "-1^Did not pass location of Extraction Array"
+20 SET MESSNUM=+$GET(MESSNUM)
+21 IF (('MESSNUM)&($GET(ARRAY)=""))
QUIT "-1^Did not pass message number of reference to array"
+22 IF (MESSNUM)
if ('$DATA(^XMB(3.9,MESSNUM)))
QUIT "-1^Valid message number not passed"
+23 SET OFFSET=+$GET(OFFSET)
+24 ;DECLARE VARIABLES
+25 NEW TMP,LINE,ID,FILE,FIELD,SEQ,NCRYPTON,X
+26 SET LINE=OFFSET
+27 ;DETERMINE IF ENCRYPTION WAS TURNED ON
+28 SET NCRYPTON=$$TRANENC^VAQUTL3(TRANPTR,0)
+29 ;LINE 1
+30 SET TMP="$DATA"
+31 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+32 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+33 SET LINE=LINE+1
+34 ;LINE 2
+35 SET TMP=SEGABB
+36 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+37 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+38 SET LINE=LINE+1
+39 ;LOOP THROUGH EACH FILE
+40 SET FILE=""
+41 FOR
SET FILE=$ORDER(@DATARR@("VALUE",FILE))
if (FILE="")
QUIT
Begin DoDot:1
+42 ;LOOP THROUGH EACH FIELD
+43 SET FIELD=""
+44 FOR
SET FIELD=$ORDER(@DATARR@("VALUE",FILE,FIELD))
if (FIELD="")
QUIT
Begin DoDot:2
+45 ;COUNT NUMBER OF VALUES (IF MORE THAN ONE)
+46 SET SEQ=1
+47 IF (+$ORDER(@DATARR@("VALUE",FILE,FIELD,0)))
Begin DoDot:3
+48 SET SEQ=0
+49 SET X=""
+50 FOR
SET X=$ORDER(@DATARR@("VALUE",FILE,FIELD,X))
if (X="")
QUIT
SET SEQ=SEQ+1
End DoDot:3
+51 ;STORE NON-REPEATED INFO
+52 ;DETERMINE IF FIELD WAS ENCRYPTED
+53 SET X=0
+54 if (NCRYPTON)
SET X=+$$NCRPFLD^VAQUTL2(FILE,FIELD)
+55 SET TMP=X_"^"_FILE_"^"_FIELD_"^"_SEQ
+56 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+57 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+58 SET LINE=LINE+1
+59 ;LOOP THROUGH EACH VALUE
+60 SET SEQ=""
+61 FOR
SET SEQ=$ORDER(@DATARR@("VALUE",FILE,FIELD,SEQ))
if (SEQ="")
QUIT
Begin DoDot:3
+62 SET TMP=$GET(@DATARR@("VALUE",FILE,FIELD,SEQ))
+63 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+64 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+65 SET LINE=LINE+1
+66 SET TMP=$GET(@DATARR@("ID",FILE,FIELD,SEQ))
+67 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+68 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+69 SET LINE=LINE+1
End DoDot:3
End DoDot:2
End DoDot:1
+70 ;LINE Z
+71 SET TMP="$$DATA"
+72 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+73 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+74 SET LINE=LINE+1
+75 QUIT (LINE-OFFSET)
