VistA-FOIAVistA/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON6.m

144 lines
4.3 KiB
Mathematica

VAQCON6 ;ALB/JRP - MESSAGE CONSTRUCTION;13-APR-93
;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
PATIENT(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT PATIENT 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 of 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,LINE,TYPE,X,NAME,PID,SSN,DOB,DFN,SENSITIV
N KEY1,KEY2,STRING,ENCRYPT,ENCSTR,NCRYPTON,USER
S LINE=OFFSET
;GET MESSAGE TYPE
S TMP=$$STATYPE^VAQCON1(TRANPTR)
Q:($P(TMP,"^",1)="-1") "-1^Could not determine status of message"
S TYPE=$P(TMP,"^",2)
Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
;DETERMINE IF ENCRYPTION IS TURNED ON
S ENCRYPT=$$TRANENC^VAQUTL3(TRANPTR,2)
S NCRYPTON=$S(ENCRYPT'="":1,1:0)
;SET UP EXECUTABLE CALL FOR ENCRYPTION ON
S:(ENCRYPT'="") ENCRYPT=("S ENCSTR="_ENCRYPT)
;SET UP EXECUTABLE CALL FOR ENCRYPTION OFF
S:(ENCRYPT="") ENCRYPT="S ENCSTR=STRING"
;DETERMINE CURRENT USER
S TMP=$$SENDER^VAQCON2(TRANPTR)
Q:($P(TMP,"^",1)="-1") "-1^Could not determine sender of message"
S USER=$P(TMP,"^",1)
;GET ENCRYPTION KEYS
S KEY1=$$NAMEKEY^VAQUTL3(USER,1)
S KEY2=$$NAMEKEY^VAQUTL3(USER,0)
;GET POINTER TO PATIENT FILE
S DFN=+$P($G(^VAT(394.61,TRANPTR,0)),"^",3)
;DETERMINE SENSITIVITY OF PATIENT
S SENSITIV=+$$GETSEN^VAQUTL97(DFN)
S:(SENSITIV<0) SENSITIV=0
;DETERMINE PATIENT INFO USING POINTER
I (DFN) D
.;GET INFO
.S TMP=$$PATINFO^VAQUTL1(DFN)
.;ON ERROR, GET INFO FROM TRANSACTION
.I (TMP<0) S DFN=0 Q
.S NAME=$P(TMP,"^",1)
.S SSN=$P(TMP,"^",2)
.S DOB=$P(TMP,"^",3)
.S PID=$P(TMP,"^",4)
.S SSN=$$DASHSSN^VAQUTL99(SSN)
.S DOB=$$DATE^VAQUTL99(DOB)
.S:(DOB="-1") DOB=""
.S DOB=$$DOBFMT^VAQUTL99(DOB,0)
;DETERMINE PATIENT INFO USING TRANSACTION
I ('DFN) D
.;GET NODE WITH PATIENT INFO ON IT
.S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
.S NAME=$P(TMP,"^",1)
.S SSN=$$DASHSSN^VAQUTL99($P(TMP,"^",2))
.S DOB=$$DOBFMT^VAQUTL99($P(TMP,"^",3),0)
.S PID=$P(TMP,"^",4)
Q:((NAME="")&(SSN="")&(PID="")) "-1^Patient information not contained in VAQ - TRANSACTION file"
;ENCRYPT NAME
S STRING=NAME
X ENCRYPT
S NAME=ENCSTR
;ENCRYPT PATIENT ID
S STRING=PID
X ENCRYPT
S PID=ENCSTR
;ENCRYPT SSN
S STRING=SSN
X ENCRYPT
S SSN=ENCSTR
;ENCRYPT DATE OF BIRTH
S STRING=DOB
X ENCRYPT
S DOB=ENCSTR
;ENCRYPT POINTER TO PATIENT
S STRING=DFN
X ENCRYPT
S DFN=ENCSTR
;ENCRYPT SENSITIVITY FLAG
S STRING=SENSITIV
X ENCRYPT
S SENSITIV=ENCSTR
;LINE 1
S TMP="$PATIENT"
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 2
S TMP=NCRYPTON
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 3
S TMP=NAME
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 4
S TMP=PID
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 5
S TMP=SSN
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 6
S TMP=DOB
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 7
S TMP=DFN
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 8
S TMP=SENSITIV
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 9
S TMP="$$PATIENT"
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
Q (LINE-OFFSET)