ECOBL ;BP/CMF - List object
;;2.0;EVENT CAPTURE;**100**;8 May 96;Build 21
;@author - Chris Flegel
;@date - 17 May 2009
;@version - 1.0
;;
Q
;;private methods
ADD(RESULT,HANDLE,VALUE) ; add simple list item
N ITEM,X
D PARSE("Handle",HANDLE)
D GET(.ITEM,HANDLE,"Pu","Count")
S ITEM=ITEM+1
S @HANDLE@("Pr","list",ITEM)=VALUE
D METHOD(.X,HANDLE_".Criteria.SetLastItem."_ITEM)
D METHOD(.X,HANDLE_".Criteria.SetLastValue."_VALUE)
D SET(.X,HANDLE,"Pu","Count",ITEM)
D METHOD(.X,HANDLE_".Criteria.Index."_ITEM)
S RESULT=ITEM
Q
;;
CLEAR(RESULT,HANDLE,PARAMS) ; restore to default state
D METHOD(.RESULT,HANDLE_".Criteria.Clear")
K @HANDLE@("Pr","list")
D SET(.RESULT,HANDLE,"Pu","Count",0)
Q
;;
COLLECT(RESULT,HANDLE,CHILD) ; add a child object to the list
N ITEM
D PARSE("Handle",HANDLE)
D ADD(.ITEM,HANDLE,CHILD)
S @HANDLE@("Pr","list","Handle",CHILD)=ITEM
S RESULT=ITEM
Q
;;
FIRST(RESULT,HANDLE,PARAMS) ;
D METHOD(.RESULT,HANDLE_".Criteria.First")
Q
;;
FIND(RESULT,HANDLE,PARAMS) ;
D METHOD(.RESULT,HANDLE_".Criteria.Find."_PARAMS)
Q
;;
FIND1(RESULT,HANDLE,PARAMS) ;
D METHOD(.RESULT,HANDLE_".Criteria.Find1."_PARAMS)
Q
;;
;;
GET(RESULT,HANDLE,SCOPE,PROPERTY) ;
; if unique get methods, call them first, else call parent
D GET^ECOB(.RESULT,HANDLE,SCOPE,PROPERTY)
Q
;;
GETITEM(RESULT,HANDLE,ITEM) ; get simple list item
N NAME,COUNT
D PARSE("Handle",HANDLE)
S RESULT=$G(@HANDLE@("Pr","list",ITEM))
Q
;;
INFO(RESULT,HANDLE,PARAMS) ;
N NAME,COUNT,ITEMS,I,OUT,JUSTIFY,OFFSET
D PARSE("Offset",PARAMS)
D METHOD(.ITEMS,HANDLE_".ShowCount."_JUSTIFY)
D METHOD(.OUT,HANDLE_".First")
F Q:+OUT=-1 D
.W !,$J(OUT,OFFSET)
.D METHOD(.OUT,HANDLE_".Next")
.Q
Q
;;
ISHANDLE(HANDLE,VALUE) ; is value a collected handle
Q:(HANDLE="")!(VALUE="") 0
Q $D(@HANDLE@("Pr","list","Handle",VALUE))
;
LAST(RESULT,HANDLE,PARAMS) ; get the last referenced item from the list
D METHOD(.RESULT,HANDLE_".Criteria.Last")
Q
;;
NEXT(RESULT,HANDLE,PARAMS) ; get the next item from the list
D METHOD(.RESULT,HANDLE_".Criteria.Next")
Q
;;
SET(RESULT,HANDLE,SCOPE,PROPERTY,VALUE) ;
; if unique set methods, call them first, else call parent
D SET^ECOB(.RESULT,HANDLE,SCOPE,PROPERTY,VALUE)
Q
;;
SETITEM(RESULT,HANDLE,ITEM,VALUE) ; set simple list item
N NAME,COUNT,X
D PARSE("Handle",HANDLE)
I '$D(@HANDLE@("Pr","list",ITEM)) D Q
.S RESULT="-1^Item "_ITEM_" does not exist"
S @HANDLE@("Pr","list",ITEM)=VALUE
D SET(.RESULT,HANDLE,"Pr","last",ITEM)
D METHOD(.X,HANDLE_".Criteria.Index."_ITEM)
Q
;;
SHOW(RESULT,HANDLE,SCOPE,PROPERTY,JUSTIFY) ; parent method
D SHOW^ECOB(.RESULT,HANDLE,SCOPE,PROPERTY,JUSTIFY)
Q
;;
PARSE(PARSE,VALUE) ;
I PARSE="Child" D Q
.S CHILD=$P(VALUE,"Handle.",2)
.Q
I PARSE="Count" D Q
.S COUNT=$P(VALUE,".",2)
.Q
I PARSE="Get" D Q
.S PROPERTY=$P(VALUE,".",3)
.S PROPERTY=$P(VALUE,"Get",2)
.Q
I PARSE="Handle" D Q
.S HANDLE=$P(VALUE,".")
.Q
I PARSE="Justify" D Q
.S JUSTIFY=$S(+VALUE:+VALUE,1:0)
.Q
I PARSE="Method" D Q
.S METHOD=$P(VALUE,".",2)
.Q
I PARSE="Offset" D Q
.S JUSTIFY=$S(+VALUE:+VALUE,1:0)
.S OFFSET=JUSTIFY+5
.Q
I PARSE="Params" D Q
.S PARAMS=$P(VALUE,".",3,99)
.Q
I PARSE="Set" D Q
.S PROPERTY=$P(VALUE,".",3)
.S PROPERTY=$P(PROPERTY,"Set",2)
.Q
I PARSE="SetItem" D Q
.S SETITEM=+$P(VALUE,".")
.S SETVALUE=$P(VALUE,".",2)
.Q
I PARSE="SetValue" D Q
.S SETVALUE=$P(VALUE,".",4)
.Q
Q
;;
PROPERTY(HANDLE,SCOPE,PROPERTY,VALUE) ; parent method
D PROPERTY^ECOB(HANDLE,SCOPE,PROPERTY,VALUE)
Q
;;
ECOBC(RESULT,HANDLE,PROPERTY,ARGUMENT) ; handler for Criteria
N CHILD
D GET(.CHILD,HANDLE,"Pr",PROPERTY)
D METHOD^ECOBC(.RESULT,CHILD_"."_ARGUMENT)
Q
;;
;; public methods
CREATE(NAME) ;
; call parent first
N HANDLE,CHILD,COUNT,X
S HANDLE=$$CREATE^ECOB(NAME)
D PROPERTY(HANDLE,"Pu","Count",0)
D PROPERTY(HANDLE,"Pr","list",0)
D PROPERTY(HANDLE,"Pr","last","")
D SELF^ECOB(.X,HANDLE,"EC LIST","Basic list","METHOD^ECOBL(.RESULT,ARGUMENT)","ECOB2")
; complex properties last
S CHILD=$$CREATE^ECOBC(NAME)
D COLLECT^ECOB(HANDLE,CHILD,"Pr","Criteria")
D SET^ECOB(.X,CHILD,"Pr","_collector",HANDLE)
;
Q HANDLE
;;
DESTROY(HANDLE) ;
; call parent last
N CHILD
D GET(.CHILD,HANDLE,"Pr","Criteria")
D DESTROY^ECOBC(CHILD)
Q $$DESTROY^ECOB2(HANDLE)
;;
METHOD(RESULT,ARGUMENT) ;
; argument= handle.method.(additional.params...)
N HANDLE,METHOD,PARAMS
D PARSE("Handle",ARGUMENT)
D PARSE("Method",ARGUMENT)
D PARSE("Params",ARGUMENT)
I METHOD="Add" D ADD(.RESULT,HANDLE,PARAMS) Q
I METHOD="Clear" D CLEAR(.RESULT,HANDLE,PARAMS) Q
I METHOD="Criteria" D ECOBC(.RESULT,HANDLE,METHOD,PARAMS) Q
I METHOD="Collect" D COLLECT(.RESULT,HANDLE,PARAMS) Q
I METHOD="Find" D FIND(.RESULT,HANDLE,PARAMS) Q
I METHOD="Find1" D FIND1(.RESULT,HANDLE,PARAMS) Q
I METHOD="First" D FIRST(.RESULT,HANDLE,PARAMS) Q
I METHOD="GetItem" D GETITEM(.RESULT,HANDLE,PARAMS) Q
I METHOD="Info" D INFO(.RESULT,HANDLE,PARAMS) Q
I METHOD="IsHandle" S RESULT=$$ISHANDLE(HANDLE,PARAMS) Q
I METHOD="Last" D LAST(.RESULT,HANDLE,PARAMS) Q
I METHOD="Next" D NEXT(.RESULT,HANDLE,PARAMS) Q
; development methods last
I METHOD="SetItem" D Q
.N SETITEM,SETVALUE
.D PARSE("SetItem",PARAMS)
.D SETITEM(.RESULT,HANDLE,SETITEM,SETVALUE)
.Q
D METHOD^ECOB2(.RESULT,ARGUMENT)
Q
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECOBL 5503 printed Apr 09, 2024@21:03:46 Page 2
ECOBL ;BP/CMF - List object
+1 ;;2.0;EVENT CAPTURE;**100**;8 May 96;Build 21
+2 ;@author - Chris Flegel
+3 ;@date - 17 May 2009
+4 ;@version - 1.0
+5 ;;
+6 QUIT
+7 ;;private methods
ADD(RESULT,HANDLE,VALUE) ; add simple list item
+1 NEW ITEM,X
+2 DO PARSE("Handle",HANDLE)
+3 DO GET(.ITEM,HANDLE,"Pu","Count")
+4 SET ITEM=ITEM+1
+5 SET @HANDLE@("Pr","list",ITEM)=VALUE
+6 DO METHOD(.X,HANDLE_".Criteria.SetLastItem."_ITEM)
+7 DO METHOD(.X,HANDLE_".Criteria.SetLastValue."_VALUE)
+8 DO SET(.X,HANDLE,"Pu","Count",ITEM)
+9 DO METHOD(.X,HANDLE_".Criteria.Index."_ITEM)
+10 SET RESULT=ITEM
+11 QUIT
+12 ;;
CLEAR(RESULT,HANDLE,PARAMS) ; restore to default state
+1 DO METHOD(.RESULT,HANDLE_".Criteria.Clear")
+2 KILL @HANDLE@("Pr","list")
+3 DO SET(.RESULT,HANDLE,"Pu","Count",0)
+4 QUIT
+5 ;;
COLLECT(RESULT,HANDLE,CHILD) ; add a child object to the list
+1 NEW ITEM
+2 DO PARSE("Handle",HANDLE)
+3 DO ADD(.ITEM,HANDLE,CHILD)
+4 SET @HANDLE@("Pr","list","Handle",CHILD)=ITEM
+5 SET RESULT=ITEM
+6 QUIT
+7 ;;
FIRST(RESULT,HANDLE,PARAMS) ;
+1 DO METHOD(.RESULT,HANDLE_".Criteria.First")
+2 QUIT
+3 ;;
FIND(RESULT,HANDLE,PARAMS) ;
+1 DO METHOD(.RESULT,HANDLE_".Criteria.Find."_PARAMS)
+2 QUIT
+3 ;;
FIND1(RESULT,HANDLE,PARAMS) ;
+1 DO METHOD(.RESULT,HANDLE_".Criteria.Find1."_PARAMS)
+2 QUIT
+3 ;;
+4 ;;
GET(RESULT,HANDLE,SCOPE,PROPERTY) ;
+1 ; if unique get methods, call them first, else call parent
+2 DO GET^ECOB(.RESULT,HANDLE,SCOPE,PROPERTY)
+3 QUIT
+4 ;;
GETITEM(RESULT,HANDLE,ITEM) ; get simple list item
+1 NEW NAME,COUNT
+2 DO PARSE("Handle",HANDLE)
+3 SET RESULT=$GET(@HANDLE@("Pr","list",ITEM))
+4 QUIT
+5 ;;
INFO(RESULT,HANDLE,PARAMS) ;
+1 NEW NAME,COUNT,ITEMS,I,OUT,JUSTIFY,OFFSET
+2 DO PARSE("Offset",PARAMS)
+3 DO METHOD(.ITEMS,HANDLE_".ShowCount."_JUSTIFY)
+4 DO METHOD(.OUT,HANDLE_".First")
+5 FOR
if +OUT=-1
QUIT
Begin DoDot:1
+6 WRITE !,$JUSTIFY(OUT,OFFSET)
+7 DO METHOD(.OUT,HANDLE_".Next")
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;;
ISHANDLE(HANDLE,VALUE) ; is value a collected handle
+1 if (HANDLE="")!(VALUE="")
QUIT 0
+2 QUIT $DATA(@HANDLE@("Pr","list","Handle",VALUE))
+3 ;
LAST(RESULT,HANDLE,PARAMS) ; get the last referenced item from the list
+1 DO METHOD(.RESULT,HANDLE_".Criteria.Last")
+2 QUIT
+3 ;;
NEXT(RESULT,HANDLE,PARAMS) ; get the next item from the list
+1 DO METHOD(.RESULT,HANDLE_".Criteria.Next")
+2 QUIT
+3 ;;
SET(RESULT,HANDLE,SCOPE,PROPERTY,VALUE) ;
+1 ; if unique set methods, call them first, else call parent
+2 DO SET^ECOB(.RESULT,HANDLE,SCOPE,PROPERTY,VALUE)
+3 QUIT
+4 ;;
SETITEM(RESULT,HANDLE,ITEM,VALUE) ; set simple list item
+1 NEW NAME,COUNT,X
+2 DO PARSE("Handle",HANDLE)
+3 IF '$DATA(@HANDLE@("Pr","list",ITEM))
Begin DoDot:1
+4 SET RESULT="-1^Item "_ITEM_" does not exist"
End DoDot:1
QUIT
+5 SET @HANDLE@("Pr","list",ITEM)=VALUE
+6 DO SET(.RESULT,HANDLE,"Pr","last",ITEM)
+7 DO METHOD(.X,HANDLE_".Criteria.Index."_ITEM)
+8 QUIT
+9 ;;
SHOW(RESULT,HANDLE,SCOPE,PROPERTY,JUSTIFY) ; parent method
+1 DO SHOW^ECOB(.RESULT,HANDLE,SCOPE,PROPERTY,JUSTIFY)
+2 QUIT
+3 ;;
PARSE(PARSE,VALUE) ;
+1 IF PARSE="Child"
Begin DoDot:1
+2 SET CHILD=$PIECE(VALUE,"Handle.",2)
+3 QUIT
End DoDot:1
QUIT
+4 IF PARSE="Count"
Begin DoDot:1
+5 SET COUNT=$PIECE(VALUE,".",2)
+6 QUIT
End DoDot:1
QUIT
+7 IF PARSE="Get"
Begin DoDot:1
+8 SET PROPERTY=$PIECE(VALUE,".",3)
+9 SET PROPERTY=$PIECE(VALUE,"Get",2)
+10 QUIT
End DoDot:1
QUIT
+11 IF PARSE="Handle"
Begin DoDot:1
+12 SET HANDLE=$PIECE(VALUE,".")
+13 QUIT
End DoDot:1
QUIT
+14 IF PARSE="Justify"
Begin DoDot:1
+15 SET JUSTIFY=$SELECT(+VALUE:+VALUE,1:0)
+16 QUIT
End DoDot:1
QUIT
+17 IF PARSE="Method"
Begin DoDot:1
+18 SET METHOD=$PIECE(VALUE,".",2)
+19 QUIT
End DoDot:1
QUIT
+20 IF PARSE="Offset"
Begin DoDot:1
+21 SET JUSTIFY=$SELECT(+VALUE:+VALUE,1:0)
+22 SET OFFSET=JUSTIFY+5
+23 QUIT
End DoDot:1
QUIT
+24 IF PARSE="Params"
Begin DoDot:1
+25 SET PARAMS=$PIECE(VALUE,".",3,99)
+26 QUIT
End DoDot:1
QUIT
+27 IF PARSE="Set"
Begin DoDot:1
+28 SET PROPERTY=$PIECE(VALUE,".",3)
+29 SET PROPERTY=$PIECE(PROPERTY,"Set",2)
+30 QUIT
End DoDot:1
QUIT
+31 IF PARSE="SetItem"
Begin DoDot:1
+32 SET SETITEM=+$PIECE(VALUE,".")
+33 SET SETVALUE=$PIECE(VALUE,".",2)
+34 QUIT
End DoDot:1
QUIT
+35 IF PARSE="SetValue"
Begin DoDot:1
+36 SET SETVALUE=$PIECE(VALUE,".",4)
+37 QUIT
End DoDot:1
QUIT
+38 QUIT
+39 ;;
PROPERTY(HANDLE,SCOPE,PROPERTY,VALUE) ; parent method
+1 DO PROPERTY^ECOB(HANDLE,SCOPE,PROPERTY,VALUE)
+2 QUIT
+3 ;;
ECOBC(RESULT,HANDLE,PROPERTY,ARGUMENT) ; handler for Criteria
+1 NEW CHILD
+2 DO GET(.CHILD,HANDLE,"Pr",PROPERTY)
+3 DO METHOD^ECOBC(.RESULT,CHILD_"."_ARGUMENT)
+4 QUIT
+5 ;;
+6 ;; public methods
CREATE(NAME) ;
+1 ; call parent first
+2 NEW HANDLE,CHILD,COUNT,X
+3 SET HANDLE=$$CREATE^ECOB(NAME)
+4 DO PROPERTY(HANDLE,"Pu","Count",0)
+5 DO PROPERTY(HANDLE,"Pr","list",0)
+6 DO PROPERTY(HANDLE,"Pr","last","")
+7 DO SELF^ECOB(.X,HANDLE,"EC LIST","Basic list","METHOD^ECOBL(.RESULT,ARGUMENT)","ECOB2")
+8 ; complex properties last
+9 SET CHILD=$$CREATE^ECOBC(NAME)
+10 DO COLLECT^ECOB(HANDLE,CHILD,"Pr","Criteria")
+11 DO SET^ECOB(.X,CHILD,"Pr","_collector",HANDLE)
+12 ;
+13 QUIT HANDLE
+14 ;;
DESTROY(HANDLE) ;
+1 ; call parent last
+2 NEW CHILD
+3 DO GET(.CHILD,HANDLE,"Pr","Criteria")
+4 DO DESTROY^ECOBC(CHILD)
+5 QUIT $$DESTROY^ECOB2(HANDLE)
+6 ;;
METHOD(RESULT,ARGUMENT) ;
+1 ; argument= handle.method.(additional.params...)
+2 NEW HANDLE,METHOD,PARAMS
+3 DO PARSE("Handle",ARGUMENT)
+4 DO PARSE("Method",ARGUMENT)
+5 DO PARSE("Params",ARGUMENT)
+6 IF METHOD="Add"
DO ADD(.RESULT,HANDLE,PARAMS)
QUIT
+7 IF METHOD="Clear"
DO CLEAR(.RESULT,HANDLE,PARAMS)
QUIT
+8 IF METHOD="Criteria"
DO ECOBC(.RESULT,HANDLE,METHOD,PARAMS)
QUIT
+9 IF METHOD="Collect"
DO COLLECT(.RESULT,HANDLE,PARAMS)
QUIT
+10 IF METHOD="Find"
DO FIND(.RESULT,HANDLE,PARAMS)
QUIT
+11 IF METHOD="Find1"
DO FIND1(.RESULT,HANDLE,PARAMS)
QUIT
+12 IF METHOD="First"
DO FIRST(.RESULT,HANDLE,PARAMS)
QUIT
+13 IF METHOD="GetItem"
DO GETITEM(.RESULT,HANDLE,PARAMS)
QUIT
+14 IF METHOD="Info"
DO INFO(.RESULT,HANDLE,PARAMS)
QUIT
+15 IF METHOD="IsHandle"
SET RESULT=$$ISHANDLE(HANDLE,PARAMS)
QUIT
+16 IF METHOD="Last"
DO LAST(.RESULT,HANDLE,PARAMS)
QUIT
+17 IF METHOD="Next"
DO NEXT(.RESULT,HANDLE,PARAMS)
QUIT
+18 ; development methods last
+19 IF METHOD="SetItem"
Begin DoDot:1
+20 NEW SETITEM,SETVALUE
+21 DO PARSE("SetItem",PARAMS)
+22 DO SETITEM(.RESULT,HANDLE,SETITEM,SETVALUE)
+23 QUIT
End DoDot:1
QUIT
+24 DO METHOD^ECOB2(.RESULT,ARGUMENT)
+25 QUIT
+26 ;;
