- 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