Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQCON2

VAQCON2.m

Go to the documentation of this file.
  1. VAQCON2 ;ALB/JRP - MESSAGE CONSTRUCTION;12-APR-93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. SENDER(TRAN) ;DETERMINE MESSAGE SENDER
  1. ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
  1. ;OUTPUT : Name_of_sender^DUZ_of_sender - Success
  1. ; Null - Error
  1. ;NOTE : Defaults to current user
  1. ;
  1. ;CHECK INPUT
  1. Q:('(+$G(TRAN))) ""
  1. Q:('$D(^VAT(394.61,TRAN))) ""
  1. ;DECLARE VARIABLES
  1. N TYPE,USER,TMP
  1. ;GET MESSAGE TYPE & STATUS
  1. S TMP=$$STATYPE^VAQCON1(TRAN)
  1. Q:($P(TMP,"^",1)="-1") ""
  1. S TYPE=$P(TMP,"^",2)
  1. Q:(TYPE="REC") ""
  1. ;DETERMINE CURRENT USER
  1. S USER=""
  1. S:((TYPE="ACK")!(TYPE="RET")) USER="PDX Server"
  1. S:(TYPE="REQ") USER=$P($G(^VAT(394.61,TRAN,"RQST1")),"^",2)
  1. S:((TYPE="RES")!(TYPE="UNS")) USER=$P($G(^VAT(394.61,TRAN,"ATHR1")),"^",2)
  1. I (USER="") D
  1. .S TMP=+$G(DUZ)
  1. .Q:('TMP)
  1. .S X=$P($G(^VA(200,TMP,0)),"^",1)
  1. .S USER=X
  1. Q:(USER="") ""
  1. S TMP=+$O(^VA(200,"B",USER,""))
  1. S:(('TMP)&(USER="PDX Server")) TMP=.5
  1. Q USER_"^"_TMP
  1. ;
  1. ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
  1. ; MESSNUM - Message number to place block into
  1. ; (if 0, block will be placed in ARRAY)
  1. ; ARRAY - Array to store block in (full global reference)
  1. ; OFFSET - Where to begin placing information (defaults to 0)
  1. ;OUTPUT : N - Number of lines in block
  1. ; -1^Error_Text - Error
  1. ;NOTES : If MESSNUM=0, then the block will be placed into
  1. ; ARRAY(LineNumber)=Line_of_info
  1. ; If MESSNUM>0 then the block will be placed into
  1. ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
  1. ;
  1. ;CHECK INPUT
  1. S TRANPTR=+$G(TRANPTR)
  1. Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
  1. S MESSNUM=+$G(MESSNUM)
  1. I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number or reference to array"
  1. I (MESSNUM) Q:('$D(^XMB(3.9,MESSNUM))) "-1^Valid message number not passed"
  1. S OFFSET=+$G(OFFSET)
  1. ;DECLARE VARIABLES
  1. N LINE,TYPE,STATUS,DATETIME,TRANNUM,ENCMTHD,PDXVER,TMP,X
  1. S LINE=OFFSET
  1. ;DETERMINE STATUS
  1. S TMP=$$STATYPE^VAQCON1(TRANPTR)
  1. Q:($P(TMP,"^",1)="-1") TMP
  1. S STATUS=$P(TMP,"^",1)
  1. ;DETERMINE MESSAGE TYPE
  1. S TYPE=$P(TMP,"^",2)
  1. Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
  1. ;GET VERSION NUMBER
  1. S PDXVER=$$PDXVER^VAQUTL1
  1. Q:(PDXVER<0) PDXVER
  1. ;DETERMINE TRANSACTION NUMBER
  1. S TMP=$G(^VAT(394.61,TRANPTR,0))
  1. ;DEFAULT TO LOCAL TRANSACTION NUMBER
  1. S TRANNUM=+TMP
  1. ;CHANGE TO REMOTE TRANSACTION IF NECCESSARY
  1. S:((TYPE="RES")!(TYPE="ACK")!(TYPE="RET")) TRANNUM=+$P(TMP,"^",6)
  1. Q:('TRANNUM) "-1^Could not determine remote transaction number"
  1. ;DETERMINE ENCRYPTION METHOD
  1. S ENCMTHD=$$TRANENC^VAQUTL3(TRANPTR,3)
  1. ;DETERMINE DATE/TIME
  1. S DATETIME=$$NOW^VAQUTL99
  1. ;BUILD HEADER
  1. ;LINE 1
  1. S TMP="$HEADER"
  1. S:('MESSNUM) @ARRAY@(LINE)=TMP
  1. S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1. S LINE=LINE+1
  1. ;LINE 2
  1. S TMP=TYPE
  1. S:('MESSNUM) @ARRAY@(LINE)=TMP
  1. S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1. S LINE=LINE+1
  1. ;LINE 3
  1. S TMP=STATUS
  1. S:('MESSNUM) @ARRAY@(LINE)=TMP
  1. S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1. S LINE=LINE+1
  1. ;LINE 4
  1. S TMP=PDXVER
  1. S:('MESSNUM) @ARRAY@(LINE)=TMP
  1. S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1. S LINE=LINE+1
  1. ;LINE 5
  1. S TMP=DATETIME
  1. S:('MESSNUM) @ARRAY@(LINE)=TMP
  1. S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1. S LINE=LINE+1
  1. ;LINE 6
  1. S TMP=$S('MESSNUM:"",1:MESSNUM)
  1. S:('MESSNUM) @ARRAY@(LINE)=TMP
  1. S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1. S LINE=LINE+1
  1. ;LINE 7
  1. S TMP=TRANNUM
  1. S:('MESSNUM) @ARRAY@(LINE)=TMP
  1. S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1. S LINE=LINE+1
  1. ;LINE 8
  1. S TMP=ENCMTHD
  1. S:('MESSNUM) @ARRAY@(LINE)=TMP
  1. S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1. S LINE=LINE+1
  1. ;LINE 9
  1. S TMP="$$HEADER"
  1. S:('MESSNUM) @ARRAY@(LINE)=TMP
  1. S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1. S LINE=LINE+1
  1. ;DONE
  1. Q (LINE-OFFSET)