source: FOIAVistA/tag/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIP2.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.6 KB
Line 
1VAQDBIP2 ;ALB/JRP - PDX EXTRACTION UTILITY;16-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3XTRCT(INFOLINE,DFN,RXIFN,ARRAY,ENCPTR,KEY1,KEY2) ;EXTRACT INFORMATION
4 ;INPUT : INFOLINE - Line containing information to extract
5 ; DFN - Pointer to patient in PATIENT file
6 ; RXIFN - Pointer to prescription in PRESCRIPTION file
7 ; ARRAY - Extraction array (full global reference)
8 ; ENCPTR - Pointer to VAQ - ENCRYPTION METHOD file (optional)
9 ; (only used if encryption will be done)
10 ; KEY1 - Primary encryption key
11 ; (only required if ENCPTR passed)
12 ; KEY2 - Secondary encryption key
13 ; (only required if ENCPTR passed)
14 ;OUTPUT : 0 - Extraction was successfull
15 ; Information stored in extraction array
16 ; -1^Error_Text - Extraction was not successfull
17 ;NOTES : INFOLINE is in the format
18 ; <TAB>;;File;Field,Field,...,Field;Multiple Limit;Reverse Order Mult
19 ; : 'Multiple Limit' is the number of multiples to extract
20 ; (defaults to all)
21 ; : If 'Reverse Order Mult' contains a value other than 0,
22 ; multiples will be extracted in reverse order (last in
23 ; first out). If it does not have a value or is 0,
24 ; multiples will be extracted in normal fashion (first in
25 ; first out).
26 ;
27 ;CHECK INPUT
28 Q:($G(INFOLINE)="") "-1^Did not pass info line"
29 Q:($G(DFN)="") "-1^Did not pass pointer to PATIENT file"
30 S RXIFN=$G(RXIFN)
31 S ENCPTR=+$G(ENCPTR)
32 S KEY1=$G(KEY1)
33 S KEY2=$G(KEY2)
34 I (ENCPTR) Q:((KEY1="")!(KEY2="")) "-1^Did not pass both encription keys"
35 ;DECLARE VARIABLES
36 N TMP,FILE,FIELDS,MAINFILE,MAINFLD,GLOBAL,NODE,STRING
37 N WORDPROC,ENTRY,ERROR,MULTLIM,COUNT,MULTREV,ENCRYPT
38 N DIC,DR,DA,DIQ,SEQUENCE,ID,RXNUM,PATNAME,FIELD,ENCSTR
39 ;SAFE GUARD DELETION OF UTILITY GLOBAL
40 K ^UTILITY("DIQ1",$J)
41 ;GET ENCRYPTION METHOD
42 S TMP="STRING"
43 S:(ENCPTR) TMP=$$ENCMTHD^VAQUTL2(ENCPTR,0)
44 Q:((ENCPTR)&(TMP="")) "-1^Could not determine encryption method"
45 S ENCRYPT="S ENCSTR="_TMP
46 ;GET PATIENT'S NAME
47 S TMP=$$PATINFO^VAQUTL1(DFN)
48 S STRING=$P(TMP,"^",1)
49 Q:(STRING="-1") "-1^Could not determine patient's name"
50 ;ENCRYPT
51 S ENCSTR=STRING
52 I $$NCRPFLD^VAQUTL2(2,.01) X ENCRYPT
53 S PATNAME=ENCSTR
54 ;GET RX #
55 I (RXIFN'="") D
56 .S DIC="^PSRX("
57 .S DR=.01
58 .S DA=RXIFN
59 .S DIQ(0)="E"
60 .D EN^DIQ1
61 .S STRING=$G(^UTILITY("DIQ1",$J,52,RXIFN,.01,"E"))
62 .;ENCRYPT
63 .S ENCSTR=STRING
64 .I $$NCRPFLD^VAQUTL2(52,.01) X ENCRYPT
65 .S RXNUM=ENCSTR
66 .;TESTING OF RESULT DONE IF NEEDED LATER ON
67 .K ^UTILITY("DIQ1",$J)
68 S ERROR=0
69 S FILE=$P(INFOLINE,";",3)
70 S FIELDS=$P(INFOLINE,";",4)
71 S MULTLIM=$P(INFOLINE,";",5)
72 S MULTREV=$P(INFOLINE,";",6)
73 ;CHECK FOR MULTIPLE
74 S MAINFILE=$G(^DD(FILE,0,"UP"))
75 ;CHECK FOR WORD-PROCESSING FIELD
76 S WORDPROC=$F($P($G(^DD(FILE,.01,0)),"^",2),"W")
77 ;NON-MULTIPLE
78 I (MAINFILE="") D Q ERROR
79 .I ((FILE=52)&(RXIFN="")) S ERROR="-1^Pointer to PRESCRIPTION file not passed" Q
80 .S DIC=FILE
81 .S DR=$TR(FIELDS,",",";")
82 .S DA=$S(FILE=52:RXIFN,1:DFN)
83 .S DIQ(0)="E"
84 .K ^UTILITY("DIQ1",$J)
85 .D EN^DIQ1
86 .;STORE IN EXTRACTION ARRAY
87 .F TMP=1:1:$L(FIELDS,",") D
88 ..S FIELD=$P(FIELDS,",",TMP)
89 ..S SEQUENCE=$$GETSEQ^VAQDBIP(ARRAY,FILE,FIELD)
90 ..;DETERMINE IDENTIFIER
91 ..S ID=PATNAME
92 ..S:((FILE=52)&(FIELD'=.01)) ID=RXNUM
93 ..S STRING=$G(^UTILITY("DIQ1",$J,FILE,DA,FIELD,"E"))
94 ..;ENCRYPT
95 ..S ENCSTR=STRING
96 ..I $$NCRPFLD^VAQUTL2(FILE,FIELD) X ENCRYPT
97 ..S @ARRAY@("VALUE",FILE,FIELD,SEQUENCE)=ENCSTR
98 ..S @ARRAY@("ID",FILE,FIELD,SEQUENCE)=ID
99 .K ^UTILITY("DIQ1",$J)
100 ;MULTIPLE
101 I ((MAINFILE'="")&('WORDPROC)) D MLTPLE^VAQDBIP5 Q ERROR
102 ;WORD-PROCESSING FIELD
103 I ((MAINFILE'="")&(WORDPROC)) D WORD^VAQDBIP5 Q ERROR
104 Q
Note: See TracBrowser for help on using the repository browser.