Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMXFIND

BMXFIND.m

Go to the documentation of this file. 
  1. BMXFIND ; IHS/OIT/HMW - BMX GENERIC FIND ;
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;
  1.  ;
  1. TABLE(BMXGBL,BMXFL)    ;EP
  1.  ;
  1.  ;---> If file number not provided check for file name.
  1.  ;S ^HW("BMXTABLE")=BMXFL
  1.  S BMX31=$C(31)_$C(31)
  1.  I +BMXFL'=BMXFL D
  1.  . S BMXFL=$TR(BMXFL,"_"," ")
  1.  . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
  1.  . S BMXFL=$O(^DIC("B",BMXFL,0))
  1.  I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
  1.  D FIND(.BMXGBL,BMXFL,"*",,,10,,,,1)
  1.  Q
  1.  ;
  1. FIND(BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC,BMXNUM) ;EP
  1.  ;
  1.  ;TODO:
  1.  ; -- Return column info even if no rows returned
  1.  ;
  1.  ;---> Places matching records from requested file into a
  1.  ;---> result global, ^BMXTEMP($J).  The exact global name
  1.  ;---> is returned in the first parameter (BMXGBL).
  1.  ;---> Records are returned one per node in the result global.
  1.  ;---> Each record is terminated with a $C(30), for parsing out
  1.  ;---> on the VB side, since the Broker concatenates all nodes
  1.  ;---> into a single string when passing the data out of M.
  1.  ;---> Requested fields within records are delimited by "^".
  1.  ;---> NOTE: The first "^"-piece of every node is the IEN of
  1.  ;---> that entry in its file; the requested fields follow.
  1.  ;---> The final record (node) contains Error Delimiter,
  1.  ;     $C(31)_$C(31), followed by error text, if any.
  1.  ;
  1.  ;
  1.  ;---> Parameters:
  1.  ;     1 - BMXGBL   (ret) Name of result global for Broker.
  1.  ;     2 - BMXFL    (req) File for lookup.
  1.  ;     3 - BMXFLDS  (opt) Fields to return w/each entry.
  1.  ;     4 - BMXFLG   (opt) Flags in DIC(0); If null, "M" is sent.
  1.  ;     5 - BMXIN    (opt) Input to match on (see Algorithm below).
  1.  ;     6 - BMXMX    (opt) Maximum number of entries to return.
  1.  ;     7 - BMXIX    (opt) Indexes to search.
  1.  ;     8 - BMXSCR   (opt) Screen/filter (M code).
  1.  ;     9 - BMXMC    (opt) Mixed Case: 1=mixed case, 0=no change.
  1.  ;                        (Converts data in uppercase to mixed case.)
  1.  ;    10 - BMXNUM   (opt) Include IEN in returned recordset (1=true)
  1.  ;
  1.  ;---> Set variables, kill temp globals.
  1.  ;N (BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC)
  1.  S BMX31=$C(31)_$C(31)
  1.  S BMXGBL="^BMXTEMP("_$J_")",BMXERR="",U="^"
  1.  K ^BMXTMP($J),^BMXTEMP($J)
  1.  ;
  1.  ;---> If file number not provided check for file name.
  1.  I +BMXFL'=BMXFL D
  1.  . I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
  1.  . S BMXFL=$O(^DIC("B",BMXFL,0))
  1.  I '$G(BMXFL) D ERROUT("File number not provided.",1) Q
  1.  ;
  1.  ;---> If no fields provided, pass .01.
  1.  ;---> NOTE: If .01 is NOT included, but the Index to lookup on is
  1.  ;--->       NOT on the .01, then the .01 will be returned
  1.  ;--->       automatically as the second ^-piece of data in the
  1.  ;--->       Result Global.  
  1.  ;--->       So it would be: IEN^.01^requested fields...
  1.  I $G(BMXFLDS)="" S BMXFLDS=".01"
  1.  ;
  1.  ;---> If no index or flag provided, set flag="M".
  1.  I $G(BMXFLG)="" D
  1.  .I $G(BMXIX)="" S BMXFLG="M" Q
  1.  .S BMXFLG=""
  1.  ;
  1.  ;---> If no Maximum Number provided, set it to 200.
  1.  I '$G(BMXMX) S BMXMX=200
  1.  ;
  1.  ;---> Define index and screen.
  1.  S:'$D(BMXIX) BMXIX=""
  1.  S:'$D(BMXSCR) BMXSCR=""
  1.  ;
  1.  ;---> Set Target Global for output and errors.
  1.  S BMXG="^BMXTMP($J)"
  1.  ;
  1.  ;---> If Mixed Case not set, set to No Change.
  1.  I '$D(BMXMC) S BMXMC=0
  1.  ;
  1.  ;---> If Return IEN not set, set to No
  1.  I '$D(BMXNUM) S BMXNUM=0
  1.  S BMXNUM=+BMXNUM
  1.  ;
  1.  ;---> Silent Fileman call.
  1.  D
  1.  .I $G(BMXIN)="" D  Q
  1.  ..D LIST^DIC(BMXFL,,,,BMXMX,0,,BMXIX,BMXSCR,,BMXG,BMXG)
  1.  .D FIND^DIC(BMXFL,,,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,,BMXG,BMXG)
  1.  ;
  1.  D WRITE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. WRITE ;EP
  1.  ;---> Collect data for matching records and write in result global.
  1.  ;
  1.  ;---> First, check for errors.
  1.  ;---> If errors exist, write them and quit.
  1.  N I,N,X
  1.  I $D(^BMXTMP($J,"DIERR")) I $O(^("DIERR",0)) D  Q
  1.  .S N=0,X=""
  1.  .F  S N=$O(^BMXTMP($J,"DIERR",N)) Q:'N  D
  1.  ..N M S M=0
  1.  ..F  S M=$O(^BMXTMP($J,"DIERR",N,"TEXT",M)) Q:'M  D
  1.  ...S X=X_^BMXTMP($J,"DIERR",N,"TEXT",M)_"  "
  1.  .D ERROUT(X,1)
  1.  ;
  1.  ;
  1.  ;---> Write valid results.
  1.  ;---> Loop through the IEN node (...2,N) of the temp global.
  1.  ;     and call GETS^DIQ for each record
  1.  N I,N,X S N=0
  1.  S BMXA="A"
  1.  ;B
  1.  S I=0
  1.  S BMXFLDF=0
  1. RESULTS F  S N=$O(^BMXTMP($J,"DILIST",2,N)) Q:'N  D
  1.  . S X=^BMXTMP($J,"DILIST",2,N)
  1.  . S I=I+1
  1.  . K A
  1.  . D GETS^DIQ(BMXFL,X_",",BMXFLDS,,BMXA,BMXA)
  1.  . ;--->Once only, write field names
  1.  . D:'BMXFLDF FIELDS
  1.  . ;
  1.  . ;
  1.  . ;---> Loop through results global
  1.  . S F=0,BMXCNT=0
  1.  . F  S F=$O(A(BMXFL,X_",",F)) Q:'F  S BMXCNT=BMXCNT+1
  1.  . S F=0
  1.  . S BMXREC=""
  1.  . S:BMXNUM ^BMXTEMP($J,I)=X_"^"
  1.  . S BMXCNTB=0
  1.  . S BMXORD=BMXNUM
  1.  . 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
  1.  . . S BMXORD=BMXORD+1
  1.  . . I $P(^DD(BMXFL,F,0),U,2) D  I 1 ;Multiple or WP
  1.  . . . ;Get the subfile number into FL1
  1.  . . . S FL1=+$P(^DD(BMXFL,F,0),U,2)
  1.  . . . S FLD1=$O(^DD(FL1,0))
  1.  . . . I $P(^DD(FL1,FLD1,0),U,2)["W" D  ;WP
  1.  . . . . S WPL=0,BMXLTMP=0
  1.  . . . . F  S WPL=$O(A(BMXFL,X_",",F,WPL)) Q:'WPL  S I=I+1 D
  1.  . . . . . S ^BMXTEMP($J,I)=A(BMXFL,X_",",F,WPL)_" "
  1.  . . . . . S BMXLTMP=BMXLTMP+$L(A(BMXFL,X_",",F,WPL))+1
  1.  . . . . . Q
  1.  . . . . S:BMXLTMP>BMXLEN(BMXORD) BMXLEN(BMXORD)=BMXLTMP
  1.  . . . . Q
  1.  . . . D  ;It's a multiple.  Implement in next phase
  1.  . . . . Q  ;
  1.  . . . Q
  1.  . . E  D  ;Not a multiple
  1.  . . . S I=I+1
  1.  . . . S ^BMXTEMP($J,I)=A(BMXFL,X_",",F)
  1.  . . . S:$L(A(BMXFL,X_",",F))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFL,X_",",F))
  1.  . . . Q
  1.  . . Q
  1.  . ;---> Convert data to mixed case if BMXMC=1.
  1.  . ;S:BMXMC BMXREC=$$T^BMXTRS(BMXREC)
  1.  . ;---> Set data in result global.
  1.  . S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_$C(30)
  1.  ;
  1.  ;---> If no results, report it as an error.
  1.  D:'$O(^BMXTEMP($J,0))
  1.  .I BMXIN]"" S BMXERR="No entry matches """_BMXIN_"""." Q
  1.  .S BMXERR="Either the lookup file is empty"
  1.  .S BMXERR=BMXERR_" or all entries are screened (software error)."
  1.  ;
  1.  ;---> Tack on Error Delimiter and any error.
  1.  S I=I+1
  1.  S ^BMXTEMP($J,I)=BMX31_BMXERR
  1.  ;---> Column types and widths
  1.  S C=0
  1.  F  S C=$O(BMXLEN(C)) Q:'C  D
  1.  . I BMXLEN(C)>99999 S BMXLEN(C)=99999
  1.  . S ^BMXTEMP($J,C)=BMXTYP(C)_$$NUMCHAR(BMXLEN(C))_^BMXTEMP($J,C)
  1.  Q
  1.  ;
  1.  ;
  1. NUMCHAR(BMXN)      ;EP
  1.  ;---> Returns Field Length left-padded with 0
  1.  ;
  1.  N BMXC
  1.  S BMXC="00000"_BMXN
  1.  Q $E(BMXC,$L(BMXC)-4,$L(BMXC))
  1.  ;
  1.  ;---> Dead code follows
  1.  N C,BMXC,F,N,J
  1.  S BMXC=""
  1.  S N=BMXN
  1.  S:N>99999 N=99999
  1.  S:N<0 N=0
  1.  F J=1:1:$L(N) D
  1.  . S F=10**(J-1)
  1.  . S C=65+(N-((N\(10*F))*(10*F))\F)
  1.  . S C=$C(C)
  1.  . S BMXC=C_BMXC
  1.  S BMXC="AAAAA"_BMXC
  1.  Q $E(BMXC,$L(BMXC)-4,$L(BMXC))
  1.  ;
  1.  ;
  1. FIELDS ;---> Write Field Names
  1.  ;Field name is TAAAAANAME
  1.  ;Where T is the field type (T=Text; D=Date)
  1.  ;      AAAAA is the field size (see NUMCHAR routine)
  1.  ;      NAME is the field name
  1.  S BMXFLDF=1
  1.  K BMXLEN,BMXTYP
  1.  D:$D(A)
  1.  . I BMXNUM S ^BMXTEMP($J,I)="IEN^",BMXLEN(I)=10,BMXTYP(I)="T",I=I+1 ;TODO: Change from text to number
  1.  . S ASDXFNUM=0
  1.  . S BMXIENS=$O(A(BMXFL,0))
  1.  . F  S ASDXFNUM=$O(A(BMXFL,BMXIENS,ASDXFNUM)) Q:'ASDXFNUM  D
  1.  . . S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^") ;Get type here
  1.  . . S ASDXFNAM=$TR(ASDXFNAM," ","_")
  1.  . . S BMXTYP(I)="T"
  1.  . . S BMXLEN(I)=0 ;Start with length zero
  1.  . . S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_I
  1.  . . S ^BMXTEMP($J,I)=ASDXFNAM_"^"
  1.  . . S I=I+1
  1.  . S ^BMXTEMP($J,I-1)=$E(^BMXTEMP($J,I-1),1,$L(^BMXTEMP($J,I-1))-1)_$C(30)
  1.  Q
  1.  ;
  1.  ;----------
  1. ERROUT(BMXERR,I) ;EP
  1.  ;---> Save next line for Error Code File if ever used.
  1.  ;---> If necessary, use I>1 to avoid overwriting valid data.
  1.  S:'$G(I) I=1
  1.  S ^BMXTEMP($J,I)=BMX31_BMXERR
  1.  Q
  1.  ;
  1.  ;
  1. PASSERR(BMXGBL,BMXERR) ;EP
  1.  ;---> If the RPC routine calling the BMX Generic Lookup above
  1.  ;---> detects a specific error prior to the call and wants to pass 
  1.  ;---> that error in the result global rather than a generic error,
  1.  ;---> then a call to this function (PASSERR) can be made.
  1.  ;---> This call will store the error text passed in the result global.
  1.  ;---> The calling routine should then quit (abort its call to the
  1.  ;---> BMX Generic Lookup function above).
  1.  ;
  1.  ;---> Parameters:
  1.  ;     1 - BMXGBL  (ret) Name of result global for Broker.
  1.  ;     2 - BMXERR  (req) Text of error to be stored in result global.
  1.  ;
  1.  S:$G(BMXERR)="" BMXERR="Error not passed (software error)."
  1.  ;
  1.  N BMX31 S BMX31=$C(31)_$C(31)
  1.  K ^BMXTMP($J),^BMXTEMP($J)
  1.  S BMXGBL="^BMXTEMP("_$J_")"
  1.  S ^BMXTEMP($J,1)=BMX31_BMXERR
  1.  Q