| 1 | MAGGNLKP ;WOIFO/GEK - Lookup from delphi into any file ; [ 06/20/2001 08:56 ]
 | 
|---|
| 2 |  ;;3.0;IMAGING;**8,92,46,59**;Nov 27, 2007;Build 20
 | 
|---|
| 3 |  ;;Per VHA Directive 2004-038, this routine should not be modified.
 | 
|---|
| 4 |  ;; +---------------------------------------------------------------+
 | 
|---|
| 5 |  ;; | Property of the US Government.                                |
 | 
|---|
| 6 |  ;; | No permission to copy or redistribute this software is given. |
 | 
|---|
| 7 |  ;; | Use of unreleased versions of this software requires the user |
 | 
|---|
| 8 |  ;; | to execute a written test agreement with the VistA Imaging    |
 | 
|---|
| 9 |  ;; | Development Office of the Department of Veterans Affairs,     |
 | 
|---|
| 10 |  ;; | telephone (301) 734-0100.                                     |
 | 
|---|
| 11 |  ;; |                                                               |
 | 
|---|
| 12 |  ;; | The Food and Drug Administration classifies this software as  |
 | 
|---|
| 13 |  ;; | a medical device.  As such, it may not be changed in any way. |
 | 
|---|
| 14 |  ;; | Modifications to this software may result in an adulterated   |
 | 
|---|
| 15 |  ;; | medical device under 21CFR820, the use of which is considered |
 | 
|---|
| 16 |  ;; | to be a violation of US Federal Statutes.                     |
 | 
|---|
| 17 |  ;; +---------------------------------------------------------------+
 | 
|---|
| 18 |  ;;
 | 
|---|
| 19 |  Q
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 | LKP(MAGRY,MAGIN,DATA) ;RPC [MAG3 LOOKUP ANY] 
 | 
|---|
| 22 |  ; Generic lookup using FIND^DIC
 | 
|---|
| 23 |  ; MAGRY is the Array to return.
 | 
|---|
| 24 |  ; MAGIN is parameter sent by calling app (Delphi)
 | 
|---|
| 25 |  ;    FILE NUM ^ NUM TO RETURN ^ TEXT TO MATCH ^ FIELDS ^ SCREEN ($P 5-99)
 | 
|---|
| 26 |  ;    
 | 
|---|
| 27 |  ; DATA : 
 | 
|---|
| 28 |  ;  LVIEW =Piece 1 
 | 
|---|
| 29 |  ;     +LVIEW = 1  :  
 | 
|---|
| 30 |  ;          result array is formatted for a magListView control
 | 
|---|
| 31 |  ;              i.e.  ^ delimiter for data and "|" delimiter for IEN
 | 
|---|
| 32 |  ;     +LVIEW = 0  : 
 | 
|---|
| 33 |  ;         old way,  "  " delim for data and '^' delim for IEN
 | 
|---|
| 34 |  ;  INDX = Piece 2
 | 
|---|
| 35 |  ;                       This is the index to search 
 | 
|---|
| 36 |  ;                       Defaults to "B"
 | 
|---|
| 37 |  ;    
 | 
|---|
| 38 |  N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
 | 
|---|
| 39 |  ;
 | 
|---|
| 40 |  N Y,XI,Z,FI,MAGIEN,INFO,LVIEW,INDX
 | 
|---|
| 41 |  N FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT
 | 
|---|
| 42 |  S (FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT)=""
 | 
|---|
| 43 |  S MAGIN=$G(MAGIN)
 | 
|---|
| 44 |  S DATA=$G(DATA)
 | 
|---|
| 45 |  ;
 | 
|---|
| 46 |  S FILE=+$P(MAGIN,U,1)
 | 
|---|
| 47 |  S NUM=$S(+$P(MAGIN,U,2):+$P(MAGIN,U,2),1:200)
 | 
|---|
| 48 |  S VAL=$P(MAGIN,U,3)
 | 
|---|
| 49 |  S FLDS=$P(MAGIN,U,4)
 | 
|---|
| 50 |  S SCR=$P(MAGIN,U,5,99)
 | 
|---|
| 51 |  ;
 | 
|---|
| 52 |  S LVIEW=+$P(DATA,"^",1)
 | 
|---|
| 53 |  S INDX=$S($L($P(DATA,"^",2)):$P(DATA,"^",2),1:"B")
 | 
|---|
| 54 |  ;
 | 
