source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON6.m@ 691

Last change on this file since 691 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1VAQCON6 ;ALB/JRP - MESSAGE CONSTRUCTION;13-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
3PATIENT(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)
Note: See TracBrowser for help on using the repository browser.