1 | DDR1 ;ALB/MJK-FileMan Delphi Components' RPCs ;4/18/97 16:15
|
---|
2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | Q
|
---|
6 | ;
|
---|
7 | DIKC(DDROK,DDR) ; -- broker callback to kill a file entry via ^DIK
|
---|
8 | N DIK,DA,FILE,IENS,FDA
|
---|
9 | S FILE=$G(DDR("FILE"))
|
---|
10 | S IENS=$G(DDR("IENS"))
|
---|
11 | I $$FNO^DILIBF(FILE)=FILE,$L(IENS,",")=2 D Q
|
---|
12 | . S DIK=$G(^DIC(FILE,0,"GL")),DA=+IENS D ^DIK S DDROK=1
|
---|
13 | S FDA(FILE,IENS,.01)="@"
|
---|
14 | D FILE^DIE("","FDA")
|
---|
15 | S DDROK='$G(DIERR)
|
---|
16 | Q
|
---|
17 | ;
|
---|
18 | LOCKC(DDROK,DDR) ; -- broker callback to lock/unlock a node
|
---|
19 | N DDRNODE
|
---|
20 | S DDRNODE=$G(DDR("NODE"))
|
---|
21 | IF DDRNODE]"" D
|
---|
22 | . IF $G(DDR("LOCKMODE")) D
|
---|
23 | . . L @("+"_DDRNODE_":"_$G(DDR("TIMEOUT"),5))
|
---|
24 | . . S DDROK=$T
|
---|
25 | . ELSE D
|
---|
26 | . . L @("-"_DDRNODE)
|
---|
27 | . . S DDROK=1
|
---|
28 | ELSE D
|
---|
29 | . S DDROK=0
|
---|
30 | Q
|
---|
31 | ;
|
---|
32 | FILENOC(DDRFLNO,DDRNAME) ; -- broker callback to get File #
|
---|
33 | ;
|
---|
34 | S DDRFLNO=+$O(^DIC("B",DDRNAME,""))
|
---|
35 | Q
|
---|
36 | ;
|
---|
37 | NODEC(DDRNODE,DDRROOT) ; -- broker callback to get global node value
|
---|
38 | ;
|
---|
39 | ;S DDRNODE=$G(@DDRROOT)
|
---|
40 | IF $D(@DDRROOT)=0!($D(@DDRROOT)=10) D
|
---|
41 | . S DDRNODE="{{"_$D(@DDRROOT)_"}}"
|
---|
42 | IF $D(@DDRROOT)=1!($D(@DDRROOT)=11) D
|
---|
43 | . S DDRNODE=$G(@DDRROOT)
|
---|
44 | Q
|
---|
45 | ;
|
---|
46 | GLCNT(DDROK,DDR) ; -- extrinsic call to invoke broker to return number of
|
---|
47 | ; global nodes found at cross reference
|
---|
48 | N DDRNODE,DDRTEAM,DDRXREF
|
---|
49 | ;
|
---|
50 | S DDRNODE=$G(DDR("ROOT"))
|
---|
51 | S DDRXREF=$G(DDR("XREF"))
|
---|
52 | S DDRVAL=$G(DDR("VALUE"))
|
---|
53 | ;
|
---|
54 | S:DDRXREF="" DDRXREF="B"
|
---|
55 | S I="",X=0
|
---|
56 | F S I=$O(@DDRNODE@(DDRXREF,DDRVAL,I)) Q:I="" D
|
---|
57 | . S X=X+1
|
---|
58 | S DDROK=$G(X)
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | IFNODE(DDRNODE,DDRROOT) ; -- extrinsic call to check if node exists.
|
---|
62 | ; passes in full node reference
|
---|
63 | N X
|
---|
64 | ;
|
---|
65 | IF $D(@DDRROOT)=0!($D(@DDRROOT)=10) D
|
---|
66 | . S DDRNODE="{{"_$D(@DDRROOT)_"}}"
|
---|
67 | IF $D(@DDRROOT)=1!($D(@DDRROOT)=11) D
|
---|
68 | . S DDRNODE=$G(@DDRROOT)
|
---|
69 | Q
|
---|