| 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 | 
|---|