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