- 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 ""
