Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGNLKP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGNLKP.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGNLKP.m
r613 r623 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 1 MAGGNLKP ;WOIFO/GEK - Lookup from delphi into any file ; [ 06/20/2001 08:56 ] 2 ;;3.0;IMAGING;**8,92**;Jan 10, 2007;Build 1 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 ; 39 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR" 40 ; 41 N Y,XI,Z,FI,MAGIEN,INFO,LVIEW,INDX 42 N FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT 43 S (FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT)="" 44 S MAGIN=$G(MAGIN) 45 S DATA=$G(DATA) 46 ; 47 S FILE=+$P(MAGIN,U,1) 48 S NUM=$S(+$P(MAGIN,U,2):+$P(MAGIN,U,2),1:200) 49 S VAL=$P(MAGIN,U,3) 50 S FLDS=$P(MAGIN,U,4) 51 S SCR=$P(MAGIN,U,5,99) 52 ; 53 S LVIEW=+$P(DATA,"^",1) 54 S INDX=$S($L($P(DATA,"^",2)):$P(DATA,"^",2),1:"B") 55 ; 56 I 'FILE S MAGRY(1)="0^ERROR - Invalid Parameter: File Number ? " Q 57 I '$$VFILE^DILFD(FILE) S MAGRY(1)="0^ERROR - Invalid File # - "_FILE Q 58 ; Number of entries to return, If 0 we'll stop at 200 59 ; 60 K ^TMP("DILIST",$J) 61 K ^TMP("DIERR",$J) 62 ; VAL is the initial value to search for. i.e. the user input. 63 ; Next line is to stop the FM Infinite Error Trap problem. 64 I $L(VAL)>30 S MAGRY(0)="0^Invalid Input: '"_$E(VAL,1,40)_"...' is too long. "_$L(VAL)_" characters." Q 65 D FIND^DIC(FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT) 66 ; 67 I '$D(^TMP("DILIST",$J,1)) S XI=1 D Q 68 . I $D(^TMP("DIERR",$J)) D FINDERR(XI) Q 69 . S MAGRY(XI)="0^NO MATCH for lookup on """_$P(MAGIN,"^",3)_"""" 70 ; so we have some matches, (BUT we could still have an error) 71 ; so first list all matches, then the ERROR 72 ; Next lines were Q&D but old .EXE's expect return string with 73 ; this syntax, when all T11 code is gone, this can be rewritten 74 I LVIEW S XI="" F S XI=$O(^TMP("DILIST",$J,1,XI)) Q:XI="" S X=^(XI) D 75 . S MAGIEN=^TMP("DILIST",$J,2,XI) 76 . S Z=".01",FLD="NAME" 77 . F S Z=$O(^TMP("DILIST",$J,"ID",XI,Z)) Q:Z="" S X=X_"^"_^(Z),FLD=FLD_"^"_$$GET1^DID(FILE,Z,"","LABEL","MAGFLD") 78 . S MAGRY(.05)=FLD 79 . S MAGRY(XI)=X_"^|"_MAGIEN 80 . Q 81 I 'LVIEW S XI="" F S XI=$O(^TMP("DILIST",$J,1,XI)) Q:XI="" S X=^(XI) D 82 . S MAGIEN=^TMP("DILIST",$J,2,XI) 83 . S Z="" 84 . F S Z=$O(^TMP("DILIST",$J,"ID",XI,Z)) Q:Z="" S X=X_" "_^(Z) 85 . S MAGRY(XI)=X_"^"_MAGIEN 86 . Q 87 I $D(^TMP("DIERR",$J)) D FINDERR() Q 88 I $D(^TMP("DILIST",$J,0)) S INFO=^(0) D 89 . S MAGRY(0)=$P(INFO,"^")_U_"Found "_$P(INFO,"^")_" entr"_$S((+INFO=1):"y",1:"ies")_" matching """_$P(MAGIN,"^",3)_"""" 90 . I $P(INFO,"^",3)>0 S MAGRY(0)=MAGRY(0)_" there are more" 91 . Q 92 Q 93 FINDERR(XI) ; 94 ; 95 I '+$G(XI) S XI=$O(MAGRY(""),-1)+1 96 S MAGRY(XI)="ERROR^"_^TMP("DIERR",$J,1,"TEXT",1) 97 Q
Note:
See TracChangeset
for help on using the changeset viewer.
