| [613] | 1 | PRPFU ;ALTOONA/CTB  FATIENT FUNDS UTILITY PROGRAM ;11/27/96  3:42 PM
 | 
|---|
 | 2 | V ;;3.0;PATIENT FUNDS;**6**;JUNE 1,1989
 | 
|---|
 | 3 | UPDATE ;
 | 
|---|
 | 4 |  W IORC D POS(XPOS+(PERCENT\2),YPOS) W CURSOR
 | 
|---|
 | 5 |  QUIT
 | 
|---|
 | 6 | POS(DX,DY) I $E(IOST)'="C" W ! QUIT
 | 
|---|
 | 7 |  I DX=""!(DY="") QUIT
 | 
|---|
 | 8 |  X IOXY
 | 
|---|
 | 9 |  QUIT
 | 
|---|
 | 10 | PERCENT ;
 | 
|---|
 | 11 |  I $D(XPDIDTOT),'$D(PRPFPASS) D UPDATE^XPDID(XCOUNT) QUIT
 | 
|---|
 | 12 |  S:'$D(ITEMS) ITEMS="items"
 | 
|---|
 | 13 |  S PERCENT=XCOUNT/TREC*100\1 I PERCENT>99.99999 S PERCENT=100
 | 
|---|
 | 14 |  I $E(IOST)="C" D UPDATE
 | 
|---|
 | 15 |  D
 | 
|---|
 | 16 |  . W !!!,$FN($S(PERCENT=100:TREC,XCOUNT<0:0,1:XCOUNT),",")," of ",$FN(TREC,",")," ",ITEMS," processed.  ",PERCENT,"% complete "
 | 
|---|
 | 17 |  . S TIME=$P($H,",",2)
 | 
|---|
 | 18 |  . S:BTIME>TIME TIME=TIME+86400
 | 
|---|
 | 19 |  . S TIME=TIME-BTIME
 | 
|---|
 | 20 |  . S TTIME=TIME/$S((PERCENT>0):(PERCENT*.01),1:.01),RTIME=TTIME-TIME
 | 
|---|
 | 21 |  . D TIME(TTIME,"required")
 | 
|---|
 | 22 |  . D TIME(TIME,"elapsed")
 | 
|---|
 | 23 |  . D TIME($P(RTIME,"."),"remaining")
 | 
|---|
 | 24 |  . I $E(IOST)'="C" QUIT
 | 
|---|
 | 25 |  . QUIT
 | 
|---|
 | 26 |  QUIT
 | 
|---|
 | 27 | S(X) Q $S(X'=1:"s",1:"")
 | 
|---|
 | 28 | TIME(X,Y) ;
 | 
|---|
 | 29 |  NEW HOURS,MIN,SEC
 | 
|---|
 | 30 |  S HOURS=0,MIN=0,SEC=0
 | 
|---|
 | 31 |  I X>3600 S HOURS=X\3600,X=X#3600
 | 
|---|
 | 32 |  S MIN=X\60,SEC=$P(X#60,".")
 | 
|---|
 | 33 |  I $E(IOST,1,2)="C-" W !
 | 
|---|
 | 34 |  W:HOURS HOURS," Hour"_$$S(HOURS)_", "
 | 
|---|
 | 35 |  W:MIN MIN_" Minute"_$$S(MIN)_", "
 | 
|---|
 | 36 |  W SEC_" Second"_$$S(SEC)_" "_Y_".                "
 | 
|---|
 | 37 |  Q
 | 
|---|
 | 38 | BEGIN ;
 | 
|---|
 | 39 |  I $D(XPDNM),'$D(PRPFPASS) S XPDIDTOT=TREC,LREC=$S($E(IOST)="C":TREC\200+1,1:TREC\20+1),DA=0,XCOUNT=-1 D BMES^XPDUTL(MESSAGE) QUIT
 | 
|---|
 | 40 |  W:$G(IOF)'="" @IOF
 | 
|---|
 | 41 |  I $E(IOST)="C",'$D(ZTQUEUED) S X="IORVON;IORVOFF;IORC;IOSC" D ENDR^%ZISS
 | 
|---|
 | 42 |  I $D(IORVON),$D(IORVOFF) S CURSOR=IORVON_" "_IORVOFF
 | 
|---|
 | 43 |  S LREC=$S($E(IOST)="C":TREC\200+1,1:TREC\20+1)
 | 
|---|
 | 44 |  W !! S X=MESSAGE D MSG
 | 
|---|
 | 45 |  S LINE="              |-------------------------+-------------------------|"
 | 
|---|
 | 46 |  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,!
 | 
|---|
 | 47 |  S DA=0,LASTENT=0,XPOS=15,YPOS=$Y-2,BTIME=$P($H,",",2),XCOUNT=-1
 | 
|---|
 | 48 |  D POS(XPOS,YPOS) W:$E(IOST)="C" IOSC
 | 
|---|
 | 49 |  QUIT
 | 
|---|
 | 50 | END ;
 | 
|---|
 | 51 |  I $G(XPDNM)]"",'$D(PRPFPASS) K XPDIDTOT QUIT
 | 
|---|
 | 52 |  K X S $P(X," ",40)=""
 | 
|---|
 | 53 |  W !,"100% complete."_X,!
 | 
|---|
 | 54 |  D 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
 | 
|---|