| [613] | 1 | VAQDBIP5 ;ALB/JRP - CONTINUATIONS FROM VAQDBIP2;23-MAR-93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | MLTPLE ;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 | ;
|
|---|
| 56 | WORD ;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
|
|---|
