DDR1.m

DDR1 ;ALB/MJK-FileMan Delphi Components' RPCs ;4/18/97  16:15

 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 ;;Per VA Directive 6402, this routine should not be modified.

 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 ;;Licensed under the terms of the Apache License, Version 2.0.

 ;

 Q

 ;

DIKC(DDROK,DDR) ; -- broker callback to kill a file entry via ^DIK

 N DIK,DA,FILE,IENS,FDA

 S FILE=$G(DDR("FILE"))

 S IENS=$G(DDR("IENS"))

 I $$FNO^DILIBF(FILE)=FILE,$L(IENS,",")=2 D  Q

 . S DIK=$G(^DIC(FILE,0,"GL")),DA=+IENS D ^DIK S DDROK=1

 S FDA(FILE,IENS,.01)="@"

 D FILE^DIE("","FDA")

 S DDROK='$G(DIERR)

 Q

 ;

LOCKC(DDROK,DDR) ; -- broker callback to lock/unlock a node

 N DDRNODE

 S DDRNODE=$G(DDR("NODE"))

 IF DDRNODE]"" D

 . IF $G(DDR("LOCKMODE")) D

 . . L @("+"_DDRNODE_":"_$G(DDR("TIMEOUT"),5))

 . . S DDROK=$T

 . ELSE  D

 . . L @("-"_DDRNODE)

 . . S DDROK=1

 ELSE  D

 . S DDROK=0

 Q

 ;

FILENOC(DDRFLNO,DDRNAME) ; -- broker callback to get File #

 ;

 S DDRFLNO=+$O(^DIC("B",DDRNAME,""))

 Q

 ;

NODEC(DDRNODE,DDRROOT) ; -- broker callback to get global node value

 ;

 ;S DDRNODE=$G(@DDRROOT)

 IF $D(@DDRROOT)=0!($D(@DDRROOT)=10) D

 . S DDRNODE="{{"_$D(@DDRROOT)_"}}"

 IF $D(@DDRROOT)=1!($D(@DDRROOT)=11) D

 . S DDRNODE=$G(@DDRROOT)

 Q

 ;

GLCNT(DDROK,DDR) ; -- extrinsic call to invoke broker to return number of

 ;       global nodes found at cross reference

 N DDRNODE,DDRTEAM,DDRXREF

 ;

 S DDRNODE=$G(DDR("ROOT"))

 S DDRXREF=$G(DDR("XREF"))

 S DDRVAL=$G(DDR("VALUE"))

 ;

 S:DDRXREF="" DDRXREF="B"

 S I="",X=0

 F  S I=$O(@DDRNODE@(DDRXREF,DDRVAL,I)) Q:I=""  D

 . S X=X+1

 S DDROK=$G(X)

 Q

 ;

IFNODE(DDRNODE,DDRROOT) ; -- extrinsic call to check if node exists.

 ; passes in full node reference

 N X

 ;

 IF $D(@DDRROOT)=0!($D(@DDRROOT)=10) D

 . S DDRNODE="{{"_$D(@DDRROOT)_"}}"

 IF $D(@DDRROOT)=1!($D(@DDRROOT)=11) D

 . S DDRNODE=$G(@DDRROOT)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DDR1   2000     printed  Mar 13, 2025@21:47:38                                                                                                                                                                                                        Page 2

DDR1      ;ALB/MJK-FileMan Delphi Components' RPCs ;4/18/97  16:15

 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 +4       ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 +5       ;;Licensed under the terms of the Apache License, Version 2.0.

 +6       ;

 +7        QUIT 

 +8       ;

DIKC(DDROK,DDR) ; -- broker callback to kill a file entry via ^DIK

 +1        NEW DIK,DA,FILE,IENS,FDA

 +2        SET FILE=$GET(DDR("FILE"))

 +3        SET IENS=$GET(DDR("IENS"))

 +4        IF $$FNO^DILIBF(FILE)=FILE

               IF $LENGTH(IENS,",")=2

                   Begin DoDot:1

 +5                    SET DIK=$GET(^DIC(FILE,0,"GL"))

                       SET DA=+IENS

                       DO ^DIK

                       SET DDROK=1

                   End DoDot:1

                   QUIT 

 +6        SET FDA(FILE,IENS,.01)="@"

 +7        DO FILE^DIE("","FDA")

 +8        SET DDROK='$GET(DIERR)

 +9        QUIT 

 +10      ;

LOCKC(DDROK,DDR) ; -- broker callback to lock/unlock a node

 +1        NEW DDRNODE

 +2        SET DDRNODE=$GET(DDR("NODE"))

 +3        IF DDRNODE]""

               Begin DoDot:1

 +4                IF $GET(DDR("LOCKMODE"))

                       Begin DoDot:2

 +5                        LOCK @("+"_DDRNODE_":"_$GET(DDR("TIMEOUT"),5))

 +6                        SET DDROK=$TEST

                       End DoDot:2

 +7               IF '$TEST

                       Begin DoDot:2

 +8                        LOCK @("-"_DDRNODE)

 +9                        SET DDROK=1

                       End DoDot:2

               End DoDot:1

 +10      IF '$TEST

               Begin DoDot:1

 +11               SET DDROK=0

               End DoDot:1

 +12       QUIT 

 +13      ;

FILENOC(DDRFLNO,DDRNAME) ; -- broker callback to get File #

 +1       ;

 +2        SET DDRFLNO=+$ORDER(^DIC("B",DDRNAME,""))

 +3        QUIT 

 +4       ;

NODEC(DDRNODE,DDRROOT) ; -- broker callback to get global node value

 +1       ;

 +2       ;S DDRNODE=$G(@DDRROOT)

 +3        IF $DATA(@DDRROOT)=0!($DATA(@DDRROOT)=10)

               Begin DoDot:1

 +4                SET DDRNODE="{{"_$DATA(@DDRROOT)_"}}"

               End DoDot:1

 +5        IF $DATA(@DDRROOT)=1!($DATA(@DDRROOT)=11)

               Begin DoDot:1

 +6                SET DDRNODE=$GET(@DDRROOT)

               End DoDot:1

 +7        QUIT 

 +8       ;

GLCNT(DDROK,DDR) ; -- extrinsic call to invoke broker to return number of

 +1       ;       global nodes found at cross reference

 +2        NEW DDRNODE,DDRTEAM,DDRXREF

 +3       ;

 +4        SET DDRNODE=$GET(DDR("ROOT"))

 +5        SET DDRXREF=$GET(DDR("XREF"))

 +6        SET DDRVAL=$GET(DDR("VALUE"))

 +7       ;

 +8        if DDRXREF=""

               SET DDRXREF="B"

 +9        SET I=""

           SET X=0

 +10       FOR 

               SET I=$ORDER(@DDRNODE@(DDRXREF,DDRVAL,I))

               if I=""

                   QUIT 

               Begin DoDot:1

 +11               SET X=X+1

               End DoDot:1

 +12       SET DDROK=$GET(X)

 +13       QUIT 

 +14      ;

IFNODE(DDRNODE,DDRROOT) ; -- extrinsic call to check if node exists.

 +1       ; passes in full node reference

 +2        NEW X

 +3       ;

 +4        IF $DATA(@DDRROOT)=0!($DATA(@DDRROOT)=10)

               Begin DoDot:1

 +5                SET DDRNODE="{{"_$DATA(@DDRROOT)_"}}"

               End DoDot:1

 +6        IF $DATA(@DDRROOT)=1!($DATA(@DDRROOT)=11)

               Begin DoDot:1

 +7                SET DDRNODE=$GET(@DDRROOT)

               End DoDot:1

 +8        QUIT