CIAURPRT ;MSC/IND/DKM - Routine Pretty Print Program ;04-May-2006 08:19;DKM
;;1.2;CIA UTILITIES;;Mar 20, 2007
;;Copyright 2000-2006, Medsphere Systems Corporation
;=================================================================
N R,C,D,P,N,M,L,X,Y,B,W,Z,S,A,F,T,Q
D HOME^%ZIS,TITLE^CIAU("Routine Pretty Print")
X ^%ZOSF("RSEL")
I $O(^UTILITY($J,0))="" W "No routines selected.",!! K ^UTILITY($J) Q
D ^%ZIS
Q:POP
X ^%ZOSF("UCI")
S A=Y,R=0,C=" >>> ",W=IOM-$L(C)-1,M=$L(C)+1,B=$$UND^CIAU(W),T=$E(IOST,1,2)="C-",F=$S(T:IOF,1:""""""),Q=0
F S R=$O(^UTILITY($J,R)) Q:R="" D
.I IO'=IO(0) U IO(0) W !,"Printing "_R_"..."
.U IO
.S D=$$ENTRY^CIAUDT($H),P=0,$Y=IOSL,S=0
.X "ZL @R F N=1:1 S L=$T(+N) Q:'$L(L) S ^UTILITY($J,R,N)=L,S=S+$L(L)+2"
.S S="("_$$FMTNUM^CIAU(S)_" bytes)"
.F N=0:0 S N=$O(^UTILITY($J,R,N)) Q:'N D Q:Q
..S L=^(N),X=$P(L," "),L=X_$E(" ",$L(X)+1,8)_" "_$P(L," ",2,999),Z=""
..F Q:L=""!Q D
...S X=$E(L,1,W),L=$E(L,W+1,999)
...D:IOSL-2<$Y HDR
...Q:Q
...W Z,?M,X,!
...S Z=C
K ^UTILITY($J)
D ^%ZISC
Q
HDR I P,T R "Press enter to continue...",Q:$G(DTIME,300) S Q=Q["^"!'$T Q:Q
S P=P+1,$Y=0
W @F,!?M,A,$$CTR(R),$$RJ("Page "_P),!
W ?M,$G(^DD("SITE")),$$CTR(S),$$RJ(D),!
W ?M,B,!!
S:P=1 F=IOF
Q
CTR(X) W ?(IOM-$L(X)\2+M),X
Q ""
RJ(X) W ?(IOM-$L(X)),X
Q ""
CIAURPRT ;MSC/IND/DKM - Routine Pretty Print Program ;04-May-2006 08:19;DKM
+1 ;;1.2;CIA UTILITIES;;Mar 20, 2007
+2 ;;Copyright 2000-2006, Medsphere Systems Corporation
+3 ;=================================================================
+4 NEW R,C,D,P,N,M,L,X,Y,B,W,Z,S,A,F,T,Q
+5 DO HOME^%ZIS
DO TITLE^CIAU("Routine Pretty Print")
+6 XECUTE ^%ZOSF("RSEL")
+7 IF $ORDER(^UTILITY($JOB,0))=""
WRITE "No routines selected.",!!
KILL ^UTILITY($JOB)
QUIT
+8 DO ^%ZIS
+9 IF POP
QUIT
+10 XECUTE ^%ZOSF("UCI")
+11 SET A=Y
SET R=0
SET C=" >>> "
SET W=IOM-$LENGTH(C)-1
SET M=$LENGTH(C)+1
SET B=$$UND^CIAU(W)
SET T=$EXTRACT(IOST,1,2)="C-"
SET F=$SELECT(T:IOF,1:"""""")
SET Q=0
+12 FOR
SET R=$ORDER(^UTILITY($JOB,R))
IF R=""
QUIT
Begin DoDot:1
+13 IF IO'=IO(0)
USE IO(0)
WRITE !,"Printing "_R_"..."
+14 USE IO
+15 SET D=$$ENTRY^CIAUDT($HOROLOG)
SET P=0
SET $Y=IOSL
SET S=0
+16 XECUTE "ZL @R F N=1:1 S L=$T(+N) Q:'$L(L) S ^UTILITY($J,R,N)=L,S=S+$L(L)+2"
+17 SET S="("_$$FMTNUM^CIAU(S)_" bytes)"
+18 FOR N=0:0
SET N=$ORDER(^UTILITY($JOB,R,N))
IF 'N
QUIT
Begin DoDot:2
+19 SET L=^(N)
SET X=$PIECE(L," ")
SET L=X_$EXTRACT(" ",$LENGTH(X)+1,8)_" "_$PIECE(L," ",2,999)
SET Z=""
+20 FOR
IF L=""!Q
QUIT
Begin DoDot:3
+21 SET X=$EXTRACT(L,1,W)
SET L=$EXTRACT(L,W+1,999)
+22 IF IOSL-2<$Y
DO HDR
+23 IF Q
QUIT
+24 WRITE Z,?M,X,!
+25 SET Z=C
End DoDot:3
End DoDot:2
IF Q
QUIT
End DoDot:1
+26 KILL ^UTILITY($JOB)
+27 DO ^%ZISC
+28 QUIT
HDR IF P
IF T
READ "Press enter to continue...",Q:$GET(DTIME,300)
SET Q=Q["^"!'$TEST
IF Q
QUIT
+1 SET P=P+1
SET $Y=0
+2 WRITE @F,!?M,A,$$CTR(R),$$RJ("Page "_P),!
+3 WRITE ?M,$GET(^DD("SITE")),$$CTR(S),$$RJ(D),!
+4 WRITE ?M,B,!!
+5 IF P=1
SET F=IOF
+6 QUIT
CTR(X) WRITE ?(IOM-$LENGTH(X)\2+M),X
+1 QUIT ""
RJ(X) WRITE ?(IOM-$LENGTH(X)),X
+1 QUIT ""
