BMXFIND ; IHS/OIT/HMW - BMX GENERIC FIND ;
;;4.0;BMX;;JUN 28, 2010
;
;
TABLE(BMXGBL,BMXFL) ;EP
;
;---> If file number not provided check for file name.
;S ^HW("BMXTABLE")=BMXFL
S BMX31=$C(31)_$C(31)
I +BMXFL'=BMXFL D
. S BMXFL=$TR(BMXFL,"_"," ")
. I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
. S BMXFL=$O(^DIC("B",BMXFL,0))
I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
D FIND(.BMXGBL,BMXFL,"*",,,10,,,,1)
Q
;
FIND(BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC,BMXNUM) ;EP
;
;TODO:
; -- Return column info even if no rows returned
;
;---> Places matching records from requested file into a
;---> result global, ^BMXTEMP($J). The exact global name
;---> is returned in the first parameter (BMXGBL).
;---> Records are returned one per node in the result global.
;---> Each record is terminated with a $C(30), for parsing out
;---> on the VB side, since the Broker concatenates all nodes
;---> into a single string when passing the data out of M.
;---> Requested fields within records are delimited by "^".
;---> NOTE: The first "^"-piece of every node is the IEN of
;---> that entry in its file; the requested fields follow.
;---> The final record (node) contains Error Delimiter,
; $C(31)_$C(31), followed by error text, if any.
;
;
;---> Parameters:
; 1 - BMXGBL (ret) Name of result global for Broker.
; 2 - BMXFL (req) File for lookup.
; 3 - BMXFLDS (opt) Fields to return w/each entry.
; 4 - BMXFLG (opt) Flags in DIC(0); If null, "M" is sent.
; 5 - BMXIN (opt) Input to match on (see Algorithm below).
; 6 - BMXMX (opt) Maximum number of entries to return.
; 7 - BMXIX (opt) Indexes to search.
; 8 - BMXSCR (opt) Screen/filter (M code).
; 9 - BMXMC (opt) Mixed Case: 1=mixed case, 0=no change.
; (Converts data in uppercase to mixed case.)
; 10 - BMXNUM (opt) Include IEN in returned recordset (1=true)
;
;---> Set variables, kill temp globals.
;N (BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC)
S BMX31=$C(31)_$C(31)
S BMXGBL="^BMXTEMP("_$J_")",BMXERR="",U="^"
K ^BMXTMP($J),^BMXTEMP($J)
;
;---> If file number not provided check for file name.
I +BMXFL'=BMXFL D
. I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
. S BMXFL=$O(^DIC("B",BMXFL,0))
I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
;
;---> If no fields provided, pass .01.
;---> NOTE: If .01 is NOT included, but the Index to lookup on is
;---> NOT on the .01, then the .01 will be returned
;---> automatically as the second ^-piece of data in the
;---> Result Global.
;---> So it would be: IEN^.01^requested fields...
I $G(BMXFLDS)="" S BMXFLDS=".01"
;
;---> If no index or flag provided, set flag="M".
I $G(BMXFLG)="" D
.I $G(BMXIX)="" S BMXFLG="M" Q
.S BMXFLG=""
;
;---> If no Maximum Number provided, set it to 200.
I '$G(BMXMX) S BMXMX=200
;
;---> Define index and screen.
S:'$D(BMXIX) BMXIX=""
S:'$D(BMXSCR) BMXSCR=""
;
;---> Set Target Global for output and errors.
S BMXG="^BMXTMP($J)"
;
;---> If Mixed Case not set, set to No Change.
I '$D(BMXMC) S BMXMC=0
;
;---> If Return IEN not set, set to No
I '$D(BMXNUM) S BMXNUM=0
S BMXNUM=+BMXNUM
;
;---> Silent Fileman call.
D
.I $G(BMXIN)="" D Q
..D LIST^DIC(BMXFL,,,,BMXMX,0,,BMXIX,BMXSCR,,BMXG,BMXG)
.D FIND^DIC(BMXFL,,,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,,BMXG,BMXG)
;
D WRITE
Q
;
;
;----------
WRITE ;EP
;---> Collect data for matching records and write in result global.
;
;---> First, check for errors.
;---> If errors exist, write them and quit.
N I,N,X
I $D(^BMXTMP($J,"DIERR")) I $O(^("DIERR",0)) D Q
.S N=0,X=""
.F S N=$O(^BMXTMP($J,"DIERR",N)) Q:'N D
..N M S M=0
..F S M=$O(^BMXTMP($J,"DIERR",N,"TEXT",M)) Q:'M D
...S X=X_^BMXTMP($J,"DIERR",N,"TEXT",M)_" "
.D ERROUT(X,1)
;
;
;---> Write valid results.
;---> Loop through the IEN node (...2,N) of the temp global.
; and call GETS^DIQ for each record
N I,N,X S N=0
S BMXA="A"
;B
S I=0
S BMXFLDF=0
RESULTS F S N=$O(^BMXTMP($J,"DILIST",2,N)) Q:'N D
. S X=^BMXTMP($J,"DILIST",2,N)
. S I=I+1
. K A
. D GETS^DIQ(BMXFL,X_",",BMXFLDS,,BMXA,BMXA)
. ;--->Once only, write field names
. D:'BMXFLDF FIELDS
. ;
. ;
. ;---> Loop through results global
. S F=0,BMXCNT=0
. F S F=$O(A(BMXFL,X_",",F)) Q:'F S BMXCNT=BMXCNT+1
. S F=0
. S BMXREC=""
. S:BMXNUM ^BMXTEMP($J,I)=X_"^"
. S BMXCNTB=0
. S BMXORD=BMXNUM
. F S F=$O(A(BMXFL,X_",",F)) Q:'F S BMXCNTB=BMXCNTB+1 D S:BMXCNTB<BMXCNT ^BMXTEMP($J,I)=^BMXTEMP($J,I)_U
. . S BMXORD=BMXORD+1
. . I $P(^DD(BMXFL,F,0),U,2) D I 1 ;Multiple or WP
. . . ;Get the subfile number into FL1
. . . S FL1=+$P(^DD(BMXFL,F,0),U,2)
. . . S FLD1=$O(^DD(FL1,0))
. . . I $P(^DD(FL1,FLD1,0),U,2)["W" D ;WP
. . . . S WPL=0,BMXLTMP=0
. . . . F S WPL=$O(A(BMXFL,X_",",F,WPL)) Q:'WPL S I=I+1 D
. . . . . S ^BMXTEMP($J,I)=A(BMXFL,X_",",F,WPL)_" "
. . . . . S BMXLTMP=BMXLTMP+$L(A(BMXFL,X_",",F,WPL))+1
. . . . . Q
. . . . S:BMXLTMP>BMXLEN(BMXORD) BMXLEN(BMXORD)=BMXLTMP
. . . . Q
. . . D ;It's a multiple. Implement in next phase
. . . . Q ;
. . . Q
. . E D ;Not a multiple
. . . S I=I+1
. . . S ^BMXTEMP($J,I)=A(BMXFL,X_",",F)
. . . S:$L(A(BMXFL,X_",",F))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFL,X_",",F))
. . . Q
. . Q
. ;---> Convert data to mixed case if BMXMC=1.
. ;S:BMXMC BMXREC=$$T^BMXTRS(BMXREC)
. ;---> Set data in result global.
. S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_$C(30)
;
;---> If no results, report it as an error.
D:'$O(^BMXTEMP($J,0))
.I BMXIN]"" S BMXERR="No entry matches """_BMXIN_"""." Q
.S BMXERR="Either the lookup file is empty"
.S BMXERR=BMXERR_" or all entries are screened (software error)."
;
;---> Tack on Error Delimiter and any error.
S I=I+1
S ^BMXTEMP($J,I)=BMX31_BMXERR
;---> Column types and widths
S C=0
F S C=$O(BMXLEN(C)) Q:'C D
. I BMXLEN(C)>99999 S BMXLEN(C)=99999
. S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C)
Q
;
;
NUMCHAR(BMXN) ;EP
;---> Returns Field Length left-padded with 0
;
N BMXC
S BMXC="00000"_BMXN
Q $E(BMXC,$L(BMXC)-4,$L(BMXC))
;
;---> Dead code follows
N C,BMXC,F,N,J
S BMXC=""
S N=BMXN
S:N>99999 N=99999
S:N<0 N=0
F J=1:1:$L(N) D
. S F=10**(J-1)
. S C=65+(N-((N\(10*F))*(10*F))\F)
. S C=$C(C)
. S BMXC=C_BMXC
S BMXC="AAAAA"_BMXC
Q $E(BMXC,$L(BMXC)-4,$L(BMXC))
;
;
FIELDS ;---> Write Field Names
;Field name is TAAAAANAME
;Where T is the field type (T=Text; D=Date)
; AAAAA is the field size (see NUMCHAR routine)
; NAME is the field name
S BMXFLDF=1
K BMXLEN,BMXTYP
D:$D(A)
. I BMXNUM S ^BMXTEMP($J,I)="IEN^",BMXLEN(I)=10,BMXTYP(I)="T",I=I+1 ;TODO: Change from text to number
. S ASDXFNUM=0
. S BMXIENS=$O(A(BMXFL,0))
. F S ASDXFNUM=$O(A(BMXFL,BMXIENS,ASDXFNUM)) Q:'ASDXFNUM D
. . S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^") ;Get type here
. . S ASDXFNAM=$TR(ASDXFNAM," ","_")
. . S BMXTYP(I)="T"
. . S BMXLEN(I)=0 ;Start with length zero
. . S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_I
. . S ^BMXTEMP($J,I)=ASDXFNAM_"^"
. . S I=I+1
. S ^BMXTEMP($J,I-1)=$E(^BMXTEMP($J,I-1),1,$L(^BMXTEMP($J,I-1))-1)_$C(30)
Q
;
;----------
ERROUT(BMXERR,I) ;EP
;---> Save next line for Error Code File if ever used.
;---> If necessary, use I>1 to avoid overwriting valid data.
S:'$G(I) I=1
S ^BMXTEMP($J,I)=BMX31_BMXERR
Q
;
;
PASSERR(BMXGBL,BMXERR) ;EP
;---> If the RPC routine calling the BMX Generic Lookup above
;---> detects a specific error prior to the call and wants to pass
;---> that error in the result global rather than a generic error,
;---> then a call to this function (PASSERR) can be made.
;---> This call will store the error text passed in the result global.
;---> The calling routine should then quit (abort its call to the
;---> BMX Generic Lookup function above).
;
;---> Parameters:
; 1 - BMXGBL (ret) Name of result global for Broker.
; 2 - BMXERR (req) Text of error to be stored in result global.
;
S:$G(BMXERR)="" BMXERR="Error not passed (software error)."
;
N BMX31 S BMX31=$C(31)_$C(31)
K ^BMXTMP($J),^BMXTEMP($J)
S BMXGBL="^BMXTEMP("_$J_")"
S ^BMXTEMP($J,1)=BMX31_BMXERR
Q
BMXFIND ; IHS/OIT/HMW - BMX GENERIC FIND ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;
TABLE(BMXGBL,BMXFL) ;EP
+1 ;
+2 ;---> If file number not provided check for file name.
+3 ;S ^HW("BMXTABLE")=BMXFL
+4 SET BMX31=$CHAR(31)_$CHAR(31)
+5 IF +BMXFL'=BMXFL
Begin DoDot:1
+6 SET BMXFL=$TRANSLATE(BMXFL,"_"," ")
+7 IF '$DATA(^DIC("B",BMXFL))
SET BMXFL=""
QUIT
+8 SET BMXFL=$ORDER(^DIC("B",BMXFL,0))
End DoDot:1
+9 IF '$GET(BMXFL)
DO ERROUT("File number not provided.",1)
QUIT
+10 DO FIND(.BMXGBL,BMXFL,"*",,,10,,,,1)
+11 QUIT
+12 ;
FIND(BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC,BMXNUM) ;EP
+1 ;
+2 ;TODO:
+3 ; -- Return column info even if no rows returned
+4 ;
+5 ;---> Places matching records from requested file into a
+6 ;---> result global, ^BMXTEMP($J). The exact global name
+7 ;---> is returned in the first parameter (BMXGBL).
+8 ;---> Records are returned one per node in the result global.
+9 ;---> Each record is terminated with a $C(30), for parsing out
+10 ;---> on the VB side, since the Broker concatenates all nodes
+11 ;---> into a single string when passing the data out of M.
+12 ;---> Requested fields within records are delimited by "^".
+13 ;---> NOTE: The first "^"-piece of every node is the IEN of
+14 ;---> that entry in its file; the requested fields follow.
+15 ;---> The final record (node) contains Error Delimiter,
+16 ; $C(31)_$C(31), followed by error text, if any.
+17 ;
+18 ;
+19 ;---> Parameters:
+20 ; 1 - BMXGBL (ret) Name of result global for Broker.
+21 ; 2 - BMXFL (req) File for lookup.
+22 ; 3 - BMXFLDS (opt) Fields to return w/each entry.
+23 ; 4 - BMXFLG (opt) Flags in DIC(0); If null, "M" is sent.
+24 ; 5 - BMXIN (opt) Input to match on (see Algorithm below).
+25 ; 6 - BMXMX (opt) Maximum number of entries to return.
+26 ; 7 - BMXIX (opt) Indexes to search.
+27 ; 8 - BMXSCR (opt) Screen/filter (M code).
+28 ; 9 - BMXMC (opt) Mixed Case: 1=mixed case, 0=no change.
+29 ; (Converts data in uppercase to mixed case.)
+30 ; 10 - BMXNUM (opt) Include IEN in returned recordset (1=true)
+31 ;
+32 ;---> Set variables, kill temp globals.
+33 ;N (BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC)
+34 SET BMX31=$CHAR(31)_$CHAR(31)
+35 SET BMXGBL="^BMXTEMP("_$JOB_")"
SET BMXERR=""
SET U="^"
+36 KILL ^BMXTMP($JOB),^BMXTEMP($JOB)
+37 ;
+38 ;---> If file number not provided check for file name.
+39 IF +BMXFL'=BMXFL
Begin DoDot:1
+40 IF '$DATA(^DIC("B",BMXFL))
SET BMXFL=""
QUIT
+41 SET BMXFL=$ORDER(^DIC("B",BMXFL,0))
End DoDot:1
+42 IF '$GET(BMXFL)
DO ERROUT("File number not provided.",1)
QUIT
+43 ;
+44 ;---> If no fields provided, pass .01.
+45 ;---> NOTE: If .01 is NOT included, but the Index to lookup on is
+46 ;---> NOT on the .01, then the .01 will be returned
+47 ;---> automatically as the second ^-piece of data in the
+48 ;---> Result Global.
+49 ;---> So it would be: IEN^.01^requested fields...
+50 IF $GET(BMXFLDS)=""
SET BMXFLDS=".01"
+51 ;
+52 ;---> If no index or flag provided, set flag="M".
+53 IF $GET(BMXFLG)=""
Begin DoDot:1
+54 IF $GET(BMXIX)=""
SET BMXFLG="M"
QUIT
+55 SET BMXFLG=""
End DoDot:1
+56 ;
+57 ;---> If no Maximum Number provided, set it to 200.
+58 IF '$GET(BMXMX)
SET BMXMX=200
+59 ;
+60 ;---> Define index and screen.
+61 IF '$DATA(BMXIX)
SET BMXIX=""
+62 IF '$DATA(BMXSCR)
SET BMXSCR=""
+63 ;
+64 ;---> Set Target Global for output and errors.
+65 SET BMXG="^BMXTMP($J)"
+66 ;
+67 ;---> If Mixed Case not set, set to No Change.
+68 IF '$DATA(BMXMC)
SET BMXMC=0
+69 ;
+70 ;---> If Return IEN not set, set to No
+71 IF '$DATA(BMXNUM)
SET BMXNUM=0
+72 SET BMXNUM=+BMXNUM
+73 ;
+74 ;---> Silent Fileman call.
+75 Begin DoDot:1
+76 IF $GET(BMXIN)=""
Begin DoDot:2
+77 DO LIST^DIC(BMXFL,,,,BMXMX,0,,BMXIX,BMXSCR,,BMXG,BMXG)
End DoDot:2
QUIT
+78 DO FIND^DIC(BMXFL,,,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,,BMXG,BMXG)
End DoDot:1
+79 ;
+80 DO WRITE
+81 QUIT
+82 ;
+83 ;
+84 ;----------
WRITE ;EP
+1 ;---> Collect data for matching records and write in result global.
+2 ;
+3 ;---> First, check for errors.
+4 ;---> If errors exist, write them and quit.
+5 NEW I,N,X
+6 IF $DATA(^BMXTMP($JOB,"DIERR"))
IF $ORDER(^("DIERR",0))
Begin DoDot:1
+7 SET N=0
SET X=""
+8 FOR
SET N=$ORDER(^BMXTMP($JOB,"DIERR",N))
IF 'N
QUIT
Begin DoDot:2
+9 NEW M
SET M=0
+10 FOR
SET M=$ORDER(^BMXTMP($JOB,"DIERR",N,"TEXT",M))
IF 'M
QUIT
Begin DoDot:3
+11 SET X=X_^BMXTMP($JOB,"DIERR",N,"TEXT",M)_" "
End DoDot:3
End DoDot:2
+12 DO ERROUT(X,1)
End DoDot:1
QUIT
+13 ;
+14 ;
+15 ;---> Write valid results.
+16 ;---> Loop through the IEN node (...2,N) of the temp global.
+17 ; and call GETS^DIQ for each record
+18 NEW I,N,X
SET N=0
+19 SET BMXA="A"
+20 ;B
+21 SET I=0
+22 SET BMXFLDF=0
RESULTS FOR
SET N=$ORDER(^BMXTMP($JOB,"DILIST",2,N))
IF 'N
QUIT
Begin DoDot:1
+1 SET X=^BMXTMP($JOB,"DILIST",2,N)
+2 SET I=I+1
+3 KILL A
+4 DO GETS^DIQ(BMXFL,X_",",BMXFLDS,,BMXA,BMXA)
+5 ;--->Once only, write field names
+6 IF 'BMXFLDF
DO FIELDS
+7 ;
+8 ;
+9 ;---> Loop through results global
+10 SET F=0
SET BMXCNT=0
+11 FOR
SET F=$ORDER(A(BMXFL,X_",",F))
IF 'F
QUIT
SET BMXCNT=BMXCNT+1
+12 SET F=0
+13 SET BMXREC=""
+14 IF BMXNUM
SET ^BMXTEMP($JOB,I)=X_"^"
+15 SET BMXCNTB=0
+16 SET BMXORD=BMXNUM
+17 FOR
SET F=$ORDER(A(BMXFL,X_",",F))
IF 'F
QUIT
SET BMXCNTB=BMXCNTB+1
Begin DoDot:2
+18 SET BMXORD=BMXORD+1
+19 ;Multiple or WP
IF $PIECE(^DD(BMXFL,F,0),U,2)
Begin DoDot:3
+20 ;Get the subfile number into FL1
+21 SET FL1=+$PIECE(^DD(BMXFL,F,0),U,2)
+22 SET FLD1=$ORDER(^DD(FL1,0))
+23 ;WP
IF $PIECE(^DD(FL1,FLD1,0),U,2)["W"
Begin DoDot:4
+24 SET WPL=0
SET BMXLTMP=0
+25 FOR
SET WPL=$ORDER(A(BMXFL,X_",",F,WPL))
IF 'WPL
QUIT
SET I=I+1
Begin DoDot:5
+26 SET ^BMXTEMP($JOB,I)=A(BMXFL,X_",",F,WPL)_" "
+27 SET BMXLTMP=BMXLTMP+$LENGTH(A(BMXFL,X_",",F,WPL))+1
+28 QUIT
End DoDot:5
+29 IF BMXLTMP>BMXLEN(BMXORD)
SET BMXLEN(BMXORD)=BMXLTMP
+30 QUIT
End DoDot:4
+31 ;It's a multiple. Implement in next phase
Begin DoDot:4
+32 ;
QUIT
End DoDot:4
+33 QUIT
End DoDot:3
IF 1
+34 ;Not a multiple
IF '$TEST
Begin DoDot:3
+35 SET I=I+1
+36 SET ^BMXTEMP($JOB,I)=A(BMXFL,X_",",F)
+37 IF $LENGTH(A(BMXFL,X_",",F))>BMXLEN(BMXORD)
SET BMXLEN(BMXORD)=$LENGTH(A(BMXFL,X_",",F))
+38 QUIT
End DoDot:3
+39 QUIT
End DoDot:2
IF BMXCNTB<BMXCNT
SET ^BMXTEMP($JOB,I)=^BMXTEMP($JOB,I)_U
+40 ;---> Convert data to mixed case if BMXMC=1.
+41 ;S:BMXMC BMXREC=$$T^BMXTRS(BMXREC)
+42 ;---> Set data in result global.
+43 SET ^BMXTEMP($JOB,I)=^BMXTEMP($JOB,I)_$CHAR(30)
End DoDot:1
+44 ;
+45 ;---> If no results, report it as an error.
+46 IF '$ORDER(^BMXTEMP($JOB,0))
Begin DoDot:1
+47 IF BMXIN]""
SET BMXERR="No entry matches """_BMXIN_"""."
QUIT
+48 SET BMXERR="Either the lookup file is empty"
+49 SET BMXERR=BMXERR_" or all entries are screened (software error)."
End DoDot:1
+50 ;
+51 ;---> Tack on Error Delimiter and any error.
+52 SET I=I+1
+53 SET ^BMXTEMP($JOB,I)=BMX31_BMXERR
+54 ;---> Column types and widths
+55 SET C=0
+56 FOR
SET C=$ORDER(BMXLEN(C))
IF 'C
QUIT
Begin DoDot:1
+57 IF BMXLEN(C)>99999
SET BMXLEN(C)=99999
+58 SET ^BMXTEMP($JOB,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($JOB,C)
End DoDot:1
+59 QUIT
+60 ;
+61 ;
NUMCHAR(BMXN) ;EP
+1 ;---> Returns Field Length left-padded with 0
+2 ;
+3 NEW BMXC
+4 SET BMXC="00000"_BMXN
+5 QUIT $EXTRACT(BMXC,$LENGTH(BMXC)-4,$LENGTH(BMXC))
+6 ;
+7 ;---> Dead code follows
+8 NEW C,BMXC,F,N,J
+9 SET BMXC=""
+10 SET N=BMXN
+11 IF N>99999
SET N=99999
+12 IF N<0
SET N=0
+13 FOR J=1:1:$LENGTH(N)
Begin DoDot:1
+14 SET F=10**(J-1)
+15 SET C=65+(N-((N\(10*F))*(10*F))\F)
+16 SET C=$CHAR(C)
+17 SET BMXC=C_BMXC
End DoDot:1
+18 SET BMXC="AAAAA"_BMXC
+19 QUIT $EXTRACT(BMXC,$LENGTH(BMXC)-4,$LENGTH(BMXC))
+20 ;
+21 ;
FIELDS ;---> Write Field Names
+1 ;Field name is TAAAAANAME
+2 ;Where T is the field type (T=Text; D=Date)
+3 ; AAAAA is the field size (see NUMCHAR routine)
+4 ; NAME is the field name
+5 SET BMXFLDF=1
+6 KILL BMXLEN,BMXTYP
+7 IF $DATA(A)
Begin DoDot:1
+8 ;TODO: Change from text to number
IF BMXNUM
SET ^BMXTEMP($JOB,I)="IEN^"
SET BMXLEN(I)=10
SET BMXTYP(I)="T"
SET I=I+1
+9 SET ASDXFNUM=0
+10 SET BMXIENS=$ORDER(A(BMXFL,0))
+11 FOR
SET ASDXFNUM=$ORDER(A(BMXFL,BMXIENS,ASDXFNUM))
IF 'ASDXFNUM
QUIT
Begin DoDot:2
+12 ;Get type here
SET ASDXFNAM=$PIECE(^DD(BMXFL,ASDXFNUM,0),"^")
+13 SET ASDXFNAM=$TRANSLATE(ASDXFNAM," ","_")
+14 SET BMXTYP(I)="T"
+15 ;Start with length zero
SET BMXLEN(I)=0
+16 IF ASDXFNAM=""
SET ASDXFNAM="UNKNOWN"_I
+17 SET ^BMXTEMP($JOB,I)=ASDXFNAM_"^"
+18 SET I=I+1
End DoDot:2
+19 SET ^BMXTEMP($JOB,I-1)=$EXTRACT(^BMXTEMP($JOB,I-1),1,$LENGTH(^BMXTEMP($JOB,I-1))-1)_$CHAR(30)
End DoDot:1
+20 QUIT
+21 ;
+22 ;----------
ERROUT(BMXERR,I) ;EP
+1 ;---> Save next line for Error Code File if ever used.
+2 ;---> If necessary, use I>1 to avoid overwriting valid data.
+3 IF '$GET(I)
SET I=1
+4 SET ^BMXTEMP($JOB,I)=BMX31_BMXERR
+5 QUIT
+6 ;
+7 ;
PASSERR(BMXGBL,BMXERR) ;EP
+1 ;---> If the RPC routine calling the BMX Generic Lookup above
+2 ;---> detects a specific error prior to the call and wants to pass
+3 ;---> that error in the result global rather than a generic error,
+4 ;---> then a call to this function (PASSERR) can be made.
+5 ;---> This call will store the error text passed in the result global.
+6 ;---> The calling routine should then quit (abort its call to the
+7 ;---> BMX Generic Lookup function above).
+8 ;
+9 ;---> Parameters:
+10 ; 1 - BMXGBL (ret) Name of result global for Broker.
+11 ; 2 - BMXERR (req) Text of error to be stored in result global.
+12 ;
+13 IF $GET(BMXERR)=""
SET BMXERR="Error not passed (software error)."
+14 ;
+15 NEW BMX31
SET BMX31=$CHAR(31)_$CHAR(31)
+16 KILL ^BMXTMP($JOB),^BMXTEMP($JOB)
+17 SET BMXGBL="^BMXTEMP("_$JOB_")"
+18 SET ^BMXTEMP($JOB,1)=BMX31_BMXERR
+19 QUIT
