source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIP5.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1VAQDBIP5 ;ALB/JRP - CONTINUATIONS FROM VAQDBIP2;23-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3MLTPLE ;MULTIPLE EXTRACTION
4 ;ALL VARIABLES ARE TAKEN CARE OF IN VAQDBIP2
5 ;DETERMINE WHERE MULTIPLE RESIDES IN THE MAIN FILE
6 S GLOBAL=$G(^DIC(MAINFILE,0,"GL"))
7 I (GLOBAL="") S ERROR="-1^Couldn't get global root of multiple" Q
8 S MAINFLD=$O(^DD(MAINFILE,"SB",FILE,""))
9 I (MAINFLD="") S ERROR="-1^Couldn't get field number of multiple" Q
10 S NODE=$P($P($G(^DD(MAINFILE,MAINFLD,0)),"^",4),";",1)
11 I (NODE="") S ERROR="-1^Couldn't get node multiple is stored on" Q
12 ;PUT QUOTES AROUND NON-NUMERIC NODE
13 I (NODE'?1.N) S NODE=$C(34)_NODE_$C(34)
14 S NODE=GLOBAL_$S(MAINFILE=52:RXIFN,1:DFN)_","_NODE_")"
15 ;STORE IFNs IN TEMP ARRAY (ALLOWS FOR REVERSE ORDER EXTRACTION)
16 K ^TMP("VAQ",$J,$J)
17 S ENTRY=0
18 F S ENTRY=$O(@NODE@(ENTRY)) Q:('ENTRY) D
19 .I (MULTREV) S ^TMP("VAQ",$J,$J,(999999999999-ENTRY))=ENTRY Q
20 .S ^TMP("VAQ",$J,$J,ENTRY)=ENTRY
21 ;EXTRACT EACH MULTIPLE ENTRY
22 S ENTRY="",COUNT=1
23 F S ENTRY=$O(^TMP("VAQ",$J,$J,ENTRY)) Q:(('ENTRY)!((COUNT>MULTLIM)&(MULTLIM'=""))) D
24 .S DIC=GLOBAL
25 .S DR=MAINFLD
26 .S DA=$S(MAINFILE=52:RXIFN,1:DFN)
27 .S DR(FILE)=$TR(FIELDS,",",";")
28 .S DA(FILE)=^TMP("VAQ",$J,$J,ENTRY)
29 .S DIQ(0)="E"
30 .K ^UTILITY("DIQ1",$J)
31 .D EN^DIQ1
32 .;STORE IN EXTRACTION ARRAY
33 .F TMP=1:1:$L(FIELDS,",") D
34 ..S FIELD=$P(FIELDS,",",TMP)
35 ..S SEQUENCE=$$GETSEQ^VAQDBIP(ARRAY,FILE,FIELD)
36 ..;ENCRYPT POTENTIAL IDENTIFIER
37 ..S STRING=$G(^UTILITY("DIQ1",$J,FILE,DA(FILE),.01,"E"))
38 ..S ENCSTR=STRING
39 ..I $$NCRPFLD^VAQUTL2(FILE,.01) X ENCRYPT
40 ..;DETERMINE IDENTIFIER
41 ..S ID=ENCSTR
42 ..S:((MAINFILE'=52)&(FIELD=.01)) ID=PATNAME
43 ..S:((MAINFILE=52)&(FIELD=.01)) ID=RXNUM
44 ..;ENCRYPT VALUE
45 ..S STRING=$G(^UTILITY("DIQ1",$J,FILE,DA(FILE),FIELD,"E"))
46 ..S ENCSTR=STRING
47 ..I $$NCRPFLD^VAQUTL2(FILE,FIELD) X ENCRYPT
48 ..;STORE VALUE & IDENTIFIER IN EXTRACTION ARRAY
49 ..S @ARRAY@("VALUE",FILE,FIELD,SEQUENCE)=ENCSTR
50 ..S @ARRAY@("ID",FILE,FIELD,SEQUENCE)=ID
51 .K ^UTILITY("DIQ1",$J)
52 .S COUNT=COUNT+1
53 K ^TMP("VAQ",$J,$J)
54 Q
55 ;
56WORD ;WORD-PROCESSING FIELD EXTRACTION
57 ;ALL VARIABLES ARE TAKEN CARE OF IN VAQDBIP2
58 ;DETERMINE WHERE WORD-PROCESSING RESIDES IN THE MAIN FILE
59 S GLOBAL=$G(^DIC(MAINFILE,0,"GL"))
60 I (GLOBAL="") S ERROR="-1^Couldn't get global root of word-processing field" Q
61 S MAINFLD=$O(^DD(MAINFILE,"SB",FILE,""))
62 I (MAINFLD="") S ERROR="-1^Couldn't get field number of word-processing field" Q
63 ;EXTRACT WORD-PROCESSING FIELD
64 S DIC=GLOBAL
65 S DR=MAINFLD
66 S DA=$S(MAINFILE=52:RXIFN,1:DFN)
67 S DIQ(0)="E"
68 K ^UTILITY("DIQ1",$J)
69 D EN^DIQ1
70 ;STORE IN EXTRACTION ARRAY
71 S ENTRY=0
72 F TMP=0:0 D Q:(ENTRY="")
73 .S ENTRY=$O(^UTILITY("DIQ1",$J,MAINFILE,DA,MAINFLD,ENTRY))
74 .Q:(ENTRY="")
75 .S SEQUENCE=$$GETSEQ^VAQDBIP(ARRAY,FILE,.01)
76 .;DETERMINE IDENTIFIER
77 .S ID=PATNAME
78 .S:(MAINFILE=52) ID=RXNUM
79 .;ENCRYPT LINE
80 .S STRING=^UTILITY("DIQ1",$J,MAINFILE,DA,MAINFLD,ENTRY)
81 .S ENCSTR=STRING
82 .I $$NCRPFLD^VAQUTL2(FILE,.01) X ENCRYPT
83 .S @ARRAY@("VALUE",FILE,.01,SEQUENCE)=ENCSTR
84 .S @ARRAY@("ID",FILE,.01,SEQUENCE)=ID
85 K ^UTILITY("DIQ1",$J)
86 Q
Note: See TracBrowser for help on using the repository browser.