SCUTBK1.m

SCUTBK1 ;ALB/MJK - Scheduling Broker Utilities ;[ 03/08/95  3:41 PM ]

 ;;5.3;Scheduling;**41,297,498,1015**;AUG 13, 1993;Build 21

 ;

 Q

 ;

DIKC(SCOK,SC) ; -- broker callback to kill a file entry

 ;

 N DIK,DA

 D CHK^SCUTBK

 ;

 ; -- array parsing

 S DIK=$G(SC("ROOT"))

 S DA=+$G(SC("IEN"))

 ;

 IF DIK]"",$D(@(DIK_DA_",0)")) D

 . D ^DIK

 . S SCOK=1

 ELSE  D

 . S SCOK=0

 Q

 ;

LOCKC(SCOK,SC) ; -- broker callback to lock/unlock a node

 ;

 N SCNODE

 D CHK^SCUTBK

 ;

 ; -- array parsing

 S SCNODE=$G(SC("NODE"))

 I SCNODE[",)" S SCOK=1 Q

 ;

 IF SCNODE]"" D

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

 . . L @("+"_SCNODE_":"_$G(SC("TIMEOUT"),5))

 . . S SCOK=$T

 . ELSE  D

 . . L @("-"_SCNODE)

 . . S SCOK=1

 ELSE  D 

 . S SCOK=0

 Q

 ;

FILENOC(SCFLNO,SCNAME) ; -- broker callback to get File #

 ;

 D CHK^SCUTBK

 S SCFLNO=+$O(^DIC("B",SCNAME,""))

 Q

 ;

NODEC(SCNODE,SCROOT) ; -- broker callback to get global node value

 ;

 D CHK^SCUTBK

 ;S SCNODE=$G(@SCROOT)

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

 . S SCNODE="{{"_$D(@SCROOT)_"}}"

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

 . S SCNODE=$G(@SCROOT)

 Q

 ;

GLCNT(SCOK,SC) ; -- extrinsic call to invoke broker to return number of

 ;       global nodes found at cross reference

 N SCNODE,SCTEAM,SCXREF,SCFRST

 D CHK^SCUTBK

 ;

 S (SCFRST,SCOK)=""

 S SCNODE=$G(SC("ROOT"))

 S SCXREF=$G(SC("XREF"))

 S SCVAL=$G(SC("VALUE"))

 ;

 S:SCXREF="" SCXREF="B"

 S I="",X=0

 F  S I=$O(@SCNODE@(SCXREF,SCVAL,I)) Q:I=""  D

 . S X=X+1

 S SCOK=$G(X)

 Q

 ;

IFNODE(SCNODE,SCROOT) ; -- extrinsic call to check if node exists.

 ; passes in full node reference.

 N X

 D CHK^SCUTBK

 ;

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

 . S SCNODE="{{"_$D(@SCROOT)_"}}"

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

 . S SCNODE=$G(@SCROOT)

 Q

 ;

PRTP(SCACTV,SC) ;

 ;

 N SCRTN,SCERRX,SCOK,SCIEN,SCKDT

 D TMP^SCUTBK

 D CHK^SCUTBK

 ;

 I $G(SC("IEN"))=0 D  G PRTPQ

 . S SCACTV=0

 S SCIEN=SC("IEN")

 ;

 S SCKDT=""

 S SCKDT("BEGIN")=$G(SC("BEGIN"),DT)

 S SCKDT("END")=$G(SC("END"),DT)

 S SCKDT("INCL")=$G(SC("INCL"),0)

 ;

 S SCOK=$$PRTP^SCAPMC8(SCIEN,"SCKDT","SCRTN","SCERRX")

 S SCACTV=$S(SCOK:$G(SCRTN(1),"0"),1:"0")

PRTPQ Q

SCUTBK1   ;ALB/MJK - Scheduling Broker Utilities ;[ 03/08/95  3:41 PM ]

 +1       ;;5.3;Scheduling;**41,297,498,1015**;AUG 13, 1993;Build 21

 +2       ;

 +3        QUIT 

 +4       ;

DIKC(SCOK,SC) ; -- broker callback to kill a file entry

 +1       ;

 +2        NEW DIK,DA

 +3        DO CHK^SCUTBK

 +4       ;

 +5       ; -- array parsing

 +6        SET DIK=$GET(SC("ROOT"))

 +7        SET DA=+$GET(SC("IEN"))

 +8       ;

 +9        IF DIK]""

               IF $DATA(@(DIK_DA_",0)"))

                   Begin DoDot:1

 +10                   DO ^DIK

 +11                   SET SCOK=1

                   End DoDot:1

 +12      IF '$TEST

               Begin DoDot:1

 +13               SET SCOK=0

               End DoDot:1

 +14       QUIT 

 +15      ;

