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