[613] | 1 | VAQCON6 ;ALB/JRP - MESSAGE CONSTRUCTION;13-APR-93
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
|
---|
| 3 | PATIENT(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT PATIENT BLOCK
|
---|
| 4 | ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
|
---|
| 5 | ; MESSNUM - Message number to place block into
|
---|
| 6 | ; (if 0, block will be placed in ARRAY)
|
---|
| 7 | ; ARRAY - Array to store block in (full global reference)
|
---|
| 8 | ; OFFSET - Where to begin placing information (defaults to 0)
|
---|
| 9 | ;OUTPUT : N - Number of lines in block
|
---|
| 10 | ; -1^Error_Text - Error
|
---|
| 11 | ;NOTES : If MESSNUM=0, then the block will be placed into
|
---|
| 12 | ; ARRAY(LineNumber)=Line_of_info
|
---|
| 13 | ; If MESSNUM>0 then the block will be placed into
|
---|
| 14 | ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
|
---|
| 15 | ;
|
---|
| 16 | ;CHECK INPUT
|
---|
| 17 | S TRANPTR=+$G(TRANPTR)
|
---|
| 18 | Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
|
---|
| 19 | S MESSNUM=+$G(MESSNUM)
|
---|
| 20 | I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number of reference to array"
|
---|
| 21 | I (MESSNUM) Q:('$D(^XMB(3.9,MESSNUM))) "-1^Valid message number not passed"
|
---|
| 22 | S OFFSET=+$G(OFFSET)
|
---|
| 23 | ;DECLARE VARIABLES
|
---|
| 24 | N TMP,LINE,TYPE,X,NAME,PID,SSN,DOB,DFN,SENSITIV
|
---|
| 25 | N KEY1,KEY2,STRING,ENCRYPT,ENCSTR,NCRYPTON,USER
|
---|
| 26 | S LINE=OFFSET
|
---|
| 27 | ;GET MESSAGE TYPE
|
---|
| 28 | S TMP=$$STATYPE^VAQCON1(TRANPTR)
|
---|
| 29 | Q:($P(TMP,"^",1)="-1") "-1^Could not determine status of message"
|
---|
| 30 | S TYPE=$P(TMP,"^",2)
|
---|
| 31 | Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
|
---|
| 32 | ;DETERMINE IF ENCRYPTION IS TURNED ON
|
---|
| 33 | S ENCRYPT=$$TRANENC^VAQUTL3(TRANPTR,2)
|
---|
| 34 | S NCRYPTON=$S(ENCRYPT'="":1,1:0)
|
---|
| 35 | ;SET UP EXECUTABLE CALL FOR ENCRYPTION ON
|
---|
| 36 | S:(ENCRYPT'="") ENCRYPT=("S ENCSTR="_ENCRYPT)
|
---|
| 37 | ;SET UP EXECUTABLE CALL FOR ENCRYPTION OFF
|
---|
| 38 | S:(ENCRYPT="") ENCRYPT="S ENCSTR=STRING"
|
---|
| 39 | ;DETERMINE CURRENT USER
|
---|
| 40 | S TMP=$$SENDER^VAQCON2(TRANPTR)
|
---|
| 41 | Q:($P(TMP,"^",1)="-1") "-1^Could not determine sender of message"
|
---|
| 42 | S USER=$P(TMP,"^",1)
|
---|
| 43 | ;GET ENCRYPTION KEYS
|
---|
| 44 | S KEY1=$$NAMEKEY^VAQUTL3(USER,1)
|
---|
| 45 | S KEY2=$$NAMEKEY^VAQUTL3(USER,0)
|
---|
| 46 | ;GET POINTER TO PATIENT FILE
|
---|
| 47 | S DFN=+$P($G(^VAT(394.61,TRANPTR,0)),"^",3)
|
---|
| 48 | ;DETERMINE SENSITIVITY OF PATIENT
|
---|
| 49 | S SENSITIV=+$$GETSEN^VAQUTL97(DFN)
|
---|
| 50 | S:(SENSITIV<0) SENSITIV=0
|
---|
| 51 | ;DETERMINE PATIENT INFO USING POINTER
|
---|
| 52 | I (DFN) D
|
---|
| 53 | .;GET INFO
|
---|
| 54 | .S TMP=$$PATINFO^VAQUTL1(DFN)
|
---|
| 55 | .;ON ERROR, GET INFO FROM TRANSACTION
|
---|
| 56 | .I (TMP<0) S DFN=0 Q
|
---|
| 57 | .S NAME=$P(TMP,"^",1)
|
---|
| 58 | .S SSN=$P(TMP,"^",2)
|
---|
| 59 | .S DOB=$P(TMP,"^",3)
|
---|
| 60 | .S PID=$P(TMP,"^",4)
|
---|
| 61 | .S SSN=$$DASHSSN^VAQUTL99(SSN)
|
---|
| 62 | .S DOB=$$DATE^VAQUTL99(DOB)
|
---|
| 63 | .S:(DOB="-1") DOB=""
|
---|
| 64 | .S DOB=$$DOBFMT^VAQUTL99(DOB,0)
|
---|
| 65 | ;DETERMINE PATIENT INFO USING TRANSACTION
|
---|
| 66 | I ('DFN) D
|
---|
| 67 | .;GET NODE WITH PATIENT INFO ON IT
|
---|
| 68 | .S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
|
---|
| 69 | .S NAME=$P(TMP,"^",1)
|
---|
| 70 | .S SSN=$$DASHSSN^VAQUTL99($P(TMP,"^",2))
|
---|
| 71 | .S DOB=$$DOBFMT^VAQUTL99($P(TMP,"^",3),0)
|
---|
| 72 | .S PID=$P(TMP,"^",4)
|
---|
| 73 | Q:((NAME="")&(SSN="")&(PID="")) "-1^Patient information not contained in VAQ - TRANSACTION file"
|
---|
| 74 | ;ENCRYPT NAME
|
---|
| 75 | S STRING=NAME
|
---|
| 76 | X ENCRYPT
|
---|
| 77 | S NAME=ENCSTR
|
---|
| 78 | ;ENCRYPT PATIENT ID
|
---|
| 79 | S STRING=PID
|
---|
| 80 | X ENCRYPT
|
---|
| 81 | S PID=ENCSTR
|
---|
| 82 | ;ENCRYPT SSN
|
---|
| 83 | S STRING=SSN
|
---|
| 84 | X ENCRYPT
|
---|
| 85 | S SSN=ENCSTR
|
---|
| 86 | ;ENCRYPT DATE OF BIRTH
|
---|
| 87 | S STRING=DOB
|
---|
| 88 | X ENCRYPT
|
---|
| 89 | S DOB=ENCSTR
|
---|
| 90 | ;ENCRYPT POINTER TO PATIENT
|
---|
| 91 | S STRING=DFN
|
---|
| 92 | X ENCRYPT
|
---|
| 93 | S DFN=ENCSTR
|
---|
| 94 | ;ENCRYPT SENSITIVITY FLAG
|
---|
| 95 | S STRING=SENSITIV
|
---|
| 96 | X ENCRYPT
|
---|
| 97 | S SENSITIV=ENCSTR
|
---|
| 98 | ;LINE 1
|
---|
| 99 | S TMP="$PATIENT"
|
---|
| 100 | S:('MESSNUM) @ARRAY@(LINE)=TMP
|
---|
| 101 | S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
|
---|
| 102 | S LINE=LINE+1
|
---|
| 103 | ;LINE 2
|
---|
| 104 | S TMP=NCRYPTON
|
---|
| 105 | S:('MESSNUM) @ARRAY@(LINE)=TMP
|
---|
| 106 | S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
|
---|
| 107 | S LINE=LINE+1
|
---|
| 108 | ;LINE 3
|
---|
| 109 | S TMP=NAME
|
---|
| 110 | S:('MESSNUM) @ARRAY@(LINE)=TMP
|
---|
| 111 | S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
|
---|
| 112 | S LINE=LINE+1
|
---|
| 113 | ;LINE 4
|
---|
| 114 | S TMP=PID
|
---|
| 115 | S:('MESSNUM) @ARRAY@(LINE)=TMP
|
---|
| 116 | S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
|
---|
| 117 | S LINE=LINE+1
|
---|
| 118 | ;LINE 5
|
---|
| 119 | S TMP=SSN
|
---|
| 120 | S:('MESSNUM) @ARRAY@(LINE)=TMP
|
---|
| 121 | S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
|
---|
| 122 | S LINE=LINE+1
|
---|
| 123 | ;LINE 6
|
---|
| 124 | S TMP=DOB
|
---|
| 125 | S:('MESSNUM) @ARRAY@(LINE)=TMP
|
---|
| 126 | S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
|
---|
| 127 | S LINE=LINE+1
|
---|
| 128 | ;LINE 7
|
---|
| 129 | S TMP=DFN
|
---|
| 130 | S:('MESSNUM) @ARRAY@(LINE)=TMP
|
---|
| 131 | S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
|
---|
| 132 | S LINE=LINE+1
|
---|
| 133 | ;LINE 8
|
---|
| 134 | S TMP=SENSITIV
|
---|
| 135 | S:('MESSNUM) @ARRAY@(LINE)=TMP
|
---|
| 136 | S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
|
---|
| 137 | S LINE=LINE+1
|
---|
| 138 | ;LINE 9
|
---|
| 139 | S TMP="$$PATIENT"
|
---|
| 140 | S:('MESSNUM) @ARRAY@(LINE)=TMP
|
---|
| 141 | S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
|
---|
| 142 | S LINE=LINE+1
|
---|
| 143 | Q (LINE-OFFSET)
|
---|