PRPFU.m

PRPFU ;ALTOONA/CTB  FATIENT FUNDS UTILITY PROGRAM ;11/27/96  3:42 PM

V ;;3.0;PATIENT FUNDS;**6**;JUNE 1,1989

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 ;

 I $D(XPDIDTOT),'$D(PRPFPASS) D UPDATE^XPDID(XCOUNT) QUIT

 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 ;

 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

 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 ;

 I $G(XPDNM)]"",'$D(PRPFPASS) K XPDIDTOT QUIT

 K X S $P(X," ",40)=""

 W !,"100% complete."_X,!

 D 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 ---PRPFU   2723     printed  Feb 18, 2025@23:28:26                                                                                                                                                                                                       Page 2

PRPFU     ;ALTOONA/CTB  FATIENT FUNDS UTILITY PROGRAM ;11/27/96  3:42 PM

V         ;;3.0;PATIENT FUNDS;**6**;JUNE 1,1989

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 $DATA(XPDIDTOT)

               IF '$DATA(PRPFPASS)

                   DO UPDATE^XPDID(XCOUNT)

                   QUIT 

 +2        if '$DATA(ITEMS)

               SET ITEMS="items"

 +3        SET PERCENT=XCOUNT/TREC*100\1

           IF PERCENT>99.99999

               SET PERCENT=100

 +4        IF $EXTRACT(IOST)="C"

               DO UPDATE

 +5        Begin DoDot:1

 +6            WRITE !!!,$FNUMBER($SELECT(PERCENT=100:TREC,XCOUNT<0:0,1:XCOUNT),",")," of ",$FNUMBER(TREC,",")," ",ITEMS," processed.  ",PERCENT,"% complete "

 +7            SET TIME=$PIECE($HOROLOG,",",2)

 +8            if BTIME>TIME

                   SET TIME=TIME+86400

 +9            SET TIME=TIME-BTIME

 +10           SET TTIME=TIME/$SELECT((PERCENT>0):(PERCENT*.01),1:.01)

               SET RTIME=TTIME-TIME

 +11           DO TIME(TTIME,"required")

 +12           DO TIME(TIME,"elapsed")

 +13           DO TIME($PIECE(RTIME,"."),"remaining")

 +14           IF $EXTRACT(IOST)'="C"

                   QUIT 

 +15           QUIT 

           End DoDot:1

 +16       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 $DATA(XPDNM)

               IF '$DATA(PRPFPASS)

                   SET XPDIDTOT=TREC

                   SET LREC=$SELECT($EXTRACT(IOST)="C":TREC\200+1,1:TREC\20+1)

                   SET DA=0

                   SET XCOUNT=-1

                   DO BMES^XPDUTL(MESSAGE)

                   QUIT 

 +2        if $GET(IOF)'=""

               WRITE @IOF

 +3        IF $EXTRACT(IOST)="C"

               IF '$DATA(ZTQUEUED)

                   SET X="IORVON;IORVOFF;IORC;IOSC"

                   DO ENDR^%ZISS

 +4        IF $DATA(IORVON)

               IF $DATA(IORVOFF)

                   SET CURSOR=IORVON_" "_IORVOFF

 +5        SET LREC=$SELECT($EXTRACT(IOST)="C":TREC\200+1,1:TREC\20+1)

 +6        WRITE !!

           SET X=MESSAGE

           DO MSG

 +7        SET LINE="              |-------------------------+-------------------------|"

 +8        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,!

 +9        SET DA=0

           SET LASTENT=0

           SET XPOS=15

           SET YPOS=$Y-2

           SET BTIME=$PIECE($HOROLOG,",",2)

           SET XCOUNT=-1

 +10       DO POS(XPOS,YPOS)

           if $EXTRACT(IOST)="C"

               WRITE IOSC

 +11       QUIT 

END       ;

 +1        IF $GET(XPDNM)]""

               IF '$DATA(PRPFPASS)

                   KILL XPDIDTOT

                   QUIT 

 +2        KILL X

           SET $PIECE(X," ",40)=""

 +3        WRITE !,"100% complete."_X,!

 +4        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