VAQCON4.m

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)

 ;

COMMENT(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT COMMENT 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,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 ---VAQCON4   4688     printed  Mar 13, 2025@21:29:15                                                                                                                                                                                                     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      ;

COMMENT(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT COMMENT 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,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)