source: WorldVistAEHR/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFU.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1PRPFU ;ALTOONA/CTB FATIENT FUNDS UTILITY PROGRAM ;11/27/96 3:42 PM
2V ;;3.0;PATIENT FUNDS;**6**;JUNE 1,1989
3UPDATE ;
4 W IORC D POS(XPOS+(PERCENT\2),YPOS) W CURSOR
5 QUIT
6POS(DX,DY) I $E(IOST)'="C" W ! QUIT
7 I DX=""!(DY="") QUIT
8 X IOXY
9 QUIT
10PERCENT ;
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
27S(X) Q $S(X'=1:"s",1:"")
28TIME(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
38BEGIN ;
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
50END ;
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
55CLOSE ;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
59MSG ;;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
65BRK 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
69DIR() ;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
Note: See TracBrowser for help on using the repository browser.