- 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 Mar 13, 2025@21:29:18 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)