|---|
| 55 |  I 'FILE S MAGRY(1)="0^ERROR - Invalid Parameter:  File Number ? " Q
 | 
|---|
| 56 |  I '$$VFILE^DILFD(FILE) S MAGRY(1)="0^ERROR - Invalid File # - "_FILE Q
 | 
|---|
| 57 |  ;          Number of entries to return, If 0 we'll stop at 200
 | 
|---|
| 58 |  ;
 | 
|---|
| 59 |  K ^TMP("DILIST",$J)
 | 
|---|
| 60 |  K ^TMP("DIERR",$J)
 | 
|---|
| 61 |  ;  VAL is the initial value to search for. i.e. the user input.
 | 
|---|
| 62 |  ;  Next line is to stop the FM Infinite Error Trap problem.
 | 
|---|
| 63 |  I $L(VAL)>30 S MAGRY(0)="0^Invalid Input: '"_$E(VAL,1,40)_"...' is too long. "_$L(VAL)_" characters." Q
 | 
|---|
| 64 |  D FIND^DIC(FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT)
 | 
|---|
| 65 |  ;
 | 
|---|
| 66 |  I '$D(^TMP("DILIST",$J,1)) S XI=1 D  Q
 | 
|---|
| 67 |  . I $D(^TMP("DIERR",$J)) D FINDERR(XI) Q
 | 
|---|
| 68 |  . S MAGRY(XI)="0^NO MATCH for lookup on """_$P(MAGIN,"^",3)_""""
 | 
|---|
| 69 |  ;  so we have some matches, (BUT we could still have an error)
 | 
|---|
| 70 |  ;  so first list all matches, then the ERROR
 | 
|---|
| 71 |  ;  Next lines were Q&D but old .EXE's expect return string with 
 | 
|---|
| 72 |  ;  this syntax, when all T11 code is gone, this can be rewritten
 | 
|---|
| 73 |  I LVIEW S XI="" F  S XI=$O(^TMP("DILIST",$J,1,XI)) Q:XI=""  S X=^(XI) D
 | 
|---|
| 74 |  . S MAGIEN=^TMP("DILIST",$J,2,XI)
 | 
|---|
| 75 |  . S Z=".01",FLD="NAME"
 | 
|---|
| 76 |  . F  S Z=$O(^TMP("DILIST",$J,"ID",XI,Z)) Q:Z=""  S X=X_"^"_^(Z),FLD=FLD_"^"_$$GET1^DID(FILE,Z,"","LABEL","MAGFLD")
 | 
|---|
| 77 |  . S MAGRY(.05)=FLD
 | 
|---|
| 78 |  . S MAGRY(XI)=X_"^|"_MAGIEN
 | 
|---|
| 79 |  . Q
 | 
|---|
| 80 |  I 'LVIEW  S XI="" F  S XI=$O(^TMP("DILIST",$J,1,XI)) Q:XI=""  S X=^(XI) D
 | 
|---|
| 81 |  . S MAGIEN=^TMP("DILIST",$J,2,XI)
 | 
|---|
| 82 |  . S Z=""
 | 
|---|
| 83 |  . F  S Z=$O(^TMP("DILIST",$J,"ID",XI,Z)) Q:Z=""  S X=X_"   "_^(Z)
 | 
|---|
| 84 |  . S MAGRY(XI)=X_"^"_MAGIEN
 | 
|---|
| 85 |  . Q
 | 
|---|
| 86 |  I $D(^TMP("DIERR",$J)) D FINDERR() Q
 | 
|---|
| 87 |  I $D(^TMP("DILIST",$J,0)) S INFO=^(0) D
 | 
|---|
| 88 |  . S MAGRY(0)=$P(INFO,"^")_U_"Found "_$P(INFO,"^")_" entr"_$S((+INFO=1):"y",1:"ies")_" matching """_$P(MAGIN,"^",3)_""""
 | 
|---|
| 89 |  . I $P(INFO,"^",3)>0 S MAGRY(0)=MAGRY(0)_" there are more"
 | 
|---|
| 90 |  . Q
 | 
|---|
| 91 |  Q
 | 
|---|
| 92 | FINDERR(XI) ;
 | 
|---|
| 93 |  ;
 | 
|---|
| 94 |  I '+$G(XI) S XI=$O(MAGRY(""),-1)+1
 | 
|---|
| 95 |  S MAGRY(XI)="ERROR^"_^TMP("DIERR",$J,1,"TEXT",1)
 | 
|---|
| 96 |  Q
 | 
|---|