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

BMXRPC.m

Go to the documentation of this file. 
  1. BMXRPC ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  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(BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC) ;EP
  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.  ;---> 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.  ;
  1.  ;---> Set variables, kill temp globals.
  1.  N (BMXGBL,BMXFL,BMXFLDS,BMXFLG,BMXIN,BMXMX,BMXIX,BMXSCR,BMXMC) ;IHS/OIT/HMW SAC Exemption Applied For
  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, return error.
  1.  I '$G(BMXFL) 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(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.  ;---> Silent Fileman call.
  1.  D
  1.  .I $G(BMXIN)="" D  Q
  1.  ..D LIST^DIC(BMXFL,,BMXFLDS,,BMXMX,0,,BMXIX,BMXSCR,,BMXG,BMXG)
  1.  .D FIND^DIC(BMXFL,,BMXFLDS,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 Field Names
  1.  S $P(ASDX,"^",1)="IEN"
  1.  F ASDC=1:1:$L(BMXFLDS,";") D
  1.  . S ASDXFNUM=$P(BMXFLDS,";",ASDC)
  1.  . S ASDXFNAM=$P(^DD(BMXFL,ASDXFNUM,0),"^")
  1.  . S:ASDXFNAM="" ASDXFNAM="UNKNOWN"_ASDC
  1.  . S $P(ASDX,"^",ASDC+1)=ASDXFNAM
  1.  S ^BMXTEMP($J,1)=ASDX_$C(30)
  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=2:1 S N=$O(^BMXTMP($J,"DILIST",2,N)) Q:'N  D
  1.  .;---> Always set first piece of X=IEN of entry.
  1.  .S X=^BMXTMP($J,"DILIST",2,N)
  1.  .;
  1.  .;---> Collect other fields and concatenate to X.
  1.  .N M S M=0
  1.  .F  S M=$O(^BMXTMP($J,"DILIST","ID",N,M)) Q:'M  D
  1.  ..S X=X_U_^BMXTMP($J,"DILIST","ID",N,M)
  1.  .;
  1.  .;---> Convert data to mixed case if BMXMC=1.
  1.  .S:BMXMC X=$$T^BMXTRS(X)
  1.  .;
  1.  .;---> Set data in result global.
  1.  .S ^BMXTEMP($J,I)=X_$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 ^BMXTEMP($J,I)=BMX31_BMXERR
  1.  Q
  1.  ;
  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