VAQCON4 ;ALB/JRP - MESSAGE CONSTRUCTION;12-APR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DOMAIN(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT DOMAIN 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,TYPE,LINE,X,SENDTO,SENTFRM,STATUS
S LINE=OFFSET
;DETERMINE MESSAGE STATUS & TYPE (USED TO DETERMINE RECEIVER OF MESSAGE)
S TMP=$$STATYPE^VAQCON1(TRANPTR)
S STATUS=$P(TMP,"^",1)
S TYPE=$P(TMP,"^",2)
Q:(STATUS="-1") "-1^Could not determine message status or type"
Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
;DETERMINE RETURN ADDRESS
S TMP=+$O(^VAT(394.81,0))
Q:('TMP) "-1^Could not determine return address"
S X=+$P($G(^VAT(394.81,TMP,0)),"^",2)
Q:('X) "-1^Could not determine return address"
S SENTFRM=$P($G(^DIC(4.2,X,0)),"^",1)
Q:(SENTFRM="") "-1^Could not determine return address"
;DETERMINE DESTINATION FOR MESSAGE
S SENDTO=""
S:((TYPE="REQ")!(TYPE="RET")) SENDTO=$P($G(^VAT(394.61,TRANPTR,"ATHR2")),"^",2)
S:(TYPE="RES")!(TYPE="UNS") SENDTO=$P($G(^VAT(394.61,TRANPTR,"RQST2")),"^",2)
S:((TYPE="ACK")&(STATUS="VAQ-UNACK")) SENDTO=$P($G(^VAT(394.61,TRANPTR,"ATHR2")),"^",2)
S:((TYPE="ACK")&(STATUS="VAQ-RQACK")) SENDTO=$P($G(^VAT(394.61,TRANPTR,"RQST2")),"^",2)
Q:(SENDTO="") "-1^Could not determine destination of message"
;LINE 1
S TMP="$DOMAIN"
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 2
S TMP=SENTFRM
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 3
S TMP=SENDTO
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 4
S TMP="$$DOMAIN"
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
Q (LINE-OFFSET)
;
;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,COMLINE,TYPE,X
S LINE=OFFSET
;DETERMINE MESSAGE TYPE
S TMP=$$STATYPE^VAQCON1(TRANPTR)
Q:($P(TMP,"^",1)="-1") "-1^Could not determine message type"
S TYPE=$P(TMP,"^",2)
Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
;LINE 1
S TMP="$COMMENT"
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;COMMENT LINES
I ((TYPE="RES")!(TYPE="UNS")) D
.S COMLINE=0
.F S COMLINE=$O(^VAT(394.61,TRANPTR,"CMNT",COMLINE)) Q:('COMLINE) D
..S TMP=$G(^VAT(394.61,TRANPTR,"CMNT",COMLINE,0))
..S:('MESSNUM) @ARRAY@(LINE)=TMP
..S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
..S LINE=LINE+1
;LINE Z
S TMP="$$COMMENT"
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[HVAQCON4 4688 printed Sep 23, 2025@20:00:25 Page 2
VAQCON4 ;ALB/JRP - MESSAGE CONSTRUCTION;12-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DOMAIN(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT DOMAIN 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,TYPE,LINE,X,SENDTO,SENTFRM,STATUS
+22 SET LINE=OFFSET
+23 ;DETERMINE MESSAGE STATUS & TYPE (USED TO DETERMINE RECEIVER OF MESSAGE)
+24 SET TMP=$$STATYPE^VAQCON1(TRANPTR)
+25 SET STATUS=$PIECE(TMP,"^",1)
+26 SET TYPE=$PIECE(TMP,"^",2)
+27 if (STATUS="-1")
QUIT "-1^Could not determine message status or type"
+28 if (TYPE="REC")
QUIT "-1^Transaction is being received, not transmitted"
+29 ;DETERMINE RETURN ADDRESS
+30 SET TMP=+$ORDER(^VAT(394.81,0))
+31 if ('TMP)
QUIT "-1^Could not determine return address"
+32 SET X=+$PIECE($GET(^VAT(394.81,TMP,0)),"^",2)
+33 if ('X)
QUIT "-1^Could not determine return address"
+34 SET SENTFRM=$PIECE($GET(^DIC(4.2,X,0)),"^",1)
+35 if (SENTFRM="")
QUIT "-1^Could not determine return address"
+36 ;DETERMINE DESTINATION FOR MESSAGE
+37 SET SENDTO=""
+38 if ((TYPE="REQ")!(TYPE="RET"))
SET SENDTO=$PIECE($GET(^VAT(394.61,TRANPTR,"ATHR2")),"^",2)
+39 if (TYPE="RES")!(TYPE="UNS")
SET SENDTO=$PIECE($GET(^VAT(394.61,TRANPTR,"RQST2")),"^",2)
+40 if ((TYPE="ACK")&(STATUS="VAQ-UNACK"))
SET SENDTO=$PIECE($GET(^VAT(394.61,TRANPTR,"ATHR2")),"^",2)
+41 if ((TYPE="ACK")&(STATUS="VAQ-RQACK"))
SET SENDTO=$PIECE($GET(^VAT(394.61,TRANPTR,"RQST2")),"^",2)
+42 if (SENDTO="")
QUIT "-1^Could not determine destination of message"
+43 ;LINE 1
+44 SET TMP="$DOMAIN"
+45 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+46 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+47 SET LINE=LINE+1
+48 ;LINE 2
+49 SET TMP=SENTFRM
+50 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+51 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+52 SET LINE=LINE+1
+53 ;LINE 3
+54 SET TMP=SENDTO
+55 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+56 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+57 SET LINE=LINE+1
+58 ;LINE 4
+59 SET TMP="$$DOMAIN"
+60 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+61 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+62 SET LINE=LINE+1
+63 QUIT (LINE-OFFSET)
+64 ;
+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,COMLINE,TYPE,X
+22 SET LINE=OFFSET
+23 ;DETERMINE MESSAGE TYPE
+24 SET TMP=$$STATYPE^VAQCON1(TRANPTR)
+25 if ($PIECE(TMP,"^",1)="-1")
QUIT "-1^Could not determine message type"
+26 SET TYPE=$PIECE(TMP,"^",2)
+27 if (TYPE="REC")
QUIT "-1^Transaction is being received, not transmitted"
+28 ;LINE 1
+29 SET TMP="$COMMENT"
+30 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+31 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+32 SET LINE=LINE+1
+33 ;COMMENT LINES
+34 IF ((TYPE="RES")!(TYPE="UNS"))
Begin DoDot:1
+35 SET COMLINE=0
+36 FOR
SET COMLINE=$ORDER(^VAT(394.61,TRANPTR,"CMNT",COMLINE))
if ('COMLINE)
QUIT
Begin DoDot:2
+37 SET TMP=$GET(^VAT(394.61,TRANPTR,"CMNT",COMLINE,0))
+38 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+39 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+40 SET LINE=LINE+1
End DoDot:2
End DoDot:1
+41 ;LINE Z
+42 SET TMP="$$COMMENT"
+43 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+44 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+45 SET LINE=LINE+1
+46 QUIT (LINE-OFFSET)
