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