VAQCON0 ;ALB/JRP - MESSAGE CONSTRUCTION;14-APR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MESSAGE(TRANPTR,ROOT,MESSNUM,ARRAY,OFFSET) ;BUILD MESSAGE FOR TRANSACTION
;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
; ROOT - Location of Extraction Arrays (full global reference)
; MESSNUM - Message number to place message into
; (if 0, message will be placed in ARRAY)
; ARRAY - Array to store message in (full global reference)
; OFFSET - Where to begin placing information (defaults to 0)
;OUTPUT : N - Number of lines in message
; -1^Error_Text - Error
;NOTES : If MESSNUM=0, then the message will be placed into
; ARRAY(LineNumber)=Line_of_info
; If MESSNUM>0 then the message will be placed into
; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
; : The first subscript in ROOT must be the segment abbreviation
; (i.e. ROOT(SegmentAbbreviation)). This is required to
; identify the segment contained in a DATA or DISPLAY block.
;
;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 ROOT=$G(ROOT)
S MESSNUM=+$G(MESSNUM)
I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number or 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,X,Y,TMPROOT,LINE,TYPE,SEG,STATUS
S LINE=OFFSET
;GET MESSAGE STATUS & TYPE
S TMP=$$STATYPE^VAQCON1(TRANPTR)
Q:($P(TMP,"^",1)="-1") TMP
S STATUS=$P(TMP,"^",1)
S TYPE=$P(TMP,"^",2)
Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
;START PDX MESSAGE
S TMP="$MESSAGE"
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;HEADER BLOCK
S TMP=$$HEADER^VAQCON2(TRANPTR,MESSNUM,ARRAY,LINE)
Q:(+TMP=-1) TMP
S LINE=LINE+TMP
;DOMAIN BLOCK
S TMP=$$DOMAIN^VAQCON4(TRANPTR,MESSNUM,ARRAY,LINE)
Q:(+TMP=-1) TMP
S LINE=LINE+TMP
;ACK & RE-TRANSMIT COMPLETED
G:((TYPE="ACK")!(TYPE="RET")) MESSDONE
;USER BLOCK
S TMP=$$USER^VAQCON3(TRANPTR,MESSNUM,ARRAY,LINE)
Q:(+TMP=-1) TMP
S LINE=LINE+TMP
;PATIENT BLOCK
S TMP=$$PATIENT^VAQCON6(TRANPTR,MESSNUM,ARRAY,LINE)
Q:(+TMP=-1) TMP
S LINE=LINE+TMP
;SEGMENT BLOCK
S TMP=$$SEGMENT^VAQCON5(TRANPTR,MESSNUM,ARRAY,LINE)
Q:(+TMP=-1) TMP
S LINE=LINE+TMP
;REQUEST COMPLETED
G:(TYPE="REQ") MESSDONE
;COMMENT BLOCK
S TMP=$$COMMENT^VAQCON4(TRANPTR,MESSNUM,ARRAY,LINE)
Q:(+TMP=-1) TMP
S LINE=LINE+TMP
;PROCESSED REQUEST WITH NO DATA COMPLETED
I (TYPE="RES") G:((STATUS="VAQ-AMBIG")!(STATUS="VAQ-NTFND")!(STATUS="VAQ-REJ")) MESSDONE
;DATA BLOCKS
S SEG=""
I (ROOT'="") F S SEG=$O(@ROOT@(SEG)) Q:(SEG="") I $D(@ROOT@(SEG,"VALUE")) D Q:(+TMP=-1)
.;PLACE SEGMENT ABBREVIATION INTO ROOT
.S TMP=$P(ROOT,"(",1)
.S X=$P(ROOT,"(",2)
.S Y=$P(X,")",1)
.S:(Y="") TMPROOT=TMP_"("_$C(34)_SEG_$C(34)_")"
.S:(Y'="") TMPROOT=TMP_"("_Y_","_$C(34)_SEG_$C(34)_")"
.S:(ROOT="") TMPROOT=""
.S TMP=$$DATA^VAQCON7(TRANPTR,SEG,TMPROOT,MESSNUM,ARRAY,LINE)
.Q:(+TMP=-1)
.S LINE=LINE+TMP
Q:(+TMP=-1) TMP
;DISPLAY BLOCKS
S SEG=""
I (ROOT'="") F S SEG=$O(@ROOT@(SEG)) Q:(SEG="") I $D(@ROOT@(SEG,"DISPLAY")) D Q:(+TMP=-1)
.;PLACE SEGMENT ABBREVIATION INTO ROOT
.S TMP=$P(ROOT,"(",1)
.S X=$P(ROOT,"(",2)
.S Y=$P(X,")",1)
.S:(Y="") TMPROOT=TMP_"("_$C(34)_SEG_$C(34)_")"
.S:(Y'="") TMPROOT=TMP_"("_Y_","_$C(34)_SEG_$C(34)_")"
.S:(ROOT="") TMPROOT=""
.S TMP=$$DISPLAY^VAQCON8(TRANPTR,SEG,TMPROOT,0,"",MESSNUM,ARRAY,LINE)
.Q:(+TMP=-1)
.S LINE=LINE+TMP
Q:(+TMP=-1) TMP
MESSDONE ;END PDX MESSAGE
S TMP="$$MESSAGE"
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[HVAQCON0 3903 printed Dec 13, 2024@02:24:42 Page 2
VAQCON0 ;ALB/JRP - MESSAGE CONSTRUCTION;14-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MESSAGE(TRANPTR,ROOT,MESSNUM,ARRAY,OFFSET) ;BUILD MESSAGE FOR TRANSACTION
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
+2 ; ROOT - Location of Extraction Arrays (full global reference)
+3 ; MESSNUM - Message number to place message into
+4 ; (if 0, message will be placed in ARRAY)
+5 ; ARRAY - Array to store message in (full global reference)
+6 ; OFFSET - Where to begin placing information (defaults to 0)
+7 ;OUTPUT : N - Number of lines in message
+8 ; -1^Error_Text - Error
+9 ;NOTES : If MESSNUM=0, then the message will be placed into
+10 ; ARRAY(LineNumber)=Line_of_info
+11 ; If MESSNUM>0 then the message will be placed into
+12 ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
+13 ; : The first subscript in ROOT must be the segment abbreviation
+14 ; (i.e. ROOT(SegmentAbbreviation)). This is required to
+15 ; identify the segment contained in a DATA or DISPLAY block.
+16 ;
+17 ;CHECK INPUT
+18 SET TRANPTR=+$GET(TRANPTR)
+19 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
QUIT "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
+20 SET ROOT=$GET(ROOT)
+21 SET MESSNUM=+$GET(MESSNUM)
+22 IF (('MESSNUM)&($GET(ARRAY)=""))
QUIT "-1^Did not pass message number or reference to array"
+23 IF (MESSNUM)
if ('$DATA(^XMB(3.9,MESSNUM)))
QUIT "-1^Valid message number not passed"
+24 SET OFFSET=+$GET(OFFSET)
+25 ;DECLARE VARIABLES
+26 NEW TMP,X,Y,TMPROOT,LINE,TYPE,SEG,STATUS
+27 SET LINE=OFFSET
+28 ;GET MESSAGE STATUS & TYPE
+29 SET TMP=$$STATYPE^VAQCON1(TRANPTR)
+30 if ($PIECE(TMP,"^",1)="-1")
QUIT TMP
+31 SET STATUS=$PIECE(TMP,"^",1)
+32 SET TYPE=$PIECE(TMP,"^",2)
+33 if (TYPE="REC")
QUIT "-1^Transaction is being received, not transmitted"
+34 ;START PDX MESSAGE
+35 SET TMP="$MESSAGE"
+36 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+37 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+38 SET LINE=LINE+1
+39 ;HEADER BLOCK
+40 SET TMP=$$HEADER^VAQCON2(TRANPTR,MESSNUM,ARRAY,LINE)
+41 if (+TMP=-1)
QUIT TMP
+42 SET LINE=LINE+TMP
+43 ;DOMAIN BLOCK
+44 SET TMP=$$DOMAIN^VAQCON4(TRANPTR,MESSNUM,ARRAY,LINE)
+45 if (+TMP=-1)
QUIT TMP
+46 SET LINE=LINE+TMP
+47 ;ACK & RE-TRANSMIT COMPLETED
+48 if ((TYPE="ACK")!(TYPE="RET"))
GOTO MESSDONE
+49 ;USER BLOCK
+50 SET TMP=$$USER^VAQCON3(TRANPTR,MESSNUM,ARRAY,LINE)
+51 if (+TMP=-1)
QUIT TMP
+52 SET LINE=LINE+TMP
+53 ;PATIENT BLOCK
+54 SET TMP=$$PATIENT^VAQCON6(TRANPTR,MESSNUM,ARRAY,LINE)
+55 if (+TMP=-1)
QUIT TMP
+56 SET LINE=LINE+TMP
+57 ;SEGMENT BLOCK
+58 SET TMP=$$SEGMENT^VAQCON5(TRANPTR,MESSNUM,ARRAY,LINE)
+59 if (+TMP=-1)
QUIT TMP
+60 SET LINE=LINE+TMP
+61 ;REQUEST COMPLETED
+62 if (TYPE="REQ")
GOTO MESSDONE
+63 ;COMMENT BLOCK
+64 SET TMP=$$COMMENT^VAQCON4(TRANPTR,MESSNUM,ARRAY,LINE)
+65 if (+TMP=-1)
QUIT TMP
+66 SET LINE=LINE+TMP
+67 ;PROCESSED REQUEST WITH NO DATA COMPLETED
+68 IF (TYPE="RES")
if ((STATUS="VAQ-AMBIG")!(STATUS="VAQ-NTFND")!(STATUS="VAQ-REJ"))
GOTO MESSDONE
+69 ;DATA BLOCKS
+70 SET SEG=""
+71 IF (ROOT'="")
FOR
SET SEG=$ORDER(@ROOT@(SEG))
if (SEG="")
QUIT
IF $DATA(@ROOT@(SEG,"VALUE"))
Begin DoDot:1
+72 ;PLACE SEGMENT ABBREVIATION INTO ROOT
+73 SET TMP=$PIECE(ROOT,"(",1)
+74 SET X=$PIECE(ROOT,"(",2)
+75 SET Y=$PIECE(X,")",1)
+76 if (Y="")
SET TMPROOT=TMP_"("_$CHAR(34)_SEG_$CHAR(34)_")"
+77 if (Y'="")
SET TMPROOT=TMP_"("_Y_","_$CHAR(34)_SEG_$CHAR(34)_")"
+78 if (ROOT="")
SET TMPROOT=""
+79 SET TMP=$$DATA^VAQCON7(TRANPTR,SEG,TMPROOT,MESSNUM,ARRAY,LINE)
+80 if (+TMP=-1)
QUIT
+81 SET LINE=LINE+TMP
End DoDot:1
if (+TMP=-1)
QUIT
+82 if (+TMP=-1)
QUIT TMP
+83 ;DISPLAY BLOCKS
+84 SET SEG=""
+85 IF (ROOT'="")
FOR
SET SEG=$ORDER(@ROOT@(SEG))
if (SEG="")
QUIT
IF $DATA(@ROOT@(SEG,"DISPLAY"))
Begin DoDot:1
+86 ;PLACE SEGMENT ABBREVIATION INTO ROOT
+87 SET TMP=$PIECE(ROOT,"(",1)
+88 SET X=$PIECE(ROOT,"(",2)
+89 SET Y=$PIECE(X,")",1)
+90 if (Y="")
SET TMPROOT=TMP_"("_$CHAR(34)_SEG_$CHAR(34)_")"
+91 if (Y'="")
SET TMPROOT=TMP_"("_Y_","_$CHAR(34)_SEG_$CHAR(34)_")"
+92 if (ROOT="")
SET TMPROOT=""
+93 SET TMP=$$DISPLAY^VAQCON8(TRANPTR,SEG,TMPROOT,0,"",MESSNUM,ARRAY,LINE)
+94 if (+TMP=-1)
QUIT
+95 SET LINE=LINE+TMP
End DoDot:1
if (+TMP=-1)
QUIT
+96 if (+TMP=-1)
QUIT TMP
MESSDONE ;END PDX MESSAGE
+1 SET TMP="$$MESSAGE"
+2 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+3 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+4 SET LINE=LINE+1
+5 QUIT (LINE-OFFSET)
