DGA4002 ;ALB/MRL - CHECK PROGRESS OF JOB ;01 JAN 1988@2300
;;5.3;Registration;;Aug 13, 1993
;S DGE=0,IOP=$S($D(ION):ION,1:IO) D ^%ZIS K IOP S DGRUN=$S($D(^DG(43,1,"AMIS")):^("AMIS"),1:0) I DGRUN=0 W:DGWR !,"AMIS 401-420 options have never been used!",*7 G PARQ
S DGE=0 S DGRUN=$S($D(^DG(43,1,"AMIS")):^("AMIS"),1:0) I DGRUN=0 W:DGWR !,"AMIS 401-420 options have never been used!",*7 G PARQ
S DGRUN=$S($D(^DG(43,1,"AMIS")):^("AMIS"),1:0) I DGRUN=0 W:DGWR !,"AMIS 401-420 options have never been used!",*7 G PARQ
S DGTSK=$P(DGRUN,"^",3),DGU=$S($D(^VA(200,+$P(DGRUN,"^",4),0)):$P(^(0),"^",1),1:"UNKNOWN USER")
I +DGTSK>0 D QCHK G PARQ:DGE,DGA4002:'DGTSK
S X(1)=$P(DGRUN,"^",1),X(2)=$P(DGRUN,"^",2),X(3)=+$P(DGRUN,"^",5) I X(1)="",X(2)="" W:DGWR !,"AMIS 401-420 options have never been run..." G PARQ
I X(1),'X(2) G RUN
I X(1)'>X(2),'X(3) S Y=X(1) X ^DD("DD") W:DGWR !,"Option last run ",Y," and completed " S Y=X(2) X ^DD("DD") D:DGWR DONE G PARQ
;
RUN S Y=X(1) X ^DD("DD") W:DGWR !,"Option has been running since " D:DGWR DONE S DGE=1
;
PARQ K DGWR,DGTSK,DGTSK1,DGWHEN,X,X1,DGTIME,DGDATE,C,DGRUN,DGU,Y Q
QCHK S ZTSK=DGTSK D ISQED^%ZTLOAD Q:'ZTSK(0) W:DGWR !,"This report has been queued - the task number is "_ZTSK
DEL W:DGWR !,"DO YOU WANT TO STOP THIS JOB FROM RUNNING" S %=2 D YN^DICN I %=-1!(%=2) W:DGWR !,"Job remains queued" S DGE=1 Q
I '% W ?4,"YES - If you want to stop this job from starting.",!?4,"NO - If you still want this job to run.",! G DEL
S ZTSK=DGTSK D KILL^%ZTLOAD W:DGWR !,"... deleted" S $P(DGRUN,"^",3)="",DGTSK=0,DGE=1 Q
;
DAT S %H=X D YMD^%DTC S X1=$P(%H,",",2),X=X+(X1\3600/100)+(X1\60#60/10000),Y=X X ^DD("DD") K %H Q
;
DONE W Y,".",!,"Run by ",DGU," for ",$S($P(DGRUN,"^",6)]"":$P(DGRUN,"^",6),1:"UNKNOWN") Q
;
QUIT D UP^DGA4001
QUIT1 K %,%DT,C,D,D1,DA,DFN,DFN1,DG,DGA,DGA1,DGAD,DGAE,DGAE1,DGAL,DGAN,DGAP,DGBLK,DGC,DGCODFLG,DGCT,DGDATA,DGATA1,DGDATE,DGDD,DGDEV,DGDISLO,DGDIV,DGDV,DGE,DGEN,DGFL,DGFLG,DGH,DGHOME,DGI,DGI1,DGL,DGL1,DGN,DGN1,DGO,DGP,DGPGM,DGPR,DGQUIT,DGREG
K DGA,DGCODFLG,DGDEV,DGFLG,DGII,DGL,DGL1,DGLAB,DGUB,DGWIDTH,DGXI
K DGCTEOM,DGRUN,DGS,DGSEG,DGSEGR,DGTASK,DGTEXT,DGTIME,DGTSK,DGTSK1,DGU,DGUB,DGVAR,DGWHEN,DGWR,DGX,DGX1,DGX2,DGX3,DGXXXD,DGZ,DGZ1,DGZ2,DIC,DINUM,I,I1,I2,I3,I4,J,N,X,X1,X2,X3,XMDUZ,XMSUB,XMTEXT,XMY,Y,^UTILITY($J) D CLOSE^DGUTQ
D ENDREP^DGUTL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGA4002 2354 printed Nov 22, 2024@17:50:59 Page 2
DGA4002 ;ALB/MRL - CHECK PROGRESS OF JOB ;01 JAN 1988@2300
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;S DGE=0,IOP=$S($D(ION):ION,1:IO) D ^%ZIS K IOP S DGRUN=$S($D(^DG(43,1,"AMIS")):^("AMIS"),1:0) I DGRUN=0 W:DGWR !,"AMIS 401-420 options have never been used!",*7 G PARQ
+3 SET DGE=0
SET DGRUN=$SELECT($DATA(^DG(43,1,"AMIS")):^("AMIS"),1:0)
IF DGRUN=0
if DGWR
WRITE !,"AMIS 401-420 options have never been used!",*7
GOTO PARQ
+4 SET DGRUN=$SELECT($DATA(^DG(43,1,"AMIS")):^("AMIS"),1:0)
IF DGRUN=0
if DGWR
WRITE !,"AMIS 401-420 options have never been used!",*7
GOTO PARQ
+5 SET DGTSK=$PIECE(DGRUN,"^",3)
SET DGU=$SELECT($DATA(^VA(200,+$PIECE(DGRUN,"^",4),0)):$PIECE(^(0),"^",1),1:"UNKNOWN USER")
+6 IF +DGTSK>0
DO QCHK
if DGE
GOTO PARQ
if 'DGTSK
GOTO DGA4002
+7 SET X(1)=$PIECE(DGRUN,"^",1)
SET X(2)=$PIECE(DGRUN,"^",2)
SET X(3)=+$PIECE(DGRUN,"^",5)
IF X(1)=""
IF X(2)=""
if DGWR
WRITE !,"AMIS 401-420 options have never been run..."
GOTO PARQ
+8 IF X(1)
IF 'X(2)
GOTO RUN
+9 IF X(1)'>X(2)
IF 'X(3)
SET Y=X(1)
XECUTE ^DD("DD")
if DGWR
WRITE !,"Option last run ",Y," and completed "
SET Y=X(2)
XECUTE ^DD("DD")
if DGWR
DO DONE
GOTO PARQ
+10 ;
RUN SET Y=X(1)
XECUTE ^DD("DD")
if DGWR
WRITE !,"Option has been running since "
if DGWR
DO DONE
SET DGE=1
+1 ;
PARQ KILL DGWR,DGTSK,DGTSK1,DGWHEN,X,X1,DGTIME,DGDATE,C,DGRUN,DGU,Y
QUIT
QCHK SET ZTSK=DGTSK
DO ISQED^%ZTLOAD
if 'ZTSK(0)
QUIT
if DGWR
WRITE !,"This report has been queued - the task number is "_ZTSK
DEL if DGWR
WRITE !,"DO YOU WANT TO STOP THIS JOB FROM RUNNING"
SET %=2
DO YN^DICN
IF %=-1!(%=2)
if DGWR
WRITE !,"Job remains queued"
SET DGE=1
QUIT
+1 IF '%
WRITE ?4,"YES - If you want to stop this job from starting.",!?4,"NO - If you still want this job to run.",!
GOTO DEL
+2 SET ZTSK=DGTSK
DO KILL^%ZTLOAD
if DGWR
WRITE !,"... deleted"
SET $PIECE(DGRUN,"^",3)=""
SET DGTSK=0
SET DGE=1
QUIT
+3 ;
DAT SET %H=X
DO YMD^%DTC
SET X1=$PIECE(%H,",",2)
SET X=X+(X1\3600/100)+(X1\60#60/10000)
SET Y=X
XECUTE ^DD("DD")
KILL %H
QUIT
+1 ;
DONE WRITE Y,".",!,"Run by ",DGU," for ",$SELECT($PIECE(DGRUN,"^",6)]"":$PIECE(DGRUN,"^",6),1:"UNKNOWN")
QUIT
+1 ;
QUIT DO UP^DGA4001
QUIT1 KILL %,%DT,C,D,D1,DA,DFN,DFN1,DG,DGA,DGA1,DGAD,DGAE,DGAE1,DGAL,DGAN,DGAP,DGBLK,DGC,DGCODFLG,DGCT,DGDATA,DGATA1,DGDATE,DGDD,DGDEV,DGDISLO,DGDIV,DGDV,DGE,DGEN,DGFL,DGFLG,DGH,DGHOME,DGI,DGI1,DGL,DGL1,DGN,DGN1,DGO,DGP,DGPGM,DGPR,DGQUIT,DGREG
+1 KILL DGA,DGCODFLG,DGDEV,DGFLG,DGII,DGL,DGL1,DGLAB,DGUB,DGWIDTH,DGXI
+2 KILL DGCTEOM,DGRUN,DGS,DGSEG,DGSEGR,DGTASK,DGTEXT,DGTIME,DGTSK,DGTSK1,DGU,DGUB,DGVAR,DGWHEN,DGWR,DGX,DGX1,DGX2,DGX3,DGXXXD,DGZ,DGZ1,DGZ2,DIC,DINUM,I,I1,I2,I3,I4,J,N,X,X1,X2,X3,XMDUZ,XMSUB,XMTEXT,XMY,Y,^UTILITY($JOB)
DO CLOSE^DGUTQ
+3 DO ENDREP^DGUTL
+4 QUIT
