- ECOB ;BP/CMF - base object ;8/21/2015
- ;;2.0;EVENT CAPTURE;**100,107,110,129**;8 May 96;Build 7
- ;@author - Chris Flegel
- ;@date - 17 May 2009
- ;@version - 1.0
- ;;
- Q
- ;; private methods
- COUNT(NAME) ; increment counter
- N COUNT
- S COUNT=+$O(@NAME@(9999999),-1)+1
- S @NAME@(COUNT,0)=$G(DT)+1
- Q COUNT
- ;;
- PARSE(METHOD,VALUE) ;
- I METHOD="Argument" D Q
- .S HANDLE=$P(VALUE,".")
- .Q
- I METHOD="Child" D Q
- .S CHILD=$P(VALUE,"Handle.",2)
- .Q
- I METHOD="Handle" D Q
- .S NAME=$P(VALUE,".",1)
- .S COUNT=$P(VALUE,".",2)
- .Q
- I METHOD="Tag" D Q
- .S TAG("routine")=$P(VALUE,"(")
- .S TAG("parameters")=$P(VALUE,TAG("routine"),2)
- .Q
- ;;
- ;; protected methods
- CREATE(NAME) ; return unique handle
- N HANDLE
- S NAME=$TR(NAME,".","") ;reserve period for piecers
- S HANDLE=$TR(NAME,")","")_","_$$COUNT(NAME)_")"
- D PROPERTY(HANDLE,"Pu","_class","EC BASE")
- D PROPERTY(HANDLE,"Pu","_routine","METHOD^DGOB(.RESULT,ARGUMENT)")
- D PROPERTY(HANDLE,"Pu","_name","Basic Pharmacy Object")
- D PROPERTY(HANDLE,"Pu","_namespace",NAME)
- D PROPERTY(HANDLE,"Pr","_parent","")
- Q HANDLE
- ;;
- COLLECT(HANDLE,CHILD,SCOPE,PROPERTY) ; attach or collect child objects
- S SCOPE=$S($G(SCOPE)'="":SCOPE,1:"Pu")
- S PROPERTY=$S($G(PROPERTY)'="":PROPERTY,1:"-1")
- S @HANDLE@(SCOPE,PROPERTY)=CHILD
- S @HANDLE@("Pr","Handle",CHILD)=PROPERTY
- Q 1
- ;;
- DESTROY(HANDLE) ; cleanup
- N CHILD
- S CHILD=0
- I ($G(HANDLE)="") Q 1 ;EC*129
- I ($P(HANDLE,"^")=0)!($P(HANDLE,"^")=-1) Q 1 ;EC*129
- F S CHILD=$O(@HANDLE@("Pr","Handle",CHILD)) Q:'CHILD D
- .K @CHILD
- .Q
- K @HANDLE
- Q 1
- ;;
- FUNCTION(HANDLE,ARGUMENT) ;
- N RESULT
- D METHOD(.RESULT,HANDLE_"."_ARGUMENT)
- Q RESULT
- ;;
- GET(RESULT,HANDLE,SCOPE,PROPERTY) ; get simple property
- I $G(HANDLE)="" S RESULT="-1^Handle does not exist." Q ;EC*110 - BGP
- I ($P(HANDLE,"^")=0)!($P(HANDLE,"^")=-1) S RESULT="-1^Handle does not exist." Q ;EC*129 - JAM
- I ($P(HANDLE,"^",2)="") S RESULT="-1^Invalid handle." Q ;EC*129
- I '$D(@HANDLE) S RESULT="-1^No data at handle: "_HANDLE_"." Q ;EC*110
- S SCOPE=$S($G(SCOPE)'="":SCOPE,1:"Pu")
- S PROPERTY=$S($G(PROPERTY)'="":PROPERTY,1:"-1")
- S RESULT=$G(@HANDLE@(SCOPE,PROPERTY))
- S:$D(RESULT)=0 RESULT="-1^Property "_PROPERTY_" does not exist."
- Q
- ;;
- ISHANDLE(HANDLE,CHILD) ;
- S HANDLE=$S($G(HANDLE)'="":HANDLE,1:-1)
- S CHILD=$S($G(CHILD)'="":CHILD,1:-1)
- Q $D(@HANDLE@("Pr","Handle",CHILD))
- ;;
- METHOD(RESULT,ARGUMENT) ; most basic handler
- N HANDLE,TAG
- S RESULT=-1
- D PARSE("Argument",ARGUMENT)
- D GET(.TAG,HANDLE,"Pu","_routine")
- D PARSE("Tag",TAG)
- Q:TAG("routine")="METHOD^DGOB" ;stop recursive call
- Q:TAG("routine")=""
- Q:($P(TAG("routine"),"^")=0)!($P(TAG("routine"),"^")=-1) ;EC*129
- I $T(@TAG("routine"))'="" D Q
- .I TAG("parameters")="(.RESULT,ARGUMENT)" D @TAG
- Q
- ;;
- MOVE(RESULT,HANDLE,SOURCE,SCOPE,PROPERTY) ;copy simple object property to another
- N X
- D GET(.X,SOURCE,SCOPE,PROPERTY)
- D SET(.RESULT,HANDLE,SCOPE,PROPERTY,X)
- Q
- ;;
- PROPERTY(HANDLE,SCOPE,PROPERTY,VALUE) ; create simple property node
- S HANDLE=$S($G(HANDLE)'="":HANDLE,1:-1)
- S SCOPE=$S($G(SCOPE)'="":SCOPE,1:"Pu")
- S PROPERTY=$S($G(PROPERTY)'="":PROPERTY,1:-1)
- S @HANDLE@(SCOPE,PROPERTY)=$G(VALUE)
- Q 1
- ;;
- SELF(RESULT,HANDLE,CLASS,NAME,ROUTINE,PARENT) ; set 'self' properties of object
- N RESULT
- D:CLASS'="" SET(.RESULT,HANDLE,"Pu","_class",CLASS)
- D:NAME'="" SET(.RESULT,HANDLE,"Pu","_name",NAME)
- D:ROUTINE'="" SET(.RESULT,HANDLE,"Pu","_routine",ROUTINE)
- D:PARENT'="" SET(.RESULT,HANDLE,"Pr","_parent",PARENT)
- Q
- ;;
- SET(RESULT,HANDLE,SCOPE,PROPERTY,VALUE) ; set simple property
- I $G(HANDLE)="" S RESULT="-1^Handle does not exist" Q ;EC*110
- I ($P(HANDLE,"^")=0)!($P(HANDLE,"^")=-1) S RESULT="-1^Handle does not exist." Q ;EC*129
- I '$D(@HANDLE) S RESULT="-1^No data at handle: "_HANDLE_"." Q ;EC*110
- S SCOPE=$S($G(SCOPE)'="":SCOPE,1:"Pu")
- S PROPERTY=$S($G(PROPERTY)'="":PROPERTY,1:"-1")
- I '$D(@HANDLE@(SCOPE,PROPERTY)) D Q
- .S RESULT="-1^Property "_PROPERTY_" does not exist."
- S @HANDLE@(SCOPE,PROPERTY)=VALUE
- S RESULT=1
- Q
- ;;
- SHOW(RESULT,HANDLE,SCOPE,PROPERTY,PARAMS) ; show a property
- N JUSTIFY,CHILD,CLASS
- D GET(.RESULT,HANDLE,SCOPE,PROPERTY)
- S JUSTIFY=$S(+PARAMS:+PARAMS,1:0)
- I PARAMS["/" W !,$J("</"_PROPERTY_"> ",JUSTIFY) Q
- W !,$J("<"_PROPERTY_"> : ",JUSTIFY),RESULT
- D:$$ISHANDLE(HANDLE,RESULT)
- .S CHILD=RESULT
- .D GET(.CLASS,CHILD,"Pu","_class")
- .W " [class = "_CLASS_"]"
- Q
- ;;
- TREE(CHILD,HANDLE,SCOPE,PROPERTY,JUSTIFY) Q ; no longer used
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECOB 4548 printed Jan 18, 2025@02:59:07 Page 2
- ECOB ;BP/CMF - base object ;8/21/2015
- +1 ;;2.0;EVENT CAPTURE;**100,107,110,129**;8 May 96;Build 7
- +2 ;@author - Chris Flegel
- +3 ;@date - 17 May 2009
- +4 ;@version - 1.0
- +5 ;;
- +6 QUIT
- +7 ;; private methods
- COUNT(NAME) ; increment counter
- +1 NEW COUNT
- +2 SET COUNT=+$ORDER(@NAME@(9999999),-1)+1
- +3 SET @NAME@(COUNT,0)=$GET(DT)+1
- +4 QUIT COUNT
- +5 ;;
- PARSE(METHOD,VALUE) ;
- +1 IF METHOD="Argument"
- Begin DoDot:1
- +2 SET HANDLE=$PIECE(VALUE,".")
- +3 QUIT
- End DoDot:1
- QUIT
- +4 IF METHOD="Child"
- Begin DoDot:1
- +5 SET CHILD=$PIECE(VALUE,"Handle.",2)
- +6 QUIT
- End DoDot:1
- QUIT
- +7 IF METHOD="Handle"
- Begin DoDot:1
- +8 SET NAME=$PIECE(VALUE,".",1)
- +9 SET COUNT=$PIECE(VALUE,".",2)
- +10 QUIT
- End DoDot:1
- QUIT
- +11 IF METHOD="Tag"
- Begin DoDot:1
- +12 SET TAG("routine")=$PIECE(VALUE,"(")
- +13 SET TAG("parameters")=$PIECE(VALUE,TAG("routine"),2)
- +14 QUIT
- End DoDot:1
- QUIT
- +15 ;;
- +16 ;; protected methods
- CREATE(NAME) ; return unique handle
- +1 NEW HANDLE
- +2 ;reserve period for piecers
- SET NAME=$TRANSLATE(NAME,".","")
- +3 SET HANDLE=$TRANSLATE(NAME,")","")_","_$$COUNT(NAME)_")"
- +4 DO PROPERTY(HANDLE,"Pu","_class","EC BASE")
- +5 DO PROPERTY(HANDLE,"Pu","_routine","METHOD^DGOB(.RESULT,ARGUMENT)")
- +6 DO PROPERTY(HANDLE,"Pu","_name","Basic Pharmacy Object")
- +7 DO PROPERTY(HANDLE,"Pu","_namespace",NAME)
- +8 DO PROPERTY(HANDLE,"Pr","_parent","")
- +9 QUIT HANDLE
- +10 ;;
- COLLECT(HANDLE,CHILD,SCOPE,PROPERTY) ; attach or collect child objects
- +1 SET SCOPE=$SELECT($GET(SCOPE)'="":SCOPE,1:"Pu")
- +2 SET PROPERTY=$SELECT($GET(PROPERTY)'="":PROPERTY,1:"-1")
- +3 SET @HANDLE@(SCOPE,PROPERTY)=CHILD
- +4 SET @HANDLE@("Pr","Handle",CHILD)=PROPERTY
- +5 QUIT 1
- +6 ;;
- DESTROY(HANDLE) ; cleanup
- +1 NEW CHILD
- +2 SET CHILD=0
- +3 ;EC*129
- IF ($GET(HANDLE)="")
- QUIT 1
- +4 ;EC*129
- IF ($PIECE(HANDLE,"^")=0)!($PIECE(HANDLE,"^")=-1)
- QUIT 1
- +5 FOR
- SET CHILD=$ORDER(@HANDLE@("Pr","Handle",CHILD))
- if 'CHILD
- QUIT
- Begin DoDot:1
- +6 KILL @CHILD
- +7 QUIT
- End DoDot:1
- +8 KILL @HANDLE
- +9 QUIT 1
- +10 ;;
- FUNCTION(HANDLE,ARGUMENT) ;
- +1 NEW RESULT
- +2 DO METHOD(.RESULT,HANDLE_"."_ARGUMENT)
- +3 QUIT RESULT
- +4 ;;
- GET(RESULT,HANDLE,SCOPE,PROPERTY) ; get simple property
- +1 ;EC*110 - BGP
- IF $GET(HANDLE)=""
- SET RESULT="-1^Handle does not exist."
- QUIT
- +2 ;EC*129 - JAM
- IF ($PIECE(HANDLE,"^")=0)!($PIECE(HANDLE,"^")=-1)
- SET RESULT="-1^Handle does not exist."
- QUIT
- +3 ;EC*129
- IF ($PIECE(HANDLE,"^",2)="")
- SET RESULT="-1^Invalid handle."
- QUIT
- +4 ;EC*110
- IF '$DATA(@HANDLE)
- SET RESULT="-1^No data at handle: "_HANDLE_"."
- QUIT
- +5 SET SCOPE=$SELECT($GET(SCOPE)'="":SCOPE,1:"Pu")
- +6 SET PROPERTY=$SELECT($GET(PROPERTY)'="":PROPERTY,1:"-1")
- +7 SET RESULT=$GET(@HANDLE@(SCOPE,PROPERTY))
- +8 if $DATA(RESULT)=0
- SET RESULT="-1^Property "_PROPERTY_" does not exist."
- +9 QUIT
- +10 ;;
- ISHANDLE(HANDLE,CHILD) ;
- +1 SET HANDLE=$SELECT($GET(HANDLE)'="":HANDLE,1:-1)
- +2 SET CHILD=$SELECT($GET(CHILD)'="":CHILD,1:-1)
- +3 QUIT $DATA(@HANDLE@("Pr","Handle",CHILD))
- +4 ;;
- METHOD(RESULT,ARGUMENT) ; most basic handler
- +1 NEW HANDLE,TAG
- +2 SET RESULT=-1
- +3 DO PARSE("Argument",ARGUMENT)
- +4 DO GET(.TAG,HANDLE,"Pu","_routine")
- +5 DO PARSE("Tag",TAG)
- +6 ;stop recursive call
- if TAG("routine")="METHOD^DGOB"
- QUIT
- +7 if TAG("routine")=""
- QUIT
- +8 ;EC*129
- if ($PIECE(TAG("routine"),"^")=0)!($PIECE(TAG("routine"),"^")=-1)
- QUIT
- +9 IF $TEXT(@TAG("routine"))'=""
- Begin DoDot:1
- +10 IF TAG("parameters")="(.RESULT,ARGUMENT)"
- DO @TAG
- End DoDot:1
- QUIT
- +11 QUIT
- +12 ;;
- MOVE(RESULT,HANDLE,SOURCE,SCOPE,PROPERTY) ;copy simple object property to another
- +1 NEW X
- +2 DO GET(.X,SOURCE,SCOPE,PROPERTY)
- +3 DO SET(.RESULT,HANDLE,SCOPE,PROPERTY,X)
- +4 QUIT
- +5 ;;
- PROPERTY(HANDLE,SCOPE,PROPERTY,VALUE) ; create simple property node
- +1 SET HANDLE=$SELECT($GET(HANDLE)'="":HANDLE,1:-1)
- +2 SET SCOPE=$SELECT($GET(SCOPE)'="":SCOPE,1:"Pu")
- +3 SET PROPERTY=$SELECT($GET(PROPERTY)'="":PROPERTY,1:-1)
- +4 SET @HANDLE@(SCOPE,PROPERTY)=$GET(VALUE)
- +5 QUIT 1
- +6 ;;
- SELF(RESULT,HANDLE,CLASS,NAME,ROUTINE,PARENT) ; set 'self' properties of object
- +1 NEW RESULT
- +2 if CLASS'=""
- DO SET(.RESULT,HANDLE,"Pu","_class",CLASS)
- +3 if NAME'=""
- DO SET(.RESULT,HANDLE,"Pu","_name",NAME)
- +4 if ROUTINE'=""
- DO SET(.RESULT,HANDLE,"Pu","_routine",ROUTINE)
- +5 if PARENT'=""
- DO SET(.RESULT,HANDLE,"Pr","_parent",PARENT)
- +6 QUIT
- +7 ;;
- SET(RESULT,HANDLE,SCOPE,PROPERTY,VALUE) ; set simple property
- +1 ;EC*110
- IF $GET(HANDLE)=""
- SET RESULT="-1^Handle does not exist"
- QUIT
- +2 ;EC*129
- IF ($PIECE(HANDLE,"^")=0)!($PIECE(HANDLE,"^")=-1)
- SET RESULT="-1^Handle does not exist."
- QUIT
- +3 ;EC*110
- IF '$DATA(@HANDLE)
- SET RESULT="-1^No data at handle: "_HANDLE_"."
- QUIT
- +4 SET SCOPE=$SELECT($GET(SCOPE)'="":SCOPE,1:"Pu")
- +5 SET PROPERTY=$SELECT($GET(PROPERTY)'="":PROPERTY,1:"-1")
- +6 IF '$DATA(@HANDLE@(SCOPE,PROPERTY))
- Begin DoDot:1
- +7 SET RESULT="-1^Property "_PROPERTY_" does not exist."
- End DoDot:1
- QUIT
- +8 SET @HANDLE@(SCOPE,PROPERTY)=VALUE
- +9 SET RESULT=1
- +10 QUIT
- +11 ;;
- SHOW(RESULT,HANDLE,SCOPE,PROPERTY,PARAMS) ; show a property
- +1 NEW JUSTIFY,CHILD,CLASS
- +2 DO GET(.RESULT,HANDLE,SCOPE,PROPERTY)
- +3 SET JUSTIFY=$SELECT(+PARAMS:+PARAMS,1:0)
- +4 IF PARAMS["/"
- WRITE !,$JUSTIFY("</"_PROPERTY_"> ",JUSTIFY)
- QUIT
- +5 WRITE !,$JUSTIFY("<"_PROPERTY_"> : ",JUSTIFY),RESULT
- +6 if $$ISHANDLE(HANDLE,RESULT)
- Begin DoDot:1
- +7 SET CHILD=RESULT
- +8 DO GET(.CLASS,CHILD,"Pu","_class")
- +9 WRITE " [class = "_CLASS_"]"
- End DoDot:1
- +10 QUIT
- +11 ;;
- TREE(CHILD,HANDLE,SCOPE,PROPERTY,JUSTIFY) ; no longer used
- QUIT