| [613] | 1 | VAQUTL94 ;ALB/JFP - UTILITY ROUTINES; 01-APR-93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | PARTIC(ARRAY,PART) ;DOES PATICIAL LOOK UP ON AGIANST INPUT ARRAY
|
|---|
| 4 | ;INPUT : ARRAY - Array to look agianst (full global reference)
|
|---|
| 5 | ; PART - What to look for
|
|---|
| 6 | ;OUTPUT : FULL - Full value
|
|---|
| 7 | ; -1 - Error (bad input)
|
|---|
| 8 | ;
|
|---|
| 9 | ; -- Check input
|
|---|
| 10 | Q:($G(ARRAY)="") -1
|
|---|
| 11 | Q:($G(PART)="") -1
|
|---|
| 12 | ; -- Declare variables
|
|---|
| 13 | N PLEN,FULL,SEL,FLEN,EXACT,ENTRY,X,Y
|
|---|
| 14 | ; -- Init variables
|
|---|
| 15 | S PLEN=$L(PART)
|
|---|
| 16 | Q:PLEN=0 -1
|
|---|
| 17 | ;
|
|---|
| 18 | S FULL="",SEL=0
|
|---|
| 19 | F S FULL=$O(@ARRAY@(FULL)) Q:FULL="" D
|
|---|
| 20 | .S FLEN=$L(FULL)
|
|---|
| 21 | .I ($E(FULL,1,PLEN)=PART)&(PLEN=FLEN) S EXACT=FULL Q
|
|---|
| 22 | .I $E(FULL,1,PLEN)=PART S SEL=SEL+1,^TMP("VAQSEL",$J,SEL)=FULL
|
|---|
| 23 | ;
|
|---|
| 24 | Q:$D(EXACT) EXACT ; -- Exact match
|
|---|
| 25 | Q:SEL=0 -1 ; -- No particial entries found
|
|---|
| 26 | I SEL=1 S FULL=$G(^TMP("VAQSEL",$J,SEL)) K ^TMP("VAQSEL",$J) Q FULL
|
|---|
| 27 | ;
|
|---|
| 28 | S ENTRY=""
|
|---|
| 29 | F S ENTRY=$O(^TMP("VAQSEL",$J,ENTRY)) Q:ENTRY="" W !,ENTRY," ",$G(^TMP("VAQSEL",$J,ENTRY))
|
|---|
| 30 | S DIR("A")="Choose (1-"_SEL_"): "
|
|---|
| 31 | S DIR(0)="NAO^1:"_SEL
|
|---|
| 32 | D ^DIR K DIR Q:$D(DIRUT) -1
|
|---|
| 33 | S X=Y
|
|---|
| 34 | I X="" Q -1
|
|---|
| 35 | S FULL=$G(^TMP("VAQSEL",$J,X)) K ^TMP("VAQSEL",$J) Q FULL
|
|---|
| 36 | QUIT
|
|---|
| 37 | ;
|
|---|
| 38 | DOMKEY(STDE) ;DETERMINES WHICH DOMAIN TO DISPLAY ON STATUS SCREEN
|
|---|
| 39 | ;INPUT : STDE - Pointer to status file
|
|---|
| 40 | ;OUTPUT : R - Pull from request node
|
|---|
| 41 | ; A - Pull form athr node
|
|---|
| 42 | ; -1 - Error (bad input)
|
|---|
| 43 | ;
|
|---|
| 44 | ; -- Check input
|
|---|
| 45 | Q:'$D(STDE) -1
|
|---|
| 46 | Q:STDE="" -1
|
|---|
| 47 | ; -- Declare variables
|
|---|
| 48 | N STATMNU
|
|---|
| 49 | ; -- Init variables
|
|---|
| 50 | S STATMNU=$P($G(^VAT(394.85,STDE,0)),U,1)
|
|---|
| 51 | I (STATMNU="VAQ-AMBIG")!(STATMNU="VAQ-PROC")!(STATMNU="VAQ-TUNSL")!(STATMNU="VAQ-UNACK") Q "R"
|
|---|
| 52 | Q "A"
|
|---|
| 53 | ;
|
|---|
