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 Dec 13, 2024@02:02:31 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
