Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AUZTMC

AUZTMC.m

Go to the documentation of this file.
  1. AUZTMC ;REMOVE THIS LINE AND LEAVE IN UCI "PRD" [ 07/02/86 9:01 AM ]
  1. ZTMC ;TASK FILE & SIGNON CLEANER [ 02/13/86 11:47 AM ]
  1. ;IHS-OKLA CITY AREA OFFICE-DEG
  1. SET S:'$D(DUZ) DUZ=1,DUZ(0)="" I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
  1. S:'$D(DTIME) DTIME=300
  1. I '$D(IO) S %IS="N",IOP=$I D ^%ZIS K IOP S FF=IOF
  1. G END:'$D(^%ZTSCH("RUN"))
  1. S ZTSK=999,ZDD=+$H-3,X=ZDD D VD S ED=Y D SB2
  1. A S ZTSK=$O(^%ZTSK(ZTSK)) G B:ZTSK'?1N.N
  1. I '$D(^%ZTSK(ZTSK,0)) K ^%ZTSK(ZTSK) G A
  1. S X=^%ZTSK(ZTSK,0),ZSD=+$P(X,"^",8),ZRD=+$P(X,"^",6),ZRC=+$P(X,"^",7)
  1. I ZSD<ZDD,ZRD<ZDD,ZRC<ZDD K ^%ZTSK(ZTSK)
  1. G A
  1. B D SB1
  1. END K ZSD,BD,ED,ZTSK,ZRC,ZDD Q
  1. SB1 S ZTSK=998 X ^%ZOSF("UCI") S ^%ZTSK(ZTSK,0)="^AUZTMC"_"^"_DUZ_"^"_Y_"^^"
  1. S ZD=+$H+1_",0060",^%ZTSCH(ZD,ZTSK)=""
  1. Q
  1. SB2 S ED=ED_.999999
  1. S BD=0
  1. SB3 S BD=$O(^XUSEC(0,BD)) G S19:BD=""!(BD>ED)
  1. K ^XUSEC(0,BD)
  1. G SB3
  1. S19 Q
  1. VD S %=X>21608+X-.1,Y=%\365.25+141,%=%#365.25\1
  1. S D=%+306#(Y#4=0+365)#153#61#31+1,M=%-D\29+1
  1. S Y=Y_"00"+M_"00"+D K M,D,% Q