AUZTMC.m

AUZTMC ;REMOVE THIS LINE AND LEAVE IN UCI "PRD" [ 07/02/86  9:01 AM ]

ZTMC ;TASK FILE & SIGNON CLEANER [ 02/13/86  11:47 AM ]

 ;IHS-OKLA CITY AREA OFFICE-DEG

SET S:'$D(DUZ) DUZ=1,DUZ(0)="" I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y

 S:'$D(DTIME) DTIME=300

 I '$D(IO) S %IS="N",IOP=$I D ^%ZIS K IOP S FF=IOF

 G END:'$D(^%ZTSCH("RUN"))

 S ZTSK=999,ZDD=+$H-3,X=ZDD D VD S ED=Y D SB2

A S ZTSK=$O(^%ZTSK(ZTSK)) G B:ZTSK'?1N.N

 I '$D(^%ZTSK(ZTSK,0)) K ^%ZTSK(ZTSK) G A

 S X=^%ZTSK(ZTSK,0),ZSD=+$P(X,"^",8),ZRD=+$P(X,"^",6),ZRC=+$P(X,"^",7)

 I ZSD<ZDD,ZRD<ZDD,ZRC<ZDD K ^%ZTSK(ZTSK)

 G A

B D SB1

END K ZSD,BD,ED,ZTSK,ZRC,ZDD Q

SB1 S ZTSK=998 X ^%ZOSF("UCI") S ^%ZTSK(ZTSK,0)="^AUZTMC"_"^"_DUZ_"^"_Y_"^^"

 S ZD=+$H+1_",0060",^%ZTSCH(ZD,ZTSK)=""

 Q

SB2 S ED=ED_.999999

 S BD=0

SB3 S BD=$O(^XUSEC(0,BD)) G S19:BD=""!(BD>ED)

 K ^XUSEC(0,BD)

 G SB3

S19 Q

VD S %=X>21608+X-.1,Y=%\365.25+141,%=%#365.25\1

 S D=%+306#(Y#4=0+365)#153#61#31+1,M=%-D\29+1

 S Y=Y_"00"+M_"00"+D K M,D,% Q

AUZTMC    ;REMOVE THIS LINE AND LEAVE IN UCI "PRD" [ 07/02/86  9:01 AM ]

ZTMC      ;TASK FILE & SIGNON CLEANER [ 02/13/86  11:47 AM ]

 +1       ;IHS-OKLA CITY AREA OFFICE-DEG

SET        IF '$DATA(DUZ)

               SET DUZ=1

               SET DUZ(0)=""

           IF '$DATA(DT)

               SET %DT=""

               SET X="T"

               DO ^%DT

               SET DT=Y

 +1        IF '$DATA(DTIME)

               SET DTIME=300

 +2        IF '$DATA(IO)

               SET %IS="N"

               SET IOP=$IO

               DO ^%ZIS

               KILL IOP

               SET FF=IOF

 +3        IF '$DATA(^%ZTSCH("RUN"))

               GOTO END

 +4        SET ZTSK=999

           SET ZDD=+$HOROLOG-3

           SET X=ZDD

           DO VD

           SET ED=Y

           DO SB2

A          SET ZTSK=$ORDER(^%ZTSK(ZTSK))

           IF ZTSK'?1N.N

               GOTO B

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

               KILL ^%ZTSK(ZTSK)

               GOTO A

 +2        SET X=^%ZTSK(ZTSK,0)

           SET ZSD=+$PIECE(X,"^",8)

           SET ZRD=+$PIECE(X,"^",6)

           SET ZRC=+$PIECE(X,"^",7)

 +3        IF ZSD<ZDD

               IF ZRD<ZDD

                   IF ZRC<ZDD

                       KILL ^%ZTSK(ZTSK)

 +4        GOTO A

B          DO SB1

END        KILL ZSD,BD,ED,ZTSK,ZRC,ZDD

           QUIT 

SB1        SET ZTSK=998

           XECUTE ^%ZOSF("UCI")

           SET ^%ZTSK(ZTSK,0)="^AUZTMC"_"^"_DUZ_"^"_Y_"^^"

 +1        SET ZD=+$HOROLOG+1_",0060"

           SET ^%ZTSCH(ZD,ZTSK)=""

 +2        QUIT 

SB2        SET ED=ED_.999999

 +1        SET BD=0

SB3        SET BD=$ORDER(^XUSEC(0,BD))

           IF BD=""!(BD>ED)

               GOTO S19

 +1        KILL ^XUSEC(0,BD)

 +2        GOTO SB3

S19        QUIT 

VD         SET %=X>21608+X-.1

           SET Y=%\365.25+141

           SET %=%#365.25\1

 +1        SET D=%+306#(Y#4=0+365)#153#61#31+1

           SET M=%-D\29+1

 +2        SET Y=Y_"00"+M_"00"+D

           KILL M,D,%

           QUIT