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

BIXRPC.m

Go to the documentation of this file. 
  1. BIXRPC ;IHS/CMI/MWR - BI REMOTE PROCEDURE CALLS; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  GENERIC LOOKUP UTILITY FOR RETURNING MATCHING RECORDS
  1.  ;;  OR TABLES TO RPC'S.
  1.  ;
  1.  ; *** NOTE: I have discovered a number of cases where these calls
  1.  ;           produce errors (with error messages to IO) or simply
  1.  ;           do not work correctly.  ANY CALL to this utility
  1.  ;           should be thoroughly tested in the M environment
  1.  ;           before being used as an RPC.
  1.  ;
  1.  ;----------
  1. LOOKUP(BIGBL,BIFL,BIFLDS,BIFLG,BIIN,BIMX,BIIX,BISCR,BIMC) ;EP
  1.  ;---> Places matching records from requested file into a
  1.  ;---> result global, ^BITEMP($J).  The exact global name
  1.  ;---> is returned in the first parameter (BIGBL).
  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.  ;---> Parameters:
  1.  ;     1 - BIGBL   (ret) Name of result global for Broker.
  1.  ;     2 - BIFL    (req) File for lookup.
  1.  ;     3 - BIFLDS  (opt) Fields to return w/each entry.
  1.  ;     4 - BIFLG   (opt) Flags in DIC(0); If null, "M" is sent.
  1.  ;     5 - BIIN    (opt) Input to match on (see Algorithm below).
  1.  ;     6 - BIMX    (opt) Maximum number of entries to return.
  1.  ;     7 - BIIX    (opt) Indexes to search.
  1.  ;     8 - BISCR   (opt) Screen/filter (M code).
  1.  ;     9 - BIMC    (opt) Mixed Case: 1=mixed case, 0=no change.
  1.  ;                        (Converts data in uppercase to mixed case.)
  1.  ;
  1.  ;---> Set variables, kill temp globals.
  1.  N (BIGBL,BIFL,BIFLDS,BIFLG,BIIN,BIMX,BIIX,BISCR,BIMC)
  1.  S BI31=$C(31)_$C(31)
  1.  S BIGBL="^BITEMP("_$J_")",BIERR="",U="^"
  1.  K ^BITMP($J),^BITEMP($J)
  1.  ;
  1.  ;---> If file number not provided, return error.
  1.  I '$G(BIFL) D ERROUT("File number not provided.",1) Q
  1.  ;
  1.  ;---> If no fields provided, pass .01.
  1.  ;---> IEN will always be the first piece of data returned.
  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(BIFLDS)="" S BIFLDS=".01"
  1.  ;
  1.  ;---> If no index or flag provided, set flag="M".
  1.  I $G(BIFLG)="" D
  1.  .I $G(BIIX)="" S BIFLG="M" Q
  1.  .S BIFLG=""
  1.  ;
  1.  ;---> If no Maximum Number provided, set it to 200.
  1.  I '$G(BIMX) S BIMX=200
  1.  ;
  1.  ;---> Define index and screen.
  1.  S:'$D(BIIX) BIIX=""
  1.  S:'$D(BISCR) BISCR=""
  1.  ;
  1.  ;---> Set Target Global for output and errors.
  1.  S BIG="^BITMP($J)"
  1.  ;
  1.  ;---> If Mixed Case not set, set to No Change.
  1.  I '$D(BIMC) S BIMC=0
  1.  ;
  1.  ;---> Silent Fileman call.
  1.  D
  1.  .I $G(BIIN)="" D  Q
  1.  ..D LIST^DIC(BIFL,,BIFLDS,,BIMX,0,,BIIX,BISCR,,BIG,BIG)
  1.  .D FIND^DIC(BIFL,,BIFLDS,BIFLG,BIIN,BIMX,BIIX,BISCR,,BIG,BIG)
  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(^BITMP($J,"DIERR")) I $O(^("DIERR",0)) D  Q
  1.  .S N=0,X=""
  1.  .F  S N=$O(^BITMP($J,"DIERR",N)) Q:'N  D
  1.  ..N M S M=0
  1.  ..F  S M=$O(^BITMP($J,"DIERR",N,"TEXT",M)) Q:'M  D
  1.  ...S X=X_^BITMP($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.  N I,N,X S N=0
  1.  F I=1:1 S N=$O(^BITMP($J,"DILIST",2,N)) Q:'N  D
  1.  .;---> Always set first piece of X=IEN of entry.
  1.  .S X=^BITMP($J,"DILIST",2,N)
  1.  .;
  1.  .;---> Collect other fields and concatenate to X.
  1.  .N M S M=0
  1.  .F  S M=$O(^BITMP($J,"DILIST","ID",N,M)) Q:'M  D
  1.  ..S X=X_U_^BITMP($J,"DILIST","ID",N,M)
  1.  .;
  1.  .;---> Convert data to mixed case if BIMC=1.
  1.  .S:BIMC X=$$T^BITRS(X)
  1.  .;
  1.  .;---> Set data in result global.
  1.  .S ^BITEMP($J,I)=X_$C(30)
  1.  ;
  1.  ;---> If no results, report it as an error.
  1.  D:'$O(^BITEMP($J,0))
  1.  .I BIIN]"" S BIERR="No entry matches """_BIIN_"""." Q
  1.  .S BIERR="Either the lookup file is empty"
  1.  .S BIERR=BIERR_" or all entries are screened (software error)."
  1.  ;
  1.  ;---> Tack on Error Delimiter and any error.
  1.  S ^BITEMP($J,I)=BI31_BIERR
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. ERROUT(BIERR,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.  ;D ERRCD^BIUTL2(BIERR,.BIERR)
  1.  S:'$G(I) I=1
  1.  S ^BITEMP($J,I)=BI31_BIERR
  1.  Q
  1.  ;
  1.  ;
  1. PASSERR(BIGBL,BIERR) ;EP
  1.  ;---> If the RPC routine calling the BI 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.  ;---> BI Generic Lookup function above).
  1.  ;
  1.  ;---> Parameters:
  1.  ;     1 - BIGBL  (ret) Name of result global for Broker.
  1.  ;     2 - BIERR  (req) Text of error to be stored in result global.
  1.  ;
  1.  S:$G(BIERR)="" BIERR="Error not passed (software error)."
  1.  ;
  1.  N BI31 S BI31=$C(31)_$C(31)
  1.  K ^BITMP($J),^BITEMP($J)
  1.  S BIGBL="^BITEMP("_$J_")"
  1.  S ^BITEMP($J,1)=BI31_BIERR
  1.  Q