| 1 | PRCGU ;WIRMFO@ALTOONA/CTB PURGEMASTER UTILITY PROGRAM ;12/10/97 10:55 AM
|
---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | UPDATE ;
|
---|
| 5 | W IORC D POS(XPOS+(PERCENT\2),YPOS) W CURSOR
|
---|
| 6 | QUIT
|
---|
| 7 | POS(DX,DY) I $E(IOST)'="C" W ! QUIT
|
---|
| 8 | I DX=""!(DY="") QUIT
|
---|
| 9 | X IOXY
|
---|
| 10 | QUIT
|
---|
| 11 | PERCENT ;
|
---|
| 12 | Q:XCOUNT'>0
|
---|
| 13 | Q:TREC'>0
|
---|
| 14 | S:'$D(ITEMS) ITEMS="items"
|
---|
| 15 | S PERCENT=XCOUNT/TREC*100\1 I PERCENT>99.99999 S PERCENT=100
|
---|
| 16 | I $E(IOST)="C" D UPDATE
|
---|
| 17 | D
|
---|
| 18 | . W !!!,$FN($S(PERCENT=100:TREC,XCOUNT<0:0,1:XCOUNT),",")," of ",$FN(TREC,",")," ",ITEMS," processed. ",PERCENT,"% complete "
|
---|
| 19 | . S TIME=$P($H,",",2)
|
---|
| 20 | . S:BTIME>TIME TIME=TIME+86400
|
---|
| 21 | . S TIME=TIME-BTIME
|
---|
| 22 | . S TTIME=TIME/$S((PERCENT>0):(PERCENT*.01),1:.01),RTIME=TTIME-TIME
|
---|
| 23 | . D TIME(TTIME,"required")
|
---|
| 24 | . D TIME(TIME,"elapsed")
|
---|
| 25 | . D TIME($P(RTIME,"."),"remaining")
|
---|
| 26 | . I $E(IOST)'="C" QUIT
|
---|
| 27 | . QUIT
|
---|
| 28 | QUIT
|
---|
| 29 | S(X) Q $S(X'=1:"s",1:"")
|
---|
| 30 | TIME(X,Y) ;
|
---|
| 31 | NEW HOURS,MIN,SEC
|
---|
| 32 | S HOURS=0,MIN=0,SEC=0
|
---|
| 33 | I X>3600 S HOURS=X\3600,X=X#3600
|
---|
| 34 | S MIN=X\60,SEC=$P(X#60,".")
|
---|
| 35 | I $E(IOST,1,2)="C-" W !
|
---|
| 36 | W:HOURS HOURS," Hour"_$$S(HOURS)_", "
|
---|
| 37 | W:MIN MIN_" Minute"_$$S(MIN)_", "
|
---|
| 38 | W SEC_" Second"_$$S(SEC)_" "_Y_". "
|
---|
| 39 | Q
|
---|
| 40 | BEGIN ;
|
---|
| 41 | W:$G(IOF)'="" @IOF
|
---|
| 42 | I $E(IOST)="C",'$D(ZTQUEUED) S X="IORVON;IORVOFF;IORC;IOSC" D ENDR^%ZISS
|
---|
| 43 | I $D(IORVON),$D(IORVOFF) S CURSOR=IORVON_" "_IORVOFF
|
---|
| 44 | S LREC=$S($E(IOST)="C":TREC\200+1,1:TREC\20+1)
|
---|
| 45 | W !! S X=MESSAGE D MSG
|
---|
| 46 | S LINE=" |-------------------------+-------------------------|"
|
---|
| 47 | I $E(IOST)="C" W !,?25,"P E R C E N T C O M P L E T E",!!?18," 50 100",!,LINE,!?14,"|",?66,"|",!,LINE,!
|
---|
| 48 | S DA=0,LASTENT=0,XPOS=15,YPOS=$Y-2,BTIME=$P($H,",",2),XCOUNT=-1
|
---|
| 49 | D POS(XPOS,YPOS) W:$E(IOST)="C" IOSC
|
---|
| 50 | QUIT
|
---|
| 51 | END ;
|
---|
| 52 | K X S $P(X," ",40)=""
|
---|
| 53 | W !,"100% complete."_X,!
|
---|
| 54 | D:$G(XPDNM)="" KILL^%ZISS
|
---|
| 55 | CLOSE ;CLOSE ALL OPEN DEVICES OTHER THAN THE HOME DEVICE
|
---|
| 56 | N N
|
---|
| 57 | S N=0 F S N=$O(IO(1,N)) Q:'N I N'=IO(0) S IO=N D ^%ZISC
|
---|
| 58 | QUIT
|
---|
| 59 | MSG ;;PRINTS MESSAGE CONTAINED IN X. IF IT DOESNT FIT ON ONE LINE, X IS PRINTED ON THE NEXT LINE.
|
---|
| 60 | N X1,X2,ZX Q:'$D(X) I $S('$D(IOM):1,IOM="":1,1:0) W $P(X,"*") R X:2 K X Q
|
---|
| 61 | I ($L($P(X,"*"))+4+$X)>IOM W !,?(IOM-($L($P(X,"*"))+4))
|
---|
| 62 | F ZX=1:1 D BRK:($L(X)+6)>IOM W " ",$P(X,"*"),! Q:'$D(X1) S X=X1 K X1
|
---|
| 63 | W:X["*" *7
|
---|
| 64 | QUIT
|
---|
| 65 | BRK N I
|
---|
| 66 | S X1=X F I=1:1 Q:$L($P(X," ",1,I))>(IOM-6)!($L(X)<(IOM-6)) S X1=$P(X," ",1,I)
|
---|
| 67 | S X2=$P(X," ",I,999),X=X1,X1=X2 K X2
|
---|
| 68 | QUIT
|
---|
| 69 | DIR() ;SET VARIABLE STRING RETURNING FROM DIR
|
---|
| 70 | NEW X
|
---|
| 71 | S X=$D(DTOUT)_$D(DUOUT)_$D(DIRUT)_$D(DIROUT)
|
---|
| 72 | K DTOUT,DUOUT,DIRUT,DIROUT
|
---|
| 73 | Q X
|
---|