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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQCON6 4502 printed Mar 13, 2025@21:29:17 Page 2
VAQCON6 ;ALB/JRP - MESSAGE CONSTRUCTION;13-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
PATIENT(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT PATIENT BLOCK
+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 of 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 TMP,LINE,TYPE,X,NAME,PID,SSN,DOB,DFN,SENSITIV
+22 NEW KEY1,KEY2,STRING,ENCRYPT,ENCSTR,NCRYPTON,USER
+23 SET LINE=OFFSET
+24 ;GET MESSAGE TYPE
+25 SET TMP=$$STATYPE^VAQCON1(TRANPTR)
+26 if ($PIECE(TMP,"^",1)="-1")
QUIT "-1^Could not determine status of message"
+27 SET TYPE=$PIECE(TMP,"^",2)
+28 if (TYPE="REC")
QUIT "-1^Transaction is being received, not transmitted"
+29 ;DETERMINE IF ENCRYPTION IS TURNED ON
+30 SET ENCRYPT=$$TRANENC^VAQUTL3(TRANPTR,2)
+31 SET NCRYPTON=$SELECT(ENCRYPT'="":1,1:0)
+32 ;SET UP EXECUTABLE CALL FOR ENCRYPTION ON
+33 if (ENCRYPT'="")
SET ENCRYPT=("S ENCSTR="_ENCRYPT)
+34 ;SET UP EXECUTABLE CALL FOR ENCRYPTION OFF
+35 if (ENCRYPT="")
SET ENCRYPT="S ENCSTR=STRING"
+36 ;DETERMINE CURRENT USER
+37 SET TMP=$$SENDER^VAQCON2(TRANPTR)
+38 if ($PIECE(TMP,"^",1)="-1")
QUIT "-1^Could not determine sender of message"
+39 SET USER=$PIECE(TMP,"^",1)
+40 ;GET ENCRYPTION KEYS
+41 SET KEY1=$$NAMEKEY^VAQUTL3(USER,1)
+42 SET KEY2=$$NAMEKEY^VAQUTL3(USER,0)
+43 ;GET POINTER TO PATIENT FILE
+44 SET DFN=+$PIECE($GET(^VAT(394.61,TRANPTR,0)),"^",3)
+45 ;DETERMINE SENSITIVITY OF PATIENT
+46 SET SENSITIV=+$$GETSEN^VAQUTL97(DFN)
+47 if (SENSITIV<0)
SET SENSITIV=0
+48 ;DETERMINE PATIENT INFO USING POINTER
+49 IF (DFN)
Begin DoDot:1
+50 ;GET INFO
+51 SET TMP=$$PATINFO^VAQUTL1(DFN)
+52 ;ON ERROR, GET INFO FROM TRANSACTION
+53 IF (TMP<0)
SET DFN=0
QUIT
+54 SET NAME=$PIECE(TMP,"^",1)
+55 SET SSN=$PIECE(TMP,"^",2)
+56 SET DOB=$PIECE(TMP,"^",3)
+57 SET PID=$PIECE(TMP,"^",4)
+58 SET SSN=$$DASHSSN^VAQUTL99(SSN)
+59 SET DOB=$$DATE^VAQUTL99(DOB)
+60 if (DOB="-1")
SET DOB=""
+61 SET DOB=$$DOBFMT^VAQUTL99(DOB,0)
End DoDot:1
+62 ;DETERMINE PATIENT INFO USING TRANSACTION
+63 IF ('DFN)
Begin DoDot:1
+64 ;GET NODE WITH PATIENT INFO ON IT
+65 SET TMP=$GET(^VAT(394.61,TRANPTR,"QRY"))
+66 SET NAME=$PIECE(TMP,"^",1)
+67 SET SSN=$$DASHSSN^VAQUTL99($PIECE(TMP,"^",2))
+68 SET DOB=$$DOBFMT^VAQUTL99($PIECE(TMP,"^",3),0)
+69 SET PID=$PIECE(TMP,"^",4)
End DoDot:1
+70 if ((NAME="")&(SSN="")&(PID=""))
QUIT "-1^Patient information not contained in VAQ - TRANSACTION file"
+71 ;ENCRYPT NAME
+72 SET STRING=NAME
+73 XECUTE ENCRYPT
+74 SET NAME=ENCSTR
+75 ;ENCRYPT PATIENT ID
+76 SET STRING=PID
+77 XECUTE ENCRYPT
+78 SET PID=ENCSTR
+79 ;ENCRYPT SSN
+80 SET STRING=SSN
+81 XECUTE ENCRYPT
+82 SET SSN=ENCSTR
+83 ;ENCRYPT DATE OF BIRTH
+84 SET STRING=DOB
+85 XECUTE ENCRYPT
+86 SET DOB=ENCSTR
+87 ;ENCRYPT POINTER TO PATIENT
+88 SET STRING=DFN
+89 XECUTE ENCRYPT
+90 SET DFN=ENCSTR
+91 ;ENCRYPT SENSITIVITY FLAG
+92 SET STRING=SENSITIV
+93 XECUTE ENCRYPT
+94 SET SENSITIV=ENCSTR
+95 ;LINE 1
+96 SET TMP="$PATIENT"
+97 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+98 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+99 SET LINE=LINE+1
+100 ;LINE 2
+101 SET TMP=NCRYPTON
+102 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+103 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+104 SET LINE=LINE+1
+105 ;LINE 3
+106 SET TMP=NAME
+107 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+108 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+109 SET LINE=LINE+1
+110 ;LINE 4
+111 SET TMP=PID
+112 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+113 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+114 SET LINE=LINE+1
+115 ;LINE 5
+116 SET TMP=SSN
+117 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+118 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+119 SET LINE=LINE+1
+120 ;LINE 6
+121 SET TMP=DOB
+122 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+123 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+124 SET LINE=LINE+1
+125 ;LINE 7
+126 SET TMP=DFN
+127 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+128 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+129 SET LINE=LINE+1
+130 ;LINE 8
+131 SET TMP=SENSITIV
+132 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+133 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+134 SET LINE=LINE+1
+135 ;LINE 9
+136 SET TMP="$$PATIENT"
+137 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+138 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+139 SET LINE=LINE+1
+140 QUIT (LINE-OFFSET)
