126 lines
3.8 KiB
Mathematica
126 lines
3.8 KiB
Mathematica
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
|
|
;
|
|
HEADER(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT HEADER 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 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)
|