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 Dec 13, 2024@02:24:44 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)
