XUTMHR.m

XUTMHR ;ISF/RWF - Taskman Hourly checkup routine. ;10/20/10  17:13

 ;;8.0;KERNEL;**446,534,554**;Jul 10, 1995;Build 7

 ;Per VHA Directive 2004-038, this routine should not be modified.

 Q

 ;

HOUR ;Work to do each hour

 D SCAN ;Look for scheduled task that have dropped there schedule.

 D DEVREJ() ;Check for tasks re-scheduled for unavailable device.

 Q

 ;

SCAN ;Scan the Scheduled Tasks file.  Merge with XUTMCS sometime.

 N D0,OLD,NOW,X,X1,X2,Z0,Z4,Z5,TK

 ;Make NOW 10 minute in the past

 S U="^",D0=0,NOW=$$HTFM^XLFDT($$HADD^XLFDT($H,,,-10)),OLD=$$HTFM^XLFDT($H-1)

 F  S D0=$O(^DIC(19.2,D0)) Q:'D0  D  L -^DIC(19.2,D0)

 . L +^DIC(19.2,D0):2 I '$T Q

 . S X=$G(^DIC(19.2,D0,0)),X1=+$G(^(1)) ;X1 is the task #.

 . ;Check that the Option still exists.

 . I '($D(^DIC(19,+X,0))#2) D REMOVE(D0) Q

 . I $P(X,U,2)="" Q  ;No Scheduled time.

 . ;Lock the Task

 . L +^%ZTSK(X1):5 I $T D  L -^%ZTSK(X1)

 . . ;I $P(X,U,9)["S" Q  ;Start-up.

 . . I $P(X,U,2)>NOW,$D(^%ZTSK(X1)) Q  ;Scheduled for future

 . . ;ToDo Check if Device OK.

 . . I X1,'$D(^%ZTSK(X1)) D FIX(D0,X) Q  ;%ZTSK entry missing

 . . S TK=$G(^%ZTSK(X1,0))

 . . I $P(X,U,2)>OLD,$L($P(X,U,6)) D FIX(D0,X,$P(TK,U,3)) Q  ;

 . . Q

 . Q

 S ZTREQ="@"

 Q

 ;

FIX(DA,X,USER) ;Reschedule

 N FDA,IEN,Y,DUZ

 S Y=$$APFIND^XUSAP("TASKMAN,PROXY USER")

 S DUZ=$S($G(USER):USER,Y>0:Y,1:.5)

 S Y=$$SCH^XLFDT($P(X,U,6),$P(X,U,2),1),IEN=DA_"," Q:'Y

 S FDA(19.2,IEN,2)=Y

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

 Q

 ;

REMOVE(DA) ;Remove if pointed to option is missing

 N DIK

 S DIK="^DIC(19.2," D ^DIK

 Q

 ;

DEVREJ(SKIP) ;Rejected Device cleanup

 N ZTSK,ZTDTH,CNT,VOL,Y,TRY,X,Z,XMB,XMY

 D GETENV^%ZOSV S VOL=$P(Y,U,2),Y=$O(^%ZIS(14.5,"B",VOL,0)) Q:'Y

 S TRY=$P(^%ZIS(14.5,Y,0),U,12),SKIP=$G(SKIP) Q:'TRY

 S ZTDTH=0

 F  S ZTDTH=$O(^%ZTSCH(ZTDTH)),ZTSK=0 Q:'ZTDTH  F  S ZTSK=$O(^%ZTSCH(ZTDTH,ZTSK)) Q:'ZTSK  D

 . L +^%ZTSK(ZTSK):5 Q:'$T  D  ;Catch next time. p554

 . . Q:'$D(^%ZTSK(ZTSK,0))

 . . S Z=^%ZTSK(ZTSK,0),Y=$G(^%ZTSK(ZTSK,.2)),X=$P(Y,U,8)

 . . I X>TRY D UNSCH(ZTSK,$P(Z,U,3),$S($L($P(Y,U,6)):$P(Y,U,6),1:$P(Y,U)),SKIP)

 . . Q

 . L -^%ZTSK(ZTSK)

 . Q

 Q

 ;

UNSCH(ZTSK,DZ,DEV,SKIP) ;Unschedule Task and send alert

 N XQA,XQAMSG,XQADATA,XQAROU

 D DQ^%ZTLOAD

 S XQA(DZ)="",XQAMSG="Your task #"_ZTSK_" was unscheduled, because it could not get device "_DEV,XQADATA=ZTSK,XQAROU="XQA^XUTMUTL"

 I 'SKIP D SETUP^XQALERT Q

 W !,XQAMSG

 Q

 ;

EN(ZTQPARAM) ;So can job it to run.

 ;

SNAP ;Snapshot ZTMON data into the TASKMAN SNAPSHOT file.

 S U="^"

 N %,FDA,I2,I3,IEN,NOWH3,R2,R3,SI,X,ZT1,ZT2,ZT3,ZT4,ZT5,ZTC,ZTC2,ZTQ1,ZTQ2

 S ZTQPARAM=$G(ZTQPARAM,"60,60") ;Default run for 60 minutes, snap every minute

 S ZTQ1=+ZTQPARAM*60 ;Convert minutes to seconds.

 S:ZTQ1>480 ZTQ1=480 ;Max 8 hours

 S ZTQ2=+$P(ZTQPARAM,",",2)

 S ZTQ2=$S(ZTQ2<2:2,ZTQ2>ZTQ1:ZTQ1,1:ZTQ2) ;See in bounds

 ;

 F  D SN2 S ZTQ1=ZTQ1-ZTQ2 Q:'ZTQ1  H ZTQ2

 Q

 ;

SN2 ;Do the snapshot

 K IEN,FDA,%,R2,R3,SI,I2,I3

 S IEN="+1,",NOWH3=$$H3^%ZTM($H)

 S FDA(14.72,IEN,.01)=$$NOW^XLFDT

 S FDA(14.72,IEN,2)=$$TM^ZTLOAD

 S ZT1="",ZT2=0,SI=101,R2=14.72101

 ;Get the Manager status data

 F  S ZT1=$O(^%ZTSCH("STATUS",ZT1)) Q:ZT1=""  S X=^(ZT1) D

 . S ZT2=ZT2+1,I2="+"_SI_","_IEN,SI=SI+1

 . S FDA(R2,I2,.01)=ZT1,FDA(R2,I2,2)=$P(X,U),FDA(R2,I2,3)=$P(X,U,2)

 . S FDA(R2,I2,4)=$P(X,U,3),FDA(R2,I2,5)=$P(X,U,4)

 . Q

 S FDA(14.72,IEN,3)=ZT2

 ;Check and get the LOAD Balance data

 S %=$G(^%ZTSCH("LOAD")),FDA(14.72,IEN,4)=$P(%,U),FDA(14.72,IEN,5)=$P(%,U,2)

 ;S ZT1=$O(^%ZTSCH(1)),FDA(14.72,IEN,8)=$$LATE(ZT1,NOWH3)

 S ZT1=1,ZT2=0,ZT3=0,ZTC=0,ZTC2=0,ZT5=0

 ;Look at the task schedule list

 ;ZT3 late amount, ZT5 is current time late, ZTC2 is count of late tasks.

 F  S ZT1=$O(^%ZTSCH(ZT1)),ZT2=0 Q:'ZT1  S ZT5=$$LATE(ZT1,NOWH3) S:'ZT3 ZT3=ZT5 D

 . F  S ZT2=$O(^%ZTSCH(ZT1,ZT2)) Q:'ZT2  S ZTC=ZTC+1 S:ZT5 ZTC2=ZTC2+1

 S FDA(14.72,IEN,7)=ZTC,FDA(14.72,IEN,8)=ZT3,FDA(14.72,IEN,9)=ZTC2

 ;Look at the IO list

 S ZT1="",ZTC=0

 F  S ZT1=$O(^%ZTSCH("IO",ZT1)) Q:ZT1=""  S:$O(^%ZTSCH("IO",ZT1,0)) ZTC=ZTC+1

 S FDA(14.72,IEN,10)=ZTC

 S ZT1="",ZT2=0,ZT3=0,ZT4=0,ZTC=0

 F  S ZT1=$O(^%ZTSCH("IO",ZT1)),ZT2=0 Q:'ZT1  F  S ZT2=$O(^%ZTSCH("IO",ZT1,ZT2)),ZT3=0 Q:'ZT2  S:'ZT4 ZT4=ZT2 F  S ZT3=$O(^%ZTSCH("IO",ZT1,ZT2,ZT3)) Q:ZT3=""  S ZTC=ZTC+1

 S FDA(14.72,IEN,11)=ZTC,FDA(14.72,IEN,12)=ZT4

 ;Look at the JOB list

 S ZT1=0,ZT2=0,ZT3=0,ZTC=0

 F  S ZT1=$O(^%ZTSCH("JOB",ZT1)),ZT2=0 Q:'ZT1  F  S ZT2=$O(^%ZTSCH("JOB",ZT1,ZT2)) Q:'ZT2  S ZTC=ZTC+1

 ;Look at the C list

 S ZT1="",ZT2=0,ZT3=0

 F  S ZT1=$O(^%ZTSCH("C",ZT1)),ZT2=0 Q:ZT1=""  F  S ZT2=$O(^%ZTSCH("C",ZT1,ZT2)),ZT3=0 Q:ZT2=""  F  S ZT3=$O(^%ZTSCH("C",ZT1,ZT2,ZT3)) Q:ZT3=""  S ZTC=ZTC+1

 S FDA(14.72,IEN,15)=ZTC

 S FDA(14.72,IEN,16)=$$LATE($O(^%ZTSCH("JOB",1)),NOWH3)

 ;Look at the running Task list

 S ZT1=0,ZT2=0,ZT3=0,ZTC=0

 F  S ZT1=$O(^%ZTSCH("TASK",ZT1)) Q:'ZT1  S ZTC=ZTC+1

 S FDA(14.72,IEN,20)=ZTC

 ;Look at the SUB-Managers

 S ZT1=0,ZT2=0,ZT3=0,ZTC=0,R3=14.72201,SI=201

 F  S ZT1=$O(^%ZTSCH("SUB",ZT1)),ZT2=0 Q:'$L(ZT1)  F  S ZT2=$O(^%ZTSCH("SUB",ZT1,ZT2)) Q:'ZT2  S X=^(ZT2) D

 . S ZTC=ZTC+1,I3="+"_SI_","_IEN,SI=SI+1

 . S FDA(R3,I3,.01)=ZT2,FDA(R3,I3,2)=$P(X,U),FDA(R3,I3,3)=$P(X,U,2),FDA(R3,I3,4)=$P(X,U,3),FDA(R3,I3,5)=ZT1

 . Q

 S FDA(14.72,IEN,19)=ZTC

 S FDA(14.72,IEN,22)=$$ACTJ^%ZOSV() ;Total jobs

 ;Now save the data.

 L +^%ZIS(14.72,0):10 D UPDATE^DIE("S","FDA") L -^%ZIS(14.72,0)

 I $D(^TMP("DIERR",$J)) D ^%ZTER

 Q

 ;

LATE(T1,NOW) ;Return if a H3 time is Late

 S:T1["," T1=$$H3^%ZTM(T1)

 Q $S(T1<1:0,T1<NOW:NOW-T1,1:0)

XUTMHR    ;ISF/RWF - Taskman Hourly checkup routine. ;10/20/10  17:13

 +1       ;;8.0;KERNEL;**446,534,554**;Jul 10, 1995;Build 7

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3        QUIT 

 +4       ;

HOUR      ;Work to do each hour

 +1       ;Look for scheduled task that have dropped there schedule.

           DO SCAN

 +2       ;Check for tasks re-scheduled for unavailable device.

           DO DEVREJ()

 +3        QUIT 

 +4       ;

SCAN      ;Scan the Scheduled Tasks file.  Merge with XUTMCS sometime.

 +1        NEW D0,OLD,NOW,X,X1,X2,Z0,Z4,Z5,TK

 +2       ;Make NOW 10 minute in the past

 +3        SET U="^"

           SET D0=0

           SET NOW=$$HTFM^XLFDT($$HADD^XLFDT($HOROLOG,,,-10))

           SET OLD=$$HTFM^XLFDT($HOROLOG-1)

 +4        FOR 

               SET D0=$ORDER(^DIC(19.2,D0))

               IF 'D0

                   QUIT 

               Begin DoDot:1

 +5                LOCK +^DIC(19.2,D0):2

                   IF '$TEST

                       QUIT 

 +6       ;X1 is the task #.

                   SET X=$GET(^DIC(19.2,D0,0))

                   SET X1=+$GET(^(1))

 +7       ;Check that the Option still exists.

 +8                IF '($DATA(^DIC(19,+X,0))#2)

                       DO REMOVE(D0)

                       QUIT 

 +9       ;No Scheduled time.

                   IF $PIECE(X,U,2)=""

                       QUIT 

 +10      ;Lock the Task

 +11               LOCK +^%ZTSK(X1):5

                   IF $TEST

                       Begin DoDot:2

 +12      ;I $P(X,U,9)["S" Q  ;Start-up.

 +13      ;Scheduled for future

                           IF $PIECE(X,U,2)>NOW

                               IF $DATA(^%ZTSK(X1))

                                   QUIT 

 +14      ;ToDo Check if Device OK.

 +15      ;%ZTSK entry missing

                           IF X1

                               IF '$DATA(^%ZTSK(X1))

                                   DO FIX(D0,X)

                                   QUIT 

 +16                       SET TK=$GET(^%ZTSK(X1,0))

 +17      ;

                           IF $PIECE(X,U,2)>OLD

                               IF $LENGTH($PIECE(X,U,6))

                                   DO FIX(D0,X,$PIECE(TK,U,3))

                                   QUIT 

 +18                       QUIT 

                       End DoDot:2

                       LOCK -^%ZTSK(X1)

 +19               QUIT 

               End DoDot:1

               LOCK -^DIC(19.2,D0)

 +20       SET ZTREQ="@"

 +21       QUIT 

 +22      ;

FIX(DA,X,USER) ;Reschedule

 +1        NEW FDA,IEN,Y,DUZ

 +2        SET Y=$$APFIND^XUSAP("TASKMAN,PROXY USER")

 +3        SET DUZ=$SELECT($GET(USER):USER,Y>0:Y,1:.5)

 +4        SET Y=$$SCH^XLFDT($PIECE(X,U,6),$PIECE(X,U,2),1)

           SET IEN=DA_","

           IF 'Y

               QUIT 

 +5        SET FDA(19.2,IEN,2)=Y

 +6        DO FILE^DIE("K","FDA")

 +7        QUIT 

 +8       ;

REMOVE(DA) ;Remove if pointed to option is missing

 +1        NEW DIK

 +2        SET DIK="^DIC(19.2,"

           DO ^DIK

 +3        QUIT 

 +4       ;

DEVREJ(SKIP) ;Rejected Device cleanup

 +1        NEW ZTSK,ZTDTH,CNT,VOL,Y,TRY,X,Z,XMB,XMY

 +2        DO GETENV^%ZOSV

           SET VOL=$PIECE(Y,U,2)

           SET Y=$ORDER(^%ZIS(14.5,"B",VOL,0))

           IF 'Y

               QUIT 

 +3        SET TRY=$PIECE(^%ZIS(14.5,Y,0),U,12)

           SET SKIP=$GET(SKIP)

           IF 'TRY

               QUIT 

 +4        SET ZTDTH=0

 +5        FOR 

               SET ZTDTH=$ORDER(^%ZTSCH(ZTDTH))

               SET ZTSK=0

               IF 'ZTDTH

                   QUIT 

               FOR 

                   SET ZTSK=$ORDER(^%ZTSCH(ZTDTH,ZTSK))

                   IF 'ZTSK

                       QUIT 

                   Begin DoDot:1

 +6       ;Catch next time. p554

                       LOCK +^%ZTSK(ZTSK):5

                       IF '$TEST

                           QUIT 

                       Begin DoDot:2

 +7                        IF '$DATA(^%ZTSK(ZTSK,0))

                               QUIT 

 +8                        SET Z=^%ZTSK(ZTSK,0)

                           SET Y=$GET(^%ZTSK(ZTSK,.2))

                           SET X=$PIECE(Y,U,8)

 +9                        IF X>TRY

                               DO UNSCH(ZTSK,$PIECE(Z,U,3),$SELECT($LENGTH($PIECE(Y,U,6)):$PIECE(Y,U,6),1:$PIECE(Y,U)),SKIP)

 +10                       QUIT 

                       End DoDot:2

 +11                   LOCK -^%ZTSK(ZTSK)

 +12                   QUIT 

                   End DoDot:1

 +13       QUIT 

 +14      ;

UNSCH(ZTSK,DZ,DEV,SKIP) ;Unschedule Task and send alert

 +1        NEW XQA,XQAMSG,XQADATA,XQAROU

 +2        DO DQ^%ZTLOAD

 +3        SET XQA(DZ)=""

           SET XQAMSG="Your task #"_ZTSK_" was unscheduled, because it could not get device "_DEV

           SET XQADATA=ZTSK

           SET XQAROU="XQA^XUTMUTL"

 +4        IF 'SKIP

               DO SETUP^XQALERT

               QUIT 

 +5        WRITE !,XQAMSG

 +6        QUIT 

 +7       ;

EN(ZTQPARAM) ;So can job it to run.

 +1       ;

SNAP      ;Snapshot ZTMON data into the TASKMAN SNAPSHOT file.

 +1        SET U="^"

 +2        NEW %,FDA,I2,I3,IEN,NOWH3,R2,R3,SI,X,ZT1,ZT2,ZT3,ZT4,ZT5,ZTC,ZTC2,ZTQ1,ZTQ2

 +3       ;Default run for 60 minutes, snap every minute

           SET ZTQPARAM=$GET(ZTQPARAM,"60,60")

 +4       ;Convert minutes to seconds.

           SET ZTQ1=+ZTQPARAM*60

 +5       ;Max 8 hours

           IF ZTQ1>480

               SET ZTQ1=480

 +6        SET ZTQ2=+$PIECE(ZTQPARAM,",",2)

 +7       ;See in bounds

           SET ZTQ2=$SELECT(ZTQ2<2:2,ZTQ2>ZTQ1:ZTQ1,1:ZTQ2)

 +8       ;

 +9        FOR 

               DO SN2

               SET ZTQ1=ZTQ1-ZTQ2

               IF 'ZTQ1

                   QUIT 

               HANG ZTQ2

 +10       QUIT 

 +11      ;

SN2       ;Do the snapshot

 +1        KILL IEN,FDA,%,R2,R3,SI,I2,I3

 +2        SET IEN="+1,"

           SET NOWH3=$$H3^%ZTM($HOROLOG)

 +3        SET FDA(14.72,IEN,.01)=$$NOW^XLFDT

 +4        SET FDA(14.72,IEN,2)=$$TM^ZTLOAD

 +5        SET ZT1=""

           SET ZT2=0

           SET SI=101

           SET R2=14.72101

 +6       ;Get the Manager status data

 +7        FOR 

               SET ZT1=$ORDER(^%ZTSCH("STATUS",ZT1))

               IF ZT1=""

                   QUIT 

               SET X=^(ZT1)

               Begin DoDot:1

 +8                SET ZT2=ZT2+1

                   SET I2="+"_SI_","_IEN

                   SET SI=SI+1

 +9                SET FDA(R2,I2,.01)=ZT1

                   SET FDA(R2,I2,2)=$PIECE(X,U)

                   SET FDA(R2,I2,3)=$PIECE(X,U,2)

 +10               SET FDA(R2,I2,4)=$PIECE(X,U,3)

                   SET FDA(R2,I2,5)=$PIECE(X,U,4)

 +11               QUIT 

               End DoDot:1

 +12       SET FDA(14.72,IEN,3)=ZT2

 +13      ;Check and get the LOAD Balance data

 +14       SET %=$GET(^%ZTSCH("LOAD"))

           SET FDA(14.72,IEN,4)=$PIECE(%,U)

           SET FDA(14.72,IEN,5)=$PIECE(%,U,2)

 +15      ;S ZT1=$O(^%ZTSCH(1)),FDA(14.72,IEN,8)=$$LATE(ZT1,NOWH3)

 +16       SET ZT1=1

           SET ZT2=0

           SET ZT3=0

           SET ZTC=0

           SET ZTC2=0

           SET ZT5=0

 +17      ;Look at the task schedule list

 +18      ;ZT3 late amount, ZT5 is current time late, ZTC2 is count of late tasks.

 +19       FOR 

               SET ZT1=$ORDER(^%ZTSCH(ZT1))

               SET ZT2=0

               IF 'ZT1

                   QUIT 

               SET ZT5=$$LATE(ZT1,NOWH3)

               IF 'ZT3

                   SET ZT3=ZT5

               Begin DoDot:1

 +20               FOR 

                       SET ZT2=$ORDER(^%ZTSCH(ZT1,ZT2))

                       IF 'ZT2

                           QUIT 

                       SET ZTC=ZTC+1

                       IF ZT5

                           SET ZTC2=ZTC2+1

               End DoDot:1

 +21       SET FDA(14.72,IEN,7)=ZTC

           SET FDA(14.72,IEN,8)=ZT3

           SET FDA(14.72,IEN,9)=ZTC2

 +22      ;Look at the IO list

 +23       SET ZT1=""

           SET ZTC=0

 +24       FOR 

               SET ZT1=$ORDER(^%ZTSCH("IO",ZT1))

               IF ZT1=""

                   QUIT 

               IF $ORDER(^%ZTSCH("IO",ZT1,0))

                   SET ZTC=ZTC+1

 +25       SET FDA(14.72,IEN,10)=ZTC

 +26       SET ZT1=""

           SET ZT2=0

           SET ZT3=0

           SET ZT4=0

           SET ZTC=0

 +27       FOR 

               SET ZT1=$ORDER(^%ZTSCH("IO",ZT1))

               SET ZT2=0

               IF 'ZT1

                   QUIT 

               FOR 

                   SET ZT2=$ORDER(^%ZTSCH("IO",ZT1,ZT2))

                   SET ZT3=0

                   IF 'ZT2

                       QUIT 

                   IF 'ZT4

                       SET ZT4=ZT2

                   FOR 

                       SET ZT3=$ORDER(^%ZTSCH("IO",ZT1,ZT2,ZT3))

                       IF ZT3=""

                           QUIT 

                       SET ZTC=ZTC+1

 +28       SET FDA(14.72,IEN,11)=ZTC

           SET FDA(14.72,IEN,12)=ZT4

 +29      ;Look at the JOB list

 +30       SET ZT1=0

           SET ZT2=0

           SET ZT3=0

           SET ZTC=0

 +31       FOR 

               SET ZT1=$ORDER(^%ZTSCH("JOB",ZT1))

               SET ZT2=0

               IF 'ZT1

                   QUIT 

               FOR 

                   SET ZT2=$ORDER(^%ZTSCH("JOB",ZT1,ZT2))

                   IF 'ZT2

                       QUIT 

                   SET ZTC=ZTC+1

 +32      ;Look at the C list

 +33       SET ZT1=""

           SET ZT2=0

           SET ZT3=0

 +34       FOR 

               SET ZT1=$ORDER(^%ZTSCH("C",ZT1))

               SET ZT2=0

               IF ZT1=""

                   QUIT 

               FOR 

                   SET ZT2=$ORDER(^%ZTSCH("C",ZT1,ZT2))

                   SET ZT3=0

                   IF ZT2=""

                       QUIT 

                   FOR 

                       SET ZT3=$ORDER(^%ZTSCH("C",ZT1,ZT2,ZT3))

                       IF ZT3=""

                           QUIT 

                       SET ZTC=ZTC+1

 +35       SET FDA(14.72,IEN,15)=ZTC

 +36       SET FDA(14.72,IEN,16)=$$LATE($ORDER(^%ZTSCH("JOB",1)),NOWH3)

 +37      ;Look at the running Task list

 +38       SET ZT1=0

           SET ZT2=0

           SET ZT3=0

           SET ZTC=0

 +39       FOR 

               SET ZT1=$ORDER(^%ZTSCH("TASK",ZT1))

               IF 'ZT1

                   QUIT 

               SET ZTC=ZTC+1

 +40       SET FDA(14.72,IEN,20)=ZTC

 +41      ;Look at the SUB-Managers

 +42       SET ZT1=0

           SET ZT2=0

           SET ZT3=0

           SET ZTC=0

           SET R3=14.72201

           SET SI=201

 +43       FOR 

               SET ZT1=$ORDER(^%ZTSCH("SUB",ZT1))

               SET ZT2=0

               IF '$LENGTH(ZT1)

                   QUIT 

               FOR 

                   SET ZT2=$ORDER(^%ZTSCH("SUB",ZT1,ZT2))

                   IF 'ZT2

                       QUIT 

                   SET X=^(ZT2)

                   Begin DoDot:1

 +44                   SET ZTC=ZTC+1

                       SET I3="+"_SI_","_IEN

                       SET SI=SI+1

 +45                   SET FDA(R3,I3,.01)=ZT2

                       SET FDA(R3,I3,2)=$PIECE(X,U)

                       SET FDA(R3,I3,3)=$PIECE(X,U,2)

                       SET FDA(R3,I3,4)=$PIECE(X,U,3)

                       SET FDA(R3,I3,5)=ZT1

 +46                   QUIT 

                   End DoDot:1

 +47       SET FDA(14.72,IEN,19)=ZTC

 +48      ;Total jobs

           SET FDA(14.72,IEN,22)=$$ACTJ^%ZOSV()

 +49      ;Now save the data.

 +50       LOCK +^%ZIS(14.72,0):10

           DO UPDATE^DIE("S","FDA")

           LOCK -^%ZIS(14.72,0)

 +51       IF $DATA(^TMP("DIERR",$JOB))

               DO ^%ZTER

 +52       QUIT 

 +53      ;

LATE(T1,NOW) ;Return if a H3 time is Late

 +1        IF T1[","

               SET T1=$$H3^%ZTM(T1)

 +2        QUIT $SELECT(T1<1:0,T1<NOW:NOW-T1,1:0)