LOCKC(SCOK,SC) ; -- broker callback to lock/unlock a node

 +1       ;

 +2        NEW SCNODE

 +3        DO CHK^SCUTBK

 +4       ;

 +5       ; -- array parsing

 +6        SET SCNODE=$GET(SC("NODE"))

 +7        IF SCNODE[",)"

               SET SCOK=1

               QUIT 

 +8       ;

 +9        IF SCNODE]""

               Begin DoDot:1

 +10               IF $GET(SC("LOCKMODE"))

                       Begin DoDot:2

 +11                       LOCK @("+"_SCNODE_":"_$GET(SC("TIMEOUT"),5))

 +12                       SET SCOK=$TEST

                       End DoDot:2

 +13              IF '$TEST

                       Begin DoDot:2

 +14                       LOCK @("-"_SCNODE)

 +15                       SET SCOK=1

                       End DoDot:2

               End DoDot:1

 +16      IF '$TEST

               Begin DoDot:1

 +17               SET SCOK=0

               End DoDot:1

 +18       QUIT 

 +19      ;

FILENOC(SCFLNO,SCNAME) ; -- broker callback to get File #

 +1       ;

 +2        DO CHK^SCUTBK

 +3        SET SCFLNO=+$ORDER(^DIC("B",SCNAME,""))

 +4        QUIT 

 +5       ;

NODEC(SCNODE,SCROOT) ; -- broker callback to get global node value

 +1       ;

 +2        DO CHK^SCUTBK

 +3       ;S SCNODE=$G(@SCROOT)

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

               Begin DoDot:1

 +5                SET SCNODE="{{"_$DATA(@SCROOT)_"}}"

               End DoDot:1

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

               Begin DoDot:1

 +7                SET SCNODE=$GET(@SCROOT)

               End DoDot:1

 +8        QUIT 

 +9       ;

GLCNT(SCOK,SC) ; -- extrinsic call to invoke broker to return number of

 +1       ;       global nodes found at cross reference

 +2        NEW SCNODE,SCTEAM,SCXREF,SCFRST

 +3        DO CHK^SCUTBK

 +4       ;

 +5        SET (SCFRST,SCOK)=""

 +6        SET SCNODE=$GET(SC("ROOT"))

 +7        SET SCXREF=$GET(SC("XREF"))

 +8        SET SCVAL=$GET(SC("VALUE"))

 +9       ;

 +10       IF SCXREF=""

               SET SCXREF="B"

 +11       SET I=""

           SET X=0

 +12       FOR 

               SET I=$ORDER(@SCNODE@(SCXREF,SCVAL,I))

               IF I=""

                   QUIT 

               Begin DoDot:1

 +13               SET X=X+1

               End DoDot:1

 +14       SET SCOK=$GET(X)

 +15       QUIT 

 +16      ;

IFNODE(SCNODE,SCROOT) ; -- extrinsic call to check if node exists.

 +1       ; passes in full node reference.

 +2        NEW X

 +3        DO CHK^SCUTBK

 +4       ;

 +5        IF $DATA(@SCROOT)=0!($DATA(@SCROOT)=10)

               Begin DoDot:1

 +6                SET SCNODE="{{"_$DATA(@SCROOT)_"}}"

               End DoDot:1

 +7        IF $DATA(@SCROOT)=1!($DATA(@SCROOT)=11)

               Begin DoDot:1

 +8                SET SCNODE=$GET(@SCROOT)

               End DoDot:1

 +9        QUIT 

 +10      ;

PRTP(SCACTV,SC) ;

 +1       ;

 +2        NEW SCRTN,SCERRX,SCOK,SCIEN,SCKDT

 +3        DO TMP^SCUTBK

 +4        DO CHK^SCUTBK

 +5       ;

 +6        IF $GET(SC("IEN"))=0

               Begin DoDot:1

 +7                SET SCACTV=0

               End DoDot:1

               GOTO PRTPQ

 +8        SET SCIEN=SC("IEN")

 +9       ;

 +10       SET SCKDT=""

 +11       SET SCKDT("BEGIN")=$GET(SC("BEGIN"),DT)

 +12       SET SCKDT("END")=$GET(SC("END"),DT)

 +13       SET SCKDT("INCL")=$GET(SC("INCL"),0)

 +14      ;

 +15       SET SCOK=$$PRTP^SCAPMC8(SCIEN,"SCKDT","SCRTN","SCERRX")

 +16       SET SCACTV=$SELECT(SCOK:$GET(SCRTN(1),"0"),1:"0")

PRTPQ      QUIT