87 lines
3.0 KiB
Mathematica
87 lines
3.0 KiB
Mathematica
|
VAQDBIP5 ;ALB/JRP - CONTINUATIONS FROM VAQDBIP2;23-MAR-93
|
||
|
|
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
||
|
|
MLTPLE ;MULTIPLE EXTRACTION
|
||
|
|
;ALL VARIABLES ARE TAKEN CARE OF IN VAQDBIP2
|
||
|
|
;DETERMINE WHERE MULTIPLE RESIDES IN THE MAIN FILE
|
||
|
|
S GLOBAL=$G(^DIC(MAINFILE,0,"GL"))
|
||
|
|
I (GLOBAL="") S ERROR="-1^Couldn't get global root of multiple" Q
|
||
|
|
S MAINFLD=$O(^DD(MAINFILE,"SB",FILE,""))
|
||
|
|
I (MAINFLD="") S ERROR="-1^Couldn't get field number of multiple" Q
|
||
|
|
S NODE=$P($P($G(^DD(MAINFILE,MAINFLD,0)),"^",4),";",1)
|
||
|
|
I (NODE="") S ERROR="-1^Couldn't get node multiple is stored on" Q
|
||
|
|
;PUT QUOTES AROUND NON-NUMERIC NODE
|
||
|
|
I (NODE'?1.N) S NODE=$C(34)_NODE_$C(34)
|
||
|
|
S NODE=GLOBAL_$S(MAINFILE=52:RXIFN,1:DFN)_","_NODE_")"
|
||
|
|
;STORE IFNs IN TEMP ARRAY (ALLOWS FOR REVERSE ORDER EXTRACTION)
|
||
|
|
K ^TMP("VAQ",$J,$J)
|
||
|
|
S ENTRY=0
|
||
|
|
F S ENTRY=$O(@NODE@(ENTRY)) Q:('ENTRY) D
|
||
|
|
.I (MULTREV) S ^TMP("VAQ",$J,$J,(999999999999-ENTRY))=ENTRY Q
|
||
|
|
.S ^TMP("VAQ",$J,$J,ENTRY)=ENTRY
|
||
|
|
;EXTRACT EACH MULTIPLE ENTRY
|
||
|
|
S ENTRY="",COUNT=1
|
||
|
|
F S ENTRY=$O(^TMP("VAQ",$J,$J,ENTRY)) Q:(('ENTRY)!((COUNT>MULTLIM)&(MULTLIM'=""))) D
|
||
|
|
.S DIC=GLOBAL
|
||
|
|
.S DR=MAINFLD
|
||
|
|
.S DA=$S(MAINFILE=52:RXIFN,1:DFN)
|
||
|
|
.S DR(FILE)=$TR(FIELDS,",",";")
|
||
|
|
.S DA(FILE)=^TMP("VAQ",$J,$J,ENTRY)
|
||
|
|
.S DIQ(0)="E"
|
||
|
|
.K ^UTILITY("DIQ1",$J)
|
||
|
|
.D EN^DIQ1
|
||
|
|
.;STORE IN EXTRACTION ARRAY
|
||
|
|
.F TMP=1:1:$L(FIELDS,",") D
|
||
|
|
..S FIELD=$P(FIELDS,",",TMP)
|
||
|
|
..S SEQUENCE=$$GETSEQ^VAQDBIP(ARRAY,FILE,FIELD)
|
||
|
|
..;ENCRYPT POTENTIAL IDENTIFIER
|
||
|
|
..S STRING=$G(^UTILITY("DIQ1",$J,FILE,DA(FILE),.01,"E"))
|
||
|
|
..S ENCSTR=STRING
|
||
|
|
..I $$NCRPFLD^VAQUTL2(FILE,.01) X ENCRYPT
|
||
|
|
..;DETERMINE IDENTIFIER
|
||
|
|
..S ID=ENCSTR
|
||
|
|
..S:((MAINFILE'=52)&(FIELD=.01)) ID=PATNAME
|
||
|
|
..S:((MAINFILE=52)&(FIELD=.01)) ID=RXNUM
|
||
|
|
..;ENCRYPT VALUE
|
||
|
|
..S STRING=$G(^UTILITY("DIQ1",$J,FILE,DA(FILE),FIELD,"E"))
|
||
|
|
..S ENCSTR=STRING
|
||
|
|
..I $$NCRPFLD^VAQUTL2(FILE,FIELD) X ENCRYPT
|
||
|
|
..;STORE VALUE & IDENTIFIER IN EXTRACTION ARRAY
|
||
|
|
..S @ARRAY@("VALUE",FILE,FIELD,SEQUENCE)=ENCSTR
|
||
|
|
..S @ARRAY@("ID",FILE,FIELD,SEQUENCE)=ID
|
||
|
|
.K ^UTILITY("DIQ1",$J)
|
||
|
|
.S COUNT=COUNT+1
|
||
|
|
K ^TMP("VAQ",$J,$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
WORD ;WORD-PROCESSING FIELD EXTRACTION
|
||
|
|
;ALL VARIABLES ARE TAKEN CARE OF IN VAQDBIP2
|
||
|
|
;DETERMINE WHERE WORD-PROCESSING RESIDES IN THE MAIN FILE
|
||
|
|
S GLOBAL=$G(^DIC(MAINFILE,0,"GL"))
|
||
|
|
I (GLOBAL="") S ERROR="-1^Couldn't get global root of word-processing field" Q
|
||
|
|
S MAINFLD=$O(^DD(MAINFILE,"SB",FILE,""))
|
||
|
|
I (MAINFLD="") S ERROR="-1^Couldn't get field number of word-processing field" Q
|
||
|
|
;EXTRACT WORD-PROCESSING FIELD
|
||
|
|
S DIC=GLOBAL
|
||
|
|
S DR=MAINFLD
|
||
|
|
S DA=$S(MAINFILE=52:RXIFN,1:DFN)
|
||
|
|
S DIQ(0)="E"
|
||
|
|
K ^UTILITY("DIQ1",$J)
|
||
|
|
D EN^DIQ1
|
||
|
|
;STORE IN EXTRACTION ARRAY
|
||
|
|
S ENTRY=0
|
||
|
|
F TMP=0:0 D Q:(ENTRY="")
|
||
|
|
.S ENTRY=$O(^UTILITY("DIQ1",$J,MAINFILE,DA,MAINFLD,ENTRY))
|
||
|
|
.Q:(ENTRY="")
|
||
|
|
.S SEQUENCE=$$GETSEQ^VAQDBIP(ARRAY,FILE,.01)
|
||
|
|
.;DETERMINE IDENTIFIER
|
||
|
|
.S ID=PATNAME
|
||
|
|
.S:(MAINFILE=52) ID=RXNUM
|
||
|
|
.;ENCRYPT LINE
|
||
|
|
.S STRING=^UTILITY("DIQ1",$J,MAINFILE,DA,MAINFLD,ENTRY)
|
||
|
|
.S ENCSTR=STRING
|
||
|
|
.I $$NCRPFLD^VAQUTL2(FILE,.01) X ENCRYPT
|
||
|
|
.S @ARRAY@("VALUE",FILE,.01,SEQUENCE)=ENCSTR
|
||
|
|
.S @ARRAY@("ID",FILE,.01,SEQUENCE)=ID
|
||
|
|
K ^UTILITY("DIQ1",$J)
|
||
|
|
Q
|