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

ECOB.m

Go to the documentation of this file.
  1. ECOB ;BP/CMF - base object ;8/21/2015
  1. ;;2.0;EVENT CAPTURE;**100,107,110,129**;8 May 96;Build 7
  1. ;@author - Chris Flegel
  1. ;@date - 17 May 2009
  1. ;@version - 1.0
  1. ;;
  1. Q
  1. ;; private methods
  1. COUNT(NAME) ; increment counter
  1. N COUNT
  1. S COUNT=+$O(@NAME@(9999999),-1)+1
  1. S @NAME@(COUNT,0)=$G(DT)+1
  1. Q COUNT
  1. ;;
  1. PARSE(METHOD,VALUE) ;
  1. I METHOD="Argument" D Q
  1. .S HANDLE=$P(VALUE,".")
  1. .Q
  1. I METHOD="Child" D Q
  1. .S CHILD=$P(VALUE,"Handle.",2)
  1. .Q
  1. I METHOD="Handle" D Q
  1. .S NAME=$P(VALUE,".",1)
  1. .S COUNT=$P(VALUE,".",2)
  1. .Q
  1. I METHOD="Tag" D Q
  1. .S TAG("routine")=$P(VALUE,"(")
  1. .S TAG("parameters")=$P(VALUE,TAG("routine"),2)
  1. .Q
  1. ;;
  1. ;; protected methods
  1. CREATE(NAME) ; return unique handle
  1. N HANDLE
  1. S NAME=$TR(NAME,".","") ;reserve period for piecers
  1. S HANDLE=$TR(NAME,")","")_","_$$COUNT(NAME)_")"
  1. D PROPERTY(HANDLE,"Pu","_class","EC BASE")
  1. D PROPERTY(HANDLE,"Pu","_routine","METHOD^DGOB(.RESULT,ARGUMENT)")
  1. D PROPERTY(HANDLE,"Pu","_name","Basic Pharmacy Object")
  1. D PROPERTY(HANDLE,"Pu","_namespace",NAME)
  1. D PROPERTY(HANDLE,"Pr","_parent","")
  1. Q HANDLE
  1. ;;
  1. COLLECT(HANDLE,CHILD,SCOPE,PROPERTY) ; attach or collect child objects
  1. S SCOPE=$S($G(SCOPE)'="":SCOPE,1:"Pu")
  1. S PROPERTY=$S($G(PROPERTY)'="":PROPERTY,1:"-1")
  1. S @HANDLE@(SCOPE,PROPERTY)=CHILD
  1. S @HANDLE@("Pr","Handle",CHILD)=PROPERTY
  1. Q 1
  1. ;;
  1. DESTROY(HANDLE) ; cleanup
  1. N CHILD
  1. S CHILD=0
  1. I ($G(HANDLE)="") Q 1 ;EC*129
  1. I ($P(HANDLE,"^")=0)!($P(HANDLE,"^")=-1) Q 1 ;EC*129
  1. F S CHILD=$O(@HANDLE@("Pr","Handle",CHILD)) Q:'CHILD D
  1. .K @CHILD
  1. .Q
  1. K @HANDLE
  1. Q 1
  1. ;;
  1. FUNCTION(HANDLE,ARGUMENT) ;
  1. N RESULT
  1. D METHOD(.RESULT,HANDLE_"."_ARGUMENT)
  1. Q RESULT
  1. ;;
  1. GET(RESULT,HANDLE,SCOPE,PROPERTY) ; get simple property
  1. I $G(HANDLE)="" S RESULT="-1^Handle does not exist." Q ;EC*110 - BGP
  1. I ($P(HANDLE,"^")=0)!($P(HANDLE,"^")=-1) S RESULT="-1^Handle does not exist." Q ;EC*129 - JAM
  1. I ($P(HANDLE,"^",2)="") S RESULT="-1^Invalid handle." Q ;EC*129
  1. I '$D(@HANDLE) S RESULT="-1^No data at handle: "_HANDLE_"." Q ;EC*110
  1. S SCOPE=$S($G(SCOPE)'="":SCOPE,1:"Pu")
  1. S PROPERTY=$S($G(PROPERTY)'="":PROPERTY,1:"-1")
  1. S RESULT=$G(@HANDLE@(SCOPE,PROPERTY))
  1. S:$D(RESULT)=0 RESULT="-1^Property "_PROPERTY_" does not exist."
  1. Q
  1. ;;
  1. ISHANDLE(HANDLE,CHILD) ;
  1. S HANDLE=$S($G(HANDLE)'="":HANDLE,1:-1)
  1. S CHILD=$S($G(CHILD)'="":CHILD,1:-1)
  1. Q $D(@HANDLE@("Pr","Handle",CHILD))
  1. ;;
  1. METHOD(RESULT,ARGUMENT) ; most basic handler
  1. N HANDLE,TAG
  1. S RESULT=-1
  1. D PARSE("Argument",ARGUMENT)
  1. D GET(.TAG,HANDLE,"Pu","_routine")
  1. D PARSE("Tag",TAG)
  1. Q:TAG("routine")="METHOD^DGOB" ;stop recursive call
  1. Q:TAG("routine")=""
  1. Q:($P(TAG("routine"),"^")=0)!($P(TAG("routine"),"^")=-1) ;EC*129
  1. I $T(@TAG("routine"))'="" D Q
  1. .I TAG("parameters")="(.RESULT,ARGUMENT)" D @TAG
  1. Q
  1. ;;
  1. MOVE(RESULT,HANDLE,SOURCE,SCOPE,PROPERTY) ;copy simple object property to another
  1. N X
  1. D GET(.X,SOURCE,SCOPE,PROPERTY)
  1. D SET(.RESULT,HANDLE,SCOPE,PROPERTY,X)
  1. Q
  1. ;;
  1. PROPERTY(HANDLE,SCOPE,PROPERTY,VALUE) ; create simple property node
  1. S HANDLE=$S($G(HANDLE)'="":HANDLE,1:-1)
  1. S SCOPE=$S($G(SCOPE)'="":SCOPE,1:"Pu")
  1. S PROPERTY=$S($G(PROPERTY)'="":PROPERTY,1:-1)
  1. S @HANDLE@(SCOPE,PROPERTY)=$G(VALUE)
  1. Q 1
  1. ;;
  1. SELF(RESULT,HANDLE,CLASS,NAME,ROUTINE,PARENT) ; set 'self' properties of object
  1. N RESULT
  1. D:CLASS'="" SET(.RESULT,HANDLE,"Pu","_class",CLASS)
  1. D:NAME'="" SET(.RESULT,HANDLE,"Pu","_name",NAME)
  1. D:ROUTINE'="" SET(.RESULT,HANDLE,"Pu","_routine",ROUTINE)
  1. D:PARENT'="" SET(.RESULT,HANDLE,"Pr","_parent",PARENT)
  1. Q
  1. ;;
  1. SET(RESULT,HANDLE,SCOPE,PROPERTY,VALUE) ; set simple property
  1. I $G(HANDLE)="" S RESULT="-1^Handle does not exist" Q ;EC*110
  1. I ($P(HANDLE,"^")=0)!($P(HANDLE,"^")=-1) S RESULT="-1^Handle does not exist." Q ;EC*129
  1. I '$D(@HANDLE) S RESULT="-1^No data at handle: "_HANDLE_"." Q ;EC*110
  1. S SCOPE=$S($G(SCOPE)'="":SCOPE,1:"Pu")
  1. S PROPERTY=$S($G(PROPERTY)'="":PROPERTY,1:"-1")
  1. I '$D(@HANDLE@(SCOPE,PROPERTY)) D Q
  1. .S RESULT="-1^Property "_PROPERTY_" does not exist."
  1. S @HANDLE@(SCOPE,PROPERTY)=VALUE
  1. S RESULT=1
  1. Q
  1. ;;
  1. SHOW(RESULT,HANDLE,SCOPE,PROPERTY,PARAMS) ; show a property
  1. N JUSTIFY,CHILD,CLASS
  1. D GET(.RESULT,HANDLE,SCOPE,PROPERTY)
  1. S JUSTIFY=$S(+PARAMS:+PARAMS,1:0)
  1. I PARAMS["/" W !,$J("</"_PROPERTY_"> ",JUSTIFY) Q
  1. W !,$J("<"_PROPERTY_"> : ",JUSTIFY),RESULT
  1. D:$$ISHANDLE(HANDLE,RESULT)
  1. .S CHILD=RESULT
  1. .D GET(.CLASS,CHILD,"Pu","_class")
  1. .W " [class = "_CLASS_"]"
  1. Q
  1. ;;
  1. TREE(CHILD,HANDLE,SCOPE,PROPERTY,JUSTIFY) Q ; no longer used