- PRCGU ;WIRMFO@ALTOONA/CTB PURGEMASTER UTILITY PROGRAM ;12/10/97 10:55 AM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- UPDATE ;
- W IORC D POS(XPOS+(PERCENT\2),YPOS) W CURSOR
- QUIT
- POS(DX,DY) I $E(IOST)'="C" W ! QUIT
- I DX=""!(DY="") QUIT
- X IOXY
- QUIT
- PERCENT ;
- Q:XCOUNT'>0
- Q:TREC'>0
- S:'$D(ITEMS) ITEMS="items"
- S PERCENT=XCOUNT/TREC*100\1 I PERCENT>99.99999 S PERCENT=100
- I $E(IOST)="C" D UPDATE
- D
- . W !!!,$FN($S(PERCENT=100:TREC,XCOUNT<0:0,1:XCOUNT),",")," of ",$FN(TREC,",")," ",ITEMS," processed. ",PERCENT,"% complete "
- . S TIME=$P($H,",",2)
- . S:BTIME>TIME TIME=TIME+86400
- . S TIME=TIME-BTIME
- . S TTIME=TIME/$S((PERCENT>0):(PERCENT*.01),1:.01),RTIME=TTIME-TIME
- . D TIME(TTIME,"required")
- . D TIME(TIME,"elapsed")
- . D TIME($P(RTIME,"."),"remaining")
- . I $E(IOST)'="C" QUIT
- . QUIT
- QUIT
- S(X) Q $S(X'=1:"s",1:"")
- TIME(X,Y) ;
- NEW HOURS,MIN,SEC
- S HOURS=0,MIN=0,SEC=0
- I X>3600 S HOURS=X\3600,X=X#3600
- S MIN=X\60,SEC=$P(X#60,".")
- I $E(IOST,1,2)="C-" W !
- W:HOURS HOURS," Hour"_$$S(HOURS)_", "
- W:MIN MIN_" Minute"_$$S(MIN)_", "
- W SEC_" Second"_$$S(SEC)_" "_Y_". "
- Q
- BEGIN ;
- W:$G(IOF)'="" @IOF
- I $E(IOST)="C",'$D(ZTQUEUED) S X="IORVON;IORVOFF;IORC;IOSC" D ENDR^%ZISS
- I $D(IORVON),$D(IORVOFF) S CURSOR=IORVON_" "_IORVOFF
- S LREC=$S($E(IOST)="C":TREC\200+1,1:TREC\20+1)
- W !! S X=MESSAGE D MSG
- S LINE=" |-------------------------+-------------------------|"
- 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,!
- S DA=0,LASTENT=0,XPOS=15,YPOS=$Y-2,BTIME=$P($H,",",2),XCOUNT=-1
- D POS(XPOS,YPOS) W:$E(IOST)="C" IOSC
- QUIT
- END ;
- K X S $P(X," ",40)=""
- W !,"100% complete."_X,!
- D:$G(XPDNM)="" KILL^%ZISS
- CLOSE ;CLOSE ALL OPEN DEVICES OTHER THAN THE HOME DEVICE
- N N
- S N=0 F S N=$O(IO(1,N)) Q:'N I N'=IO(0) S IO=N D ^%ZISC
- QUIT
- MSG ;;PRINTS MESSAGE CONTAINED IN X. IF IT DOESNT FIT ON ONE LINE, X IS PRINTED ON THE NEXT LINE.
- 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
- I ($L($P(X,"*"))+4+$X)>IOM W !,?(IOM-($L($P(X,"*"))+4))
- F ZX=1:1 D BRK:($L(X)+6)>IOM W " ",$P(X,"*"),! Q:'$D(X1) S X=X1 K X1
- W:X["*" *7
- QUIT
- BRK N I
- 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)
- S X2=$P(X," ",I,999),X=X1,X1=X2 K X2
- QUIT
- DIR() ;SET VARIABLE STRING RETURNING FROM DIR
- NEW X
- S X=$D(DTOUT)_$D(DUOUT)_$D(DIRUT)_$D(DIROUT)
- K DTOUT,DUOUT,DIRUT,DIROUT
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCGU 2587 printed Jan 18, 2025@03:06:07 Page 2
- PRCGU ;WIRMFO@ALTOONA/CTB PURGEMASTER UTILITY PROGRAM ;12/10/97 10:55 AM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- UPDATE ;
- +1 WRITE IORC
- DO POS(XPOS+(PERCENT\2),YPOS)
- WRITE CURSOR
- +2 QUIT
- POS(DX,DY) IF $EXTRACT(IOST)'="C"
- WRITE !
- QUIT
- +1 IF DX=""!(DY="")
- QUIT
- +2 XECUTE IOXY
- +3 QUIT
- PERCENT ;
- +1 if XCOUNT'>0
- QUIT
- +2 if TREC'>0
- QUIT
- +3 if '$DATA(ITEMS)
- SET ITEMS="items"
- +4 SET PERCENT=XCOUNT/TREC*100\1
- IF PERCENT>99.99999
- SET PERCENT=100
- +5 IF $EXTRACT(IOST)="C"
- DO UPDATE
- +6 Begin DoDot:1
- +7 WRITE !!!,$FNUMBER($SELECT(PERCENT=100:TREC,XCOUNT<0:0,1:XCOUNT),",")," of ",$FNUMBER(TREC,",")," ",ITEMS," processed. ",PERCENT,"% complete "
- +8 SET TIME=$PIECE($HOROLOG,",",2)
- +9 if BTIME>TIME
- SET TIME=TIME+86400
- +10 SET TIME=TIME-BTIME
- +11 SET TTIME=TIME/$SELECT((PERCENT>0):(PERCENT*.01),1:.01)
- SET RTIME=TTIME-TIME
- +12 DO TIME(TTIME,"required")
- +13 DO TIME(TIME,"elapsed")
- +14 DO TIME($PIECE(RTIME,"."),"remaining")
- +15 IF $EXTRACT(IOST)'="C"
- QUIT
- +16 QUIT
- End DoDot:1
- +17 QUIT
- S(X) QUIT $SELECT(X'=1:"s",1:"")
- TIME(X,Y) ;
- +1 NEW HOURS,MIN,SEC
- +2 SET HOURS=0
- SET MIN=0
- SET SEC=0
- +3 IF X>3600
- SET HOURS=X\3600
- SET X=X#3600
- +4 SET MIN=X\60
- SET SEC=$PIECE(X#60,".")
- +5 IF $EXTRACT(IOST,1,2)="C-"
- WRITE !
- +6 if HOURS
- WRITE HOURS," Hour"_$$S(HOURS)_", "
- +7 if MIN
- WRITE MIN_" Minute"_$$S(MIN)_", "
- +8 WRITE SEC_" Second"_$$S(SEC)_" "_Y_". "
- +9 QUIT
- BEGIN ;
- +1 if $GET(IOF)'=""
- WRITE @IOF
- +2 IF $EXTRACT(IOST)="C"
- IF '$DATA(ZTQUEUED)
- SET X="IORVON;IORVOFF;IORC;IOSC"
- DO ENDR^%ZISS
- +3 IF $DATA(IORVON)
- IF $DATA(IORVOFF)
- SET CURSOR=IORVON_" "_IORVOFF
- +4 SET LREC=$SELECT($EXTRACT(IOST)="C":TREC\200+1,1:TREC\20+1)
- +5 WRITE !!
- SET X=MESSAGE
- DO MSG
- +6 SET LINE=" |-------------------------+-------------------------|"
- +7 IF $EXTRACT(IOST)="C"
- WRITE !,?25,"P E R C E N T C O M P L E T E",!!?18," 50 100",!,LINE,!?14,"|",?66,"|",!,LINE,!
- +8 SET DA=0
- SET LASTENT=0
- SET XPOS=15
- SET YPOS=$Y-2
- SET BTIME=$PIECE($HOROLOG,",",2)
- SET XCOUNT=-1
- +9 DO POS(XPOS,YPOS)
- if $EXTRACT(IOST)="C"
- WRITE IOSC
- +10 QUIT
- END ;
- +1 KILL X
- SET $PIECE(X," ",40)=""
- +2 WRITE !,"100% complete."_X,!
- +3 if $GET(XPDNM)=""
- DO KILL^%ZISS
- CLOSE ;CLOSE ALL OPEN DEVICES OTHER THAN THE HOME DEVICE
- +1 NEW N
- +2 SET N=0
- FOR
- SET N=$ORDER(IO(1,N))
- if 'N
- QUIT
- IF N'=IO(0)
- SET IO=N
- DO ^%ZISC
- +3 QUIT
- MSG ;;PRINTS MESSAGE CONTAINED IN X. IF IT DOESNT FIT ON ONE LINE, X IS PRINTED ON THE NEXT LINE.
- +1 NEW X1,X2,ZX
- if '$DATA(X)
- QUIT
- IF $SELECT('$DATA(IOM):1,IOM="":1,1:0)
- WRITE $PIECE(X,"*")
- READ X:2
- KILL X
- QUIT
- +2 IF ($LENGTH($PIECE(X,"*"))+4+$X)>IOM
- WRITE !,?(IOM-($LENGTH($PIECE(X,"*"))+4))
- +3 FOR ZX=1:1
- if ($LENGTH(X)+6)>IOM
- DO BRK
- WRITE " ",$PIECE(X,"*"),!
- if '$DATA(X1)
- QUIT
- SET X=X1
- KILL X1
- +4 if X["*"
- WRITE *7
- +5 QUIT
- BRK NEW I
- +1 SET X1=X
- FOR I=1:1
- if $LENGTH($PIECE(X," ",1,I))>(IOM-6)!($LENGTH(X)<(IOM-6))
- QUIT
- SET X1=$PIECE(X," ",1,I)
- +2 SET X2=$PIECE(X," ",I,999)
- SET X=X1
- SET X1=X2
- KILL X2
- +3 QUIT
- DIR() ;SET VARIABLE STRING RETURNING FROM DIR
- +1 NEW X
- +2 SET X=$DATA(DTOUT)_$DATA(DUOUT)_$DATA(DIRUT)_$DATA(DIROUT)
- +3 KILL DTOUT,DUOUT,DIRUT,DIROUT
- +4 QUIT X