VAQUTL94 ;ALB/JFP - UTILITY ROUTINES; 01-APR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
PARTIC(ARRAY,PART) ;DOES PATICIAL LOOK UP ON AGIANST INPUT ARRAY
;INPUT : ARRAY - Array to look agianst (full global reference)
; PART - What to look for
;OUTPUT : FULL - Full value
; -1 - Error (bad input)
;
; -- Check input
Q:($G(ARRAY)="") -1
Q:($G(PART)="") -1
; -- Declare variables
N PLEN,FULL,SEL,FLEN,EXACT,ENTRY,X,Y
; -- Init variables
S PLEN=$L(PART)
Q:PLEN=0 -1
;
S FULL="",SEL=0
F S FULL=$O(@ARRAY@(FULL)) Q:FULL="" D
.S FLEN=$L(FULL)
.I ($E(FULL,1,PLEN)=PART)&(PLEN=FLEN) S EXACT=FULL Q
.I $E(FULL,1,PLEN)=PART S SEL=SEL+1,^TMP("VAQSEL",$J,SEL)=FULL
;
Q:$D(EXACT) EXACT ; -- Exact match
Q:SEL=0 -1 ; -- No particial entries found
I SEL=1 S FULL=$G(^TMP("VAQSEL",$J,SEL)) K ^TMP("VAQSEL",$J) Q FULL
;
S ENTRY=""
F S ENTRY=$O(^TMP("VAQSEL",$J,ENTRY)) Q:ENTRY="" W !,ENTRY," ",$G(^TMP("VAQSEL",$J,ENTRY))
S DIR("A")="Choose (1-"_SEL_"): "
S DIR(0)="NAO^1:"_SEL
D ^DIR K DIR Q:$D(DIRUT) -1
S X=Y
I X="" Q -1
S FULL=$G(^TMP("VAQSEL",$J,X)) K ^TMP("VAQSEL",$J) Q FULL
QUIT
;
DOMKEY(STDE) ;DETERMINES WHICH DOMAIN TO DISPLAY ON STATUS SCREEN
;INPUT : STDE - Pointer to status file
;OUTPUT : R - Pull from request node
; A - Pull form athr node
; -1 - Error (bad input)
;
; -- Check input
Q:'$D(STDE) -1
Q:STDE="" -1
; -- Declare variables
N STATMNU
; -- Init variables
S STATMNU=$P($G(^VAT(394.85,STDE,0)),U,1)
I (STATMNU="VAQ-AMBIG")!(STATMNU="VAQ-PROC")!(STATMNU="VAQ-TUNSL")!(STATMNU="VAQ-UNACK") Q "R"
Q "A"
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQUTL94 1682 printed Nov 22, 2024@17:37:05 Page 2
VAQUTL94 ;ALB/JFP - UTILITY ROUTINES; 01-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
PARTIC(ARRAY,PART) ;DOES PATICIAL LOOK UP ON AGIANST INPUT ARRAY
+1 ;INPUT : ARRAY - Array to look agianst (full global reference)
+2 ; PART - What to look for
+3 ;OUTPUT : FULL - Full value
+4 ; -1 - Error (bad input)
+5 ;
+6 ; -- Check input
+7 if ($GET(ARRAY)="")
QUIT -1
+8 if ($GET(PART)="")
QUIT -1
+9 ; -- Declare variables
+10 NEW PLEN,FULL,SEL,FLEN,EXACT,ENTRY,X,Y
+11 ; -- Init variables
+12 SET PLEN=$LENGTH(PART)
+13 if PLEN=0
QUIT -1
+14 ;
+15 SET FULL=""
SET SEL=0
+16 FOR
SET FULL=$ORDER(@ARRAY@(FULL))
if FULL=""
QUIT
Begin DoDot:1
+17 SET FLEN=$LENGTH(FULL)
+18 IF ($EXTRACT(FULL,1,PLEN)=PART)&(PLEN=FLEN)
SET EXACT=FULL
QUIT
+19 IF $EXTRACT(FULL,1,PLEN)=PART
SET SEL=SEL+1
SET ^TMP("VAQSEL",$JOB,SEL)=FULL
End DoDot:1
+20 ;
+21 ; -- Exact match
if $DATA(EXACT)
QUIT EXACT
+22 ; -- No particial entries found
if SEL=0
QUIT -1
+23 IF SEL=1
SET FULL=$GET(^TMP("VAQSEL",$JOB,SEL))
KILL ^TMP("VAQSEL",$JOB)
QUIT FULL
+24 ;
+25 SET ENTRY=""
+26 FOR
SET ENTRY=$ORDER(^TMP("VAQSEL",$JOB,ENTRY))
if ENTRY=""
QUIT
WRITE !,ENTRY," ",$GET(^TMP("VAQSEL",$JOB,ENTRY))
+27 SET DIR("A")="Choose (1-"_SEL_"): "
+28 SET DIR(0)="NAO^1:"_SEL
+29 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT -1
+30 SET X=Y
+31 IF X=""
QUIT -1
+32 SET FULL=$GET(^TMP("VAQSEL",$JOB,X))
KILL ^TMP("VAQSEL",$JOB)
QUIT FULL
+33 QUIT
+34 ;
DOMKEY(STDE) ;DETERMINES WHICH DOMAIN TO DISPLAY ON STATUS SCREEN
+1 ;INPUT : STDE - Pointer to status file
+2 ;OUTPUT : R - Pull from request node
+3 ; A - Pull form athr node
+4 ; -1 - Error (bad input)
+5 ;
+6 ; -- Check input
+7 if '$DATA(STDE)
QUIT -1
+8 if STDE=""
QUIT -1
+9 ; -- Declare variables
+10 NEW STATMNU
+11 ; -- Init variables
+12 SET STATMNU=$PIECE($GET(^VAT(394.85,STDE,0)),U,1)
+13 IF (STATMNU="VAQ-AMBIG")!(STATMNU="VAQ-PROC")!(STATMNU="VAQ-TUNSL")!(STATMNU="VAQ-UNACK")
QUIT "R"
+14 QUIT "A"
+15 ;
