- VAQCON2 ;ALB/JRP - MESSAGE CONSTRUCTION;12-APR-93
- ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- SENDER(TRAN) ;DETERMINE MESSAGE SENDER
- ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
- ;OUTPUT : Name_of_sender^DUZ_of_sender - Success
- ; Null - Error
- ;NOTE : Defaults to current user
- ;
- ;CHECK INPUT
- Q:('(+$G(TRAN))) ""
- Q:('$D(^VAT(394.61,TRAN))) ""
- ;DECLARE VARIABLES
- N TYPE,USER,TMP
- ;GET MESSAGE TYPE & STATUS
- S TMP=$$STATYPE^VAQCON1(TRAN)
- Q:($P(TMP,"^",1)="-1") ""
- S TYPE=$P(TMP,"^",2)
- Q:(TYPE="REC") ""
- ;DETERMINE CURRENT USER
- S USER=""
- S:((TYPE="ACK")!(TYPE="RET")) USER="PDX Server"
- S:(TYPE="REQ") USER=$P($G(^VAT(394.61,TRAN,"RQST1")),"^",2)
- S:((TYPE="RES")!(TYPE="UNS")) USER=$P($G(^VAT(394.61,TRAN,"ATHR1")),"^",2)
- I (USER="") D
- .S TMP=+$G(DUZ)
- .Q:('TMP)
- .S X=$P($G(^VA(200,TMP,0)),"^",1)
- .S USER=X
- Q:(USER="") ""
- S TMP=+$O(^VA(200,"B",USER,""))
- S:(('TMP)&(USER="PDX Server")) TMP=.5
- Q USER_"^"_TMP
- ;
- ;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 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 LINE,TYPE,STATUS,DATETIME,TRANNUM,ENCMTHD,PDXVER,TMP,X
- S LINE=OFFSET
- ;DETERMINE STATUS
- S TMP=$$STATYPE^VAQCON1(TRANPTR)
- Q:($P(TMP,"^",1)="-1") TMP
- S STATUS=$P(TMP,"^",1)
- ;DETERMINE MESSAGE TYPE
- S TYPE=$P(TMP,"^",2)
- Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
- ;GET VERSION NUMBER
- S PDXVER=$$PDXVER^VAQUTL1
- Q:(PDXVER<0) PDXVER
- ;DETERMINE TRANSACTION NUMBER
- S TMP=$G(^VAT(394.61,TRANPTR,0))
- ;DEFAULT TO LOCAL TRANSACTION NUMBER
- S TRANNUM=+TMP
- ;CHANGE TO REMOTE TRANSACTION IF NECCESSARY
- S:((TYPE="RES")!(TYPE="ACK")!(TYPE="RET")) TRANNUM=+$P(TMP,"^",6)
- Q:('TRANNUM) "-1^Could not determine remote transaction number"
- ;DETERMINE ENCRYPTION METHOD
- S ENCMTHD=$$TRANENC^VAQUTL3(TRANPTR,3)
- ;DETERMINE DATE/TIME
- S DATETIME=$$NOW^VAQUTL99
- ;BUILD HEADER
- ;LINE 1
- S TMP="$HEADER"
- S:('MESSNUM) @ARRAY@(LINE)=TMP
- S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- S LINE=LINE+1
- ;LINE 2
- S TMP=TYPE
- S:('MESSNUM) @ARRAY@(LINE)=TMP
- S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- S LINE=LINE+1
- ;LINE 3
- S TMP=STATUS
- S:('MESSNUM) @ARRAY@(LINE)=TMP
- S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- S LINE=LINE+1
- ;LINE 4
- S TMP=PDXVER
- S:('MESSNUM) @ARRAY@(LINE)=TMP
- S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- S LINE=LINE+1
- ;LINE 5
- S TMP=DATETIME
- S:('MESSNUM) @ARRAY@(LINE)=TMP
- S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- S LINE=LINE+1
- ;LINE 6
- S TMP=$S('MESSNUM:"",1:MESSNUM)
- S:('MESSNUM) @ARRAY@(LINE)=TMP
- S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- S LINE=LINE+1
- ;LINE 7
- S TMP=TRANNUM
- S:('MESSNUM) @ARRAY@(LINE)=TMP
- S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- S LINE=LINE+1
- ;LINE 8
- S TMP=ENCMTHD
- S:('MESSNUM) @ARRAY@(LINE)=TMP
- S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- S LINE=LINE+1
- ;LINE 9
- S TMP="$$HEADER"
- S:('MESSNUM) @ARRAY@(LINE)=TMP
- S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- S LINE=LINE+1
- ;DONE
- Q (LINE-OFFSET)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQCON2 4042 printed Feb 18, 2025@23:50:47 Page 2
- VAQCON2 ;ALB/JRP - MESSAGE CONSTRUCTION;12-APR-93
- +1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- SENDER(TRAN) ;DETERMINE MESSAGE SENDER
- +1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
- +2 ;OUTPUT : Name_of_sender^DUZ_of_sender - Success
- +3 ; Null - Error
- +4 ;NOTE : Defaults to current user
- +5 ;
- +6 ;CHECK INPUT
- +7 if ('(+$GET(TRAN)))
- QUIT ""
- +8 if ('$DATA(^VAT(394.61,TRAN)))
- QUIT ""
- +9 ;DECLARE VARIABLES
- +10 NEW TYPE,USER,TMP
- +11 ;GET MESSAGE TYPE & STATUS
- +12 SET TMP=$$STATYPE^VAQCON1(TRAN)
- +13 if ($PIECE(TMP,"^",1)="-1")
- QUIT ""
- +14 SET TYPE=$PIECE(TMP,"^",2)
- +15 if (TYPE="REC")
- QUIT ""
- +16 ;DETERMINE CURRENT USER
- +17 SET USER=""
- +18 if ((TYPE="ACK")!(TYPE="RET"))
- SET USER="PDX Server"
- +19 if (TYPE="REQ")
- SET USER=$PIECE($GET(^VAT(394.61,TRAN,"RQST1")),"^",2)
- +20 if ((TYPE="RES")!(TYPE="UNS"))
- SET USER=$PIECE($GET(^VAT(394.61,TRAN,"ATHR1")),"^",2)
- +21 IF (USER="")
- Begin DoDot:1
- +22 SET TMP=+$GET(DUZ)
- +23 if ('TMP)
- QUIT
- +24 SET X=$PIECE($GET(^VA(200,TMP,0)),"^",1)
- +25 SET USER=X
- End DoDot:1
- +26 if (USER="")
- QUIT ""
- +27 SET TMP=+$ORDER(^VA(200,"B",USER,""))
- +28 if (('TMP)&(USER="PDX Server"))
- SET TMP=.5
- +29 QUIT USER_"^"_TMP
- +30 ;
- +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 or 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 LINE,TYPE,STATUS,DATETIME,TRANNUM,ENCMTHD,PDXVER,TMP,X
- +22 SET LINE=OFFSET
- +23 ;DETERMINE STATUS
- +24 SET TMP=$$STATYPE^VAQCON1(TRANPTR)
- +25 if ($PIECE(TMP,"^",1)="-1")
- QUIT TMP
- +26 SET STATUS=$PIECE(TMP,"^",1)
- +27 ;DETERMINE MESSAGE TYPE
- +28 SET TYPE=$PIECE(TMP,"^",2)
- +29 if (TYPE="REC")
- QUIT "-1^Transaction is being received, not transmitted"
- +30 ;GET VERSION NUMBER
- +31 SET PDXVER=$$PDXVER^VAQUTL1
- +32 if (PDXVER<0)
- QUIT PDXVER
- +33 ;DETERMINE TRANSACTION NUMBER
- +34 SET TMP=$GET(^VAT(394.61,TRANPTR,0))
- +35 ;DEFAULT TO LOCAL TRANSACTION NUMBER
- +36 SET TRANNUM=+TMP
- +37 ;CHANGE TO REMOTE TRANSACTION IF NECCESSARY
- +38 if ((TYPE="RES")!(TYPE="ACK")!(TYPE="RET"))
- SET TRANNUM=+$PIECE(TMP,"^",6)
- +39 if ('TRANNUM)
- QUIT "-1^Could not determine remote transaction number"
- +40 ;DETERMINE ENCRYPTION METHOD
- +41 SET ENCMTHD=$$TRANENC^VAQUTL3(TRANPTR,3)
- +42 ;DETERMINE DATE/TIME
- +43 SET DATETIME=$$NOW^VAQUTL99
- +44 ;BUILD HEADER
- +45 ;LINE 1
- +46 SET TMP="$HEADER"
- +47 if ('MESSNUM)
- SET @ARRAY@(LINE)=TMP
- +48 if (MESSNUM)
- SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- +49 SET LINE=LINE+1
- +50 ;LINE 2
- +51 SET TMP=TYPE
- +52 if ('MESSNUM)
- SET @ARRAY@(LINE)=TMP
- +53 if (MESSNUM)
- SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- +54 SET LINE=LINE+1
- +55 ;LINE 3
- +56 SET TMP=STATUS
- +57 if ('MESSNUM)
- SET @ARRAY@(LINE)=TMP
- +58 if (MESSNUM)
- SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- +59 SET LINE=LINE+1
- +60 ;LINE 4
- +61 SET TMP=PDXVER
- +62 if ('MESSNUM)
- SET @ARRAY@(LINE)=TMP
- +63 if (MESSNUM)
- SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- +64 SET LINE=LINE+1
- +65 ;LINE 5
- +66 SET TMP=DATETIME
- +67 if ('MESSNUM)
- SET @ARRAY@(LINE)=TMP
- +68 if (MESSNUM)
- SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- +69 SET LINE=LINE+1
- +70 ;LINE 6
- +71 SET TMP=$SELECT('MESSNUM:"",1:MESSNUM)
- +72 if ('MESSNUM)
- SET @ARRAY@(LINE)=TMP
- +73 if (MESSNUM)
- SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- +74 SET LINE=LINE+1
- +75 ;LINE 7
- +76 SET TMP=TRANNUM
- +77 if ('MESSNUM)
- SET @ARRAY@(LINE)=TMP
- +78 if (MESSNUM)
- SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- +79 SET LINE=LINE+1
- +80 ;LINE 8
- +81 SET TMP=ENCMTHD
- +82 if ('MESSNUM)
- SET @ARRAY@(LINE)=TMP
- +83 if (MESSNUM)
- SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- +84 SET LINE=LINE+1
- +85 ;LINE 9
- +86 SET TMP="$$HEADER"
- +87 if ('MESSNUM)
- SET @ARRAY@(LINE)=TMP
- +88 if (MESSNUM)
- SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
- +89 SET LINE=LINE+1
- +90 ;DONE
- +91 QUIT (LINE-OFFSET)