XUTMSYNC ;ISCSF/RWF - SYNC TASK MANAGMENT ;07/13/94 15:57
;;8.0;KERNEL;**163,761**;Jul 10, 1995;Build 6
;;Per VHA VA Directive 6402, this routine should not be modified
;
A ;Lookup and clear/restart a sync queue.
N DIC,DIR,XUFLAG,XUIO,XUDA,X,Y
S DIC="^%ZISL(14.8,",DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT
S XUDA=+Y,XUFLAG=$P($P(Y,"^",2),"~"),XUIO=$P($P(Y,"^",2),"~",2)
A1 ;LOOP TAG AFTER LIST TASKS
W @IOF,!,$G(^%ZISL(14.8,XUDA,0)),!,$G(^(1))
S DIR(0)="S^L:LIST TASKS;S:START NEXT;D:DELETE/CLEAR QUEUE;Q:QUIT"
S DIR("A")="Select Option" D ^DIR G:Y="Q" A
D LIST:Y="L",DELCLR:Y="D",START:Y="S"
G A:Y="D",A1
;
LIST ; List tasks related to Sync-Pair
N TASK,SEP,ENTER,CNT,TNODE
S $P(SEP,"-",IOM)="" ;Line separator for task
S CNT=0
W @IOF,!,"Task-Sync pair task list...",!
S TASK=0 F S TASK=$O(^%ZTSCH("TASK",TASK)) Q:'+TASK D
. S TNODE=$G(^%ZTSCH("TASK",TASK))
. Q:(XUIO=$P(TNODE,U,6))+(XUFLAG=$P(TNODE,U,11))'=2
. S CNT=CNT+1
. D PAGE,EN^XUTMTP(TASK)
. W !,SEP
S TASK=0 F S TASK=$O(^%ZTSCH("SYNC",XUIO,XUFLAG,TASK)) Q:'+TASK D
. S CNT=CNT+1
. D PAGE,EN^XUTMTP(TASK)
. W !,SEP
R:CNT>0 !!,"Press <ENTER> to continue: ",ENTER
W:CNT<1 !!,"No tasks to list for selected Task-Sync pair"
Q
;
START ;Start, clear and start next
N IOT,CNT,ENTER
S IOT="RES",CNT=0
W @IOF,!,"Task-Sync pair task(s) status...",!
S TASK=0 F S TASK=$O(^%ZTSCH("TASK",TASK)) Q:'+TASK D
. S TNODE=$G(^%ZTSCH("TASK",TASK))
. Q:(XUIO=$P(TNODE,U,6))+(XUFLAG=$P(TNODE,U,11))'=2
. S CNT=CNT+1
. W !,TASK_" - Currently running."
W:CNT=0 !,"No tasks running for this Task-Sync pair"
S TASK=0,TASK=$O(^%ZTSCH("SYNC",XUIO,XUFLAG,TASK))
I TASK="" W !!,"There are no waiting tasks to start." G STARTQ
W !!,TASK_" - Next sync task to be started.",!
S X=$$SYNCFLG^%ZTMS2("D",XUFLAG,XUIO)
D SCHSYNC^%ZTMS2(XUFLAG,XUIO)
STARTQ ;Start end tag
R !!,"Press <ENTER> to continue: ",ENTER
Q
;
DELCLR ; Delete Task-Sync pair and sync tasks queue
N IOT,TASK,ZTSK,X,CNT,SEP,DQLST,ENTER
S IOT="RES",CNT=0,DQLST=""
W @IOF,"Dequeuing/Unscheduling waiting task(s)..."
S (CNT,ZTSK)=0 F S ZTSK=$O(^%ZTSCH("SYNC",XUIO,XUFLAG,ZTSK)) Q:'+ZTSK D
. S CNT=CNT+1
. S DQLST=DQLST_ZTSK_" "
. D DQ^%ZTLOAD
W !!,$S(CNT>0:DQLST,1:"No waiting tasks for this Task-Sync pair")
W:CNT>0 !,CNT_" waiting task(s) found and unscheduled."
W !!,"Checking for running task(s)...",!
S (CNT,TASK)=0 F S TASK=$O(^%ZTSCH("TASK",TASK)) Q:'+TASK D
. S TNODE=$G(^%ZTSCH("TASK",TASK))
. Q:(XUIO=$P(TNODE,U,6))+(XUFLAG=$P(TNODE,U,11))'=2
. S CNT=CNT+1
. W !,TASK_" - "_$P($$ASKSTOP^%ZTLOAD(TASK),U,2)
W:CNT>0 !,CNT_" running task(s) found and requested to stop.",!,"NOTE: Further action may be required to stop the task(s)."
W:CNT=0 !,"No tasks running for this Task-Sync pair"
W !!,"Deallocating and removing Task-Sync pair..."
K ^%ZTSCH("SYNC",XUIO,XUFLAG)
S X=$$SYNCFLG^%ZTMS2("D",XUFLAG,XUIO)
W !!!,XUFLAG_" Task-Sync removed.",!
R !!,"Press <ENTER> to continue: ",ENTER
Q
;
PAGE ; Check for task list display new page needed
N ENTER
I $Y>18 D
. R !!,"Press <ENTER> to continue: ",ENTER
. W @IOF,!,"Task-Sync pair task list...",!
Q
;
EXIT ; Exit
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUTMSYNC 3229 printed Aug 26, 2025@22:29:38 Page 2
XUTMSYNC ;ISCSF/RWF - SYNC TASK MANAGMENT ;07/13/94 15:57
+1 ;;8.0;KERNEL;**163,761**;Jul 10, 1995;Build 6
+2 ;;Per VHA VA Directive 6402, this routine should not be modified
+3 ;
A ;Lookup and clear/restart a sync queue.
+1 NEW DIC,DIR,XUFLAG,XUIO,XUDA,X,Y
+2 SET DIC="^%ZISL(14.8,"
SET DIC(0)="AEMQ"
DO ^DIC
if Y'>0
GOTO EXIT
+3 SET XUDA=+Y
SET XUFLAG=$PIECE($PIECE(Y,"^",2),"~")
SET XUIO=$PIECE($PIECE(Y,"^",2),"~",2)
A1 ;LOOP TAG AFTER LIST TASKS
+1 WRITE @IOF,!,$GET(^%ZISL(14.8,XUDA,0)),!,$GET(^(1))
+2 SET DIR(0)="S^L:LIST TASKS;S:START NEXT;D:DELETE/CLEAR QUEUE;Q:QUIT"
+3 SET DIR("A")="Select Option"
DO ^DIR
if Y="Q"
GOTO A
+4 if Y="L"
DO LIST
if Y="D"
DO DELCLR
if Y="S"
DO START
+5 if Y="D"
GOTO A
GOTO A1
+6 ;
LIST ; List tasks related to Sync-Pair
+1 NEW TASK,SEP,ENTER,CNT,TNODE
+2 ;Line separator for task
SET $PIECE(SEP,"-",IOM)=""
+3 SET CNT=0
+4 WRITE @IOF,!,"Task-Sync pair task list...",!
+5 SET TASK=0
FOR
SET TASK=$ORDER(^%ZTSCH("TASK",TASK))
if '+TASK
QUIT
Begin DoDot:1
+6 SET TNODE=$GET(^%ZTSCH("TASK",TASK))
+7 if (XUIO=$PIECE(TNODE,U,6))+(XUFLAG=$PIECE(TNODE,U,11))'=2
QUIT
+8 SET CNT=CNT+1
+9 DO PAGE
DO EN^XUTMTP(TASK)
+10 WRITE !,SEP
End DoDot:1
+11 SET TASK=0
FOR
SET TASK=$ORDER(^%ZTSCH("SYNC",XUIO,XUFLAG,TASK))
if '+TASK
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 DO PAGE
DO EN^XUTMTP(TASK)
+14 WRITE !,SEP
End DoDot:1
+15 if CNT>0
READ !!,"Press <ENTER> to continue: ",ENTER
+16 if CNT<1
WRITE !!,"No tasks to list for selected Task-Sync pair"
+17 QUIT
+18 ;
START ;Start, clear and start next
+1 NEW IOT,CNT,ENTER
+2 SET IOT="RES"
SET CNT=0
+3 WRITE @IOF,!,"Task-Sync pair task(s) status...",!
+4 SET TASK=0
FOR
SET TASK=$ORDER(^%ZTSCH("TASK",TASK))
if '+TASK
QUIT
Begin DoDot:1
+5 SET TNODE=$GET(^%ZTSCH("TASK",TASK))
+6 if (XUIO=$PIECE(TNODE,U,6))+(XUFLAG=$PIECE(TNODE,U,11))'=2
QUIT
+7 SET CNT=CNT+1
+8 WRITE !,TASK_" - Currently running."
End DoDot:1
+9 if CNT=0
WRITE !,"No tasks running for this Task-Sync pair"
+10 SET TASK=0
SET TASK=$ORDER(^%ZTSCH("SYNC",XUIO,XUFLAG,TASK))
+11 IF TASK=""
WRITE !!,"There are no waiting tasks to start."
GOTO STARTQ
+12 WRITE !!,TASK_" - Next sync task to be started.",!
+13 SET X=$$SYNCFLG^%ZTMS2("D",XUFLAG,XUIO)
+14 DO SCHSYNC^%ZTMS2(XUFLAG,XUIO)
STARTQ ;Start end tag
+1 READ !!,"Press <ENTER> to continue: ",ENTER
+2 QUIT
+3 ;
DELCLR ; Delete Task-Sync pair and sync tasks queue
+1 NEW IOT,TASK,ZTSK,X,CNT,SEP,DQLST,ENTER
+2 SET IOT="RES"
SET CNT=0
SET DQLST=""
+3 WRITE @IOF,"Dequeuing/Unscheduling waiting task(s)..."
+4 SET (CNT,ZTSK)=0
FOR
SET ZTSK=$ORDER(^%ZTSCH("SYNC",XUIO,XUFLAG,ZTSK))
if '+ZTSK
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET DQLST=DQLST_ZTSK_" "
+7 DO DQ^%ZTLOAD
End DoDot:1
+8 WRITE !!,$SELECT(CNT>0:DQLST,1:"No waiting tasks for this Task-Sync pair")
+9 if CNT>0
WRITE !,CNT_" waiting task(s) found and unscheduled."
+10 WRITE !!,"Checking for running task(s)...",!
+11 SET (CNT,TASK)=0
FOR
SET TASK=$ORDER(^%ZTSCH("TASK",TASK))
if '+TASK
QUIT
Begin DoDot:1
+12 SET TNODE=$GET(^%ZTSCH("TASK",TASK))
+13 if (XUIO=$PIECE(TNODE,U,6))+(XUFLAG=$PIECE(TNODE,U,11))'=2
QUIT
+14 SET CNT=CNT+1
+15 WRITE !,TASK_" - "_$PIECE($$ASKSTOP^%ZTLOAD(TASK),U,2)
End DoDot:1
+16 if CNT>0
WRITE !,CNT_" running task(s) found and requested to stop.",!,"NOTE: Further action may be required to stop the task(s)."
+17 if CNT=0
WRITE !,"No tasks running for this Task-Sync pair"
+18 WRITE !!,"Deallocating and removing Task-Sync pair..."
+19 KILL ^%ZTSCH("SYNC",XUIO,XUFLAG)
+20 SET X=$$SYNCFLG^%ZTMS2("D",XUFLAG,XUIO)
+21 WRITE !!!,XUFLAG_" Task-Sync removed.",!
+22 READ !!,"Press <ENTER> to continue: ",ENTER
+23 QUIT
+24 ;
PAGE ; Check for task list display new page needed
+1 NEW ENTER
+2 IF $Y>18
Begin DoDot:1
+3 READ !!,"Press <ENTER> to continue: ",ENTER
+4 WRITE @IOF,!,"Task-Sync pair task list...",!
End DoDot:1
+5 QUIT
+6 ;
EXIT ; Exit
+1 QUIT
+2 ;
