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

CIAURPC.m

Go to the documentation of this file. 
  1. CIAURPC ;MSC/IND/DKM - RPC Encapsulations for CIAU routines ;04-May-2006 08:19;DKM
  1.  ;;1.2;CIA UTILITIES;;Mar 20, 2007
  1.  ;;Copyright 2000-2006, Medsphere Systems Corporation
  1.  ;=================================================================
  1.  ; RPC: CIAUDIC
  1. DIC(CIADATA,CIABM,CIACMD,CIAARG) ;
  1.  S CIADATA(0)=$$ENTRY^CIAUDIC(CIABM,CIACMD)
  1.  Q
  1.  ; RPC: CIAUSTX
  1. MSYNTAX(CIADATA,CIACODE,CIAOPT) ;
  1.  S CIADATA=$$ENTRY^CIAUSTX(CIACODE,.CIAOPT)
  1.  Q
  1.  ; RPC: Return a group of entries from a file
  1.  ; CIAFN   = File #
  1.  ; CIAFROM = Starting entry (default is null)
  1.  ; CIADIR  = Direction (default = 1)
  1.  ; CIASCN  = Screening logic (optional)
  1.  ; CIAMAX  = Maximum entries (default = 20)
  1.  ; CIAXRF  = Cross reference (default = B)
  1. FILGET(CIADATA,CIAFN,CIAFROM,CIADIR,CIASCN,CIAMAX,CIAXRF) ;
  1.  N CIAIEN,CIAGBL,CIATOT,Y
  1.  S CIAFROM=$G(CIAFROM),CIADIR=$S($G(CIADIR)<0:-1,1:1),CIAMAX=$G(CIAMAX,20),CIAXRF=$G(CIAXRF,"B"),CIASCN=$G(CIASCN),CIAGBL=$$ROOT^DILFD(CIAFN,,1),CIATOT=0
  1.  Q:'$L(CIAGBL)
  1.  F  Q:CIATOT'<CIAMAX  S CIAFROM=$O(@CIAGBL@(CIAXRF,CIAFROM),CIADIR),CIAIEN=0 Q:'$L(CIAFROM)  D
  1.  .F  S CIAIEN=$O(@CIAGBL@(CIAXRF,CIAFROM,CIAIEN)) Q:'CIAIEN  D
  1.  ..Q:'$D(@CIAGBL@(CIAIEN,0))
  1.  ..I $L(CIASCN) S Y=CIAIEN X CIASCN E  Q
  1.  ..S CIATOT=CIATOT+1,@CIADATA@(CIATOT)=CIAIEN_U_CIAFROM
  1.  Q
  1.  ; RPC: Show all or selected entries for a file
  1.  ; CIAGBL = File # or closed global reference
  1.  ; CIAIEN = Optional list of IENs to retrieve (default=ALL)
  1.  ;          May be passed as single IEN or array with IENs as subscripts
  1. FILENT(CIADATA,CIAGBL,CIAIEN) ;
  1.  N CIAG,CIAX
  1.  S:CIAGBL=+CIAGBL CIAGBL=$$ROOT^DILFD(CIAGBL,,1)
  1.  S CIADATA=$$TMPGBL
  1.  Q:'$L(CIAGBL)
  1.  S:$G(CIAIEN) CIAIEN(+CIAIEN)=""
  1.  S CIAG=$S($D(CIAIEN):"CIAIEN",1:CIAGBL),CIAIEN=0
  1.  F  S CIAIEN=$O(@CIAG@(CIAIEN)) Q:'CIAIEN  D
  1.  .S CIAX=$P($G(@CIAGBL@(CIAIEN,0)),U)
  1.  .S:$L(CIAX) @CIADATA@(CIAIEN)=CIAIEN_U_CIAX
  1.  Q
  1.  ; RPC: Show IEN of next/previous entry in a file
  1. FILNXT(CIADATA,CIAGBL,CIAIEN) ;
  1.  N CIAD
  1.  S:CIAGBL=+CIAGBL CIAGBL=$$ROOT^DILFD(CIAGBL,,1)
  1.  I CIAIEN<0 S CIAIEN=-CIAIEN,CIAD=-1
  1.  E  S CIAD=1
  1.  S CIADATA=+$O(@CIAGBL@(CIAIEN),CIAD)
  1.  Q
  1.  ; RPC: Convert date input to FM format
  1. STRTODAT(DATA,VAL,FMT) ;
  1.  N %DT,X,Y
  1.  I VAL'["@",VAL[" " S VAL=$TR(VAL," ","@")
  1.  I VAL["@",$TR($P(VAL,"@",2),":0")="" S $P(VAL,"@",2)="00:00:01"
  1.  S %DT=$G(FMT,"TS"),X=VAL
  1.  D ^%DT
  1.  S DATA=$S(Y>0:Y,1:"")
  1.  Q
  1.  ; Return reference to temp global
  1. TMPGBL(X) ;EP
  1.  K ^TMP("CIAURPC"_$G(X),$J) Q $NA(^($J))
  1.  ; Register/unregister RPCs within a given namespace to a context
  1. REGNMSP(NMSP,CTX,DEL) ;EP
  1.  N RPC,IEN,LEN
  1.  S LEN=$L(NMSP),CTX=+$$GETOPT(CTX)
  1.  I $G(DEL) D
  1.  .S IEN=0
  1.  .F  S IEN=$O(^DIC(19,CTX,"RPC","B",IEN)) Q:'IEN  D
  1.  ..I $E($G(^XWB(8994,IEN,0)),1,LEN)=NMSP,$$REGRPC(IEN,CTX,1)
  1.  E  D
  1.  .Q:LEN<2
  1.  .S RPC=NMSP
  1.  .F  D:$L(RPC)  S RPC=$O(^XWB(8994,"B",RPC)) Q:NMSP'=$E(RPC,1,LEN)
  1.  ..F IEN=0:0 S IEN=$O(^XWB(8994,"B",RPC,IEN)) Q:'IEN  I $$REGRPC(IEN,.CTX)
  1.  Q
  1.  ; Register/unregister an RPC to/from a context
  1.  ; RPC = IEN or name of RPC
  1.  ; CTX = IEN or name of context
  1.  ; DEL = If nonzero, the RPC is unregistered (defaults to 0)
  1.  ; Returns -1 if already registered; 0 if failed; 1 if succeeded
  1. REGRPC(RPC,CTX,DEL) ;EP
  1.  S RPC=+$$GETRPC(RPC)
  1.  Q $S(RPC<1:0,1:$$REGMULT(19.05,"RPC",RPC,.CTX,.DEL))
  1.  ; Add/remove a context to/from the ITEM multiple of another context.
  1. REGCTX(SRC,DST,DEL) ;EP
  1.  S SRC=+$$GETOPT(SRC)
  1.  Q $S('SRC:0,1:$$REGMULT(19.01,10,SRC,.DST,.DEL))
  1.  ; Add/delete an entry to/from a specified OPTION multiple.
  1.  ; SFN = Subfile #
  1.  ; NOD = Subnode for multiple
  1.  ; ITM = Item IEN to add
  1.  ; CTX = Option to add to
  1.  ; DEL = Delete flag (optional)
  1. REGMULT(SFN,NOD,ITM,CTX,DEL) ;
  1.  N FDA,IEN
  1.  S CTX=+$$GETOPT(CTX)
  1.  S DEL=+$G(DEL)
  1.  S IEN=+$O(^DIC(19,CTX,NOD,"B",ITM,0))
  1.  Q:'IEN=DEL -1
  1.  K ^TMP("DIERR",$J)
  1.  I DEL S FDA(SFN,IEN_","_CTX_",",.01)="@"
  1.  E  S FDA(SFN,"+1,"_CTX_",",.01)=ITM
  1.  D UPDATE^DIE("","FDA")
  1.  S FDA='$D(^TMP("DIERR",$J)) K ^($J)
  1.  Q FDA
  1.  ; Register a protocol to an extended action protocol
  1.  ; Input: P-Parent protocol
  1.  ;        C-Child protocol
  1. REGPROT(P,C,ERR) ;EP
  1.  N IENARY,PIEN,AIEN,FDA
  1.  D
  1.  .I '$L(P)!('$L(C)) S ERR="Missing input parameter" Q
  1.  .S IENARY(1)=$$FIND1^DIC(101,"","",P)
  1.  .S AIEN=$$FIND1^DIC(101,"","",C)
  1.  .I 'IENARY(1)!'AIEN S ERR="Unknown protocol name" Q
  1.  .S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN
  1.  .D UPDATE^DIE("S","FDA","IENARY","ERR")
  1.  Q:$Q $G(ERR)=""
  1.  Q
  1.  ; Remove nonexistent RPCs from context
  1. CLNRPC(CTX) ;EP
  1.  N IEN
  1.  S CTX=+$$GETOPT(CTX)
  1.  F IEN=0:0 S IEN=$O(^DIC(19,CTX,"RPC","B",IEN)) Q:'IEN  D:'$D(^XWB(8994,IEN)) REGRPC(IEN,CTX,1)
  1.  Q
  1.  ; Return IEN of option
  1. GETOPT(X) ;EP
  1.  N Y
  1.  Q:X=+X X
  1.  S Y=$$FIND1^DIC(19,"","X",X)
  1.  W:'Y "Cannot find option "_X,!!
  1.  Q Y
  1.  ; Return IEN of RPC
  1. GETRPC(X) ;EP
  1.  N Y
  1.  Q:X=+X X
  1.  S Y=$$FIND1^DIC(8994,"","X",X)
  1.  W:'Y "Cannot find RPC "_X,!!
  1.  Q Y