%ZTP1 ;SF/RWF - Prints 1ST lines in Name, Date, Patch or Size order ;08/18/09 16:25
;;7.3;TOOLKIT;**20,70,91,105,122**;Apr 25, 1995;Build 4
;Per VHA Directive 2004-038, this routine should not be modified.
A W !!,"PRINTS FIRST LINES",!!
K ^UTILITY($J) S DTIME=$G(DTIME,300)
X ^%ZOSF("RSEL") G KIL:$O(^UTILITY($J,0))=""
A1 ;
N ZTP1,ZTP2,X
A2 R !,"(A)lpha, (D)ate ,(P)atched, OR (S)ize ORDER: A//",ZTP1:DTIME
S:ZTP1="" ZTP1="A" S ZTP1=$E(ZTP1,1) G KIL:ZTP1="^",A2:"ADPS"'[ZTP1
S ZTP2=$S(ZTP1="P":"2",1:"None")
A3 W !,"Include line (2), Include lines 2&(3), (N)one: ",ZTP2,"//" R X:DTIME
S X=$TR(X,"n","N")
G KIL:X["^"!('$T) S:X="" X=ZTP2 G A3:"23N"'[$E(X) S ZTP2=+X
S %ZIS="QM" D ^%ZIS G KIL:POP
I $D(IO("Q")) D D ^%ZISC Q
. K IO("Q") S ZTRTN="DQ^%ZTP1",ZTSAVE("ZTP1")="",ZTSAVE("^UTILITY($J,")="",ZTSAVE("ZTP2")="",ZTDESC="FIRST LINES PRINT"
. D ^%ZTLOAD K ZTSK Q
;Set RN for all loops
DQ ;Taskman entry point
N %L,%R,%ZN,A,B,C,HED,JR,S,X,Y,ZTP,ZP,RN,CCNT
S RN=2 G DATE:ZTP1="D",SIZE:ZTP1="S",PATCH:ZTP1="P"
;
ALPHA ;By name
F JP=1:1 S RN=$O(^UTILITY($J,RN)) Q:RN="" S ^UTILITY($J,1,JP,RN)=0
S HED=" FIRST LINE LIST "
G LIST
;
SIZE ;Sort by routine size
F S RN=$O(^UTILITY($J,RN)) Q:RN="" D
. D LOAD(RN)
. S Y=$$SIZE2(.CCNT) I '$D(ZTQUEUED) W RN," ",Y,?$X\19+1*19 W:$X>66 !
. D KEEP(Y,RN,CCNT)
S HED=" SIZE RANKING "
G LIST
;
LOAD(X,R) ;Load routine
N DIF,XCNP K ^TMP($J)
S DIF="^TMP($J,",XCNP=0 X ^%ZOSF("LOAD")
I $D(R) S R(1)=$G(^TMP($J,1,0)),R(2)=$G(^TMP($J,2,0)),R(3)=$G(^TMP($J,3,0))
Q
;
KEEP(IX1,IX2,IX4) ;
S ^UTILITY($J,1,IX1,IX2)=2
S ^UTILITY($J,1,IX1,IX2,1)=^TMP($J,1,0),^UTILITY($J,1,IX1,IX2,2)=^TMP($J,2,0),^UTILITY($J,1,IX1,IX2,3)=$G(^TMP($J,3,0))
S:$D(IX4) ^UTILITY($J,1,IX1,IX2,4)=IX4
Q
;
LIST ;All 3 sorts come here to print the list.
N %X,QUIT,L,L1,L2,S,PL,X
S PL=IOSL-3-ZTP2,X=$H X ^%ZOSF("ZD")
X ^%ZOSF("UCI") S HED=HED_" UCI: "_Y,X=$H X ^%ZOSF("ZD")
S HED=HED_" "_Y,HED(1)="Total/Comments"
U IO D HED
S ZP=0,X=0,QUIT=0,S=0
F S S=$O(^UTILITY($J,1,S)),RN="" Q:(S'>0)!(QUIT) D
. F S RN=$O(^UTILITY($J,1,S,RN)) Q:'$L(RN)!QUIT D
. . D:$Y>PL WAIT I X["^" S RN="zz",QUIT=1,S=" " Q
. . S ZP=ZP+1 D L2
I 'QUIT W !!?14,ZP," ROUTINES",!
KIL D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
K ^UTILITY($J)
Q
;
L2 ;Write one
N LI
I ^UTILITY($J,1,S,RN) M LI=^(RN) ;S LI(1)=^(RN,1),LI(2)=^(2),LI(3)=^(3)
I '$T S LI=0 D LOAD(RN,.LI) S LI(1)=$P(LI(1)," ",2,999)
W RN,?10 W:ZTP1="S" $J(S,5),"/",LI(4),?20," - " S %X=$X-1 D WR(LI(1))
I ZTP2 W ?%X D WR(LI(2)) I ZTP2>2 W ?%X D WR(LI(3))
Q
;
WR(STR) ;Write line w/ wrap
N %1,%2
S %1=$X+1,%2=IOM-1-%1
F W $E(STR,1,%2) S STR=$E(STR,%2+1,9999) Q:'$L(STR) W !,?%1
W:$X>0 !
Q
;
WAIT ;Wait at end of page
I IOST["C-" R !,"Enter Return to continue ",X:DTIME Q:X["^"
HED W @IOF,!?12,HED,! W:ZTP1="S" ?10,HED(1),! Q
;
DATE ;Sort by date
F S RN=$O(^UTILITY($J,RN)) Q:RN="" D
. N L S L=0 D LOAD(RN,.L)
. S X=$$DTF(L(1)) D KEEP(9999999-X,RN)
. W RN," ",X,?$X\19+1*19 W:$X>66 !
. Q
S HED=" REVERSE DATE ORDER "
G LIST
DTF(L) ;Find the date
N %,PC,%DT,B,S,Y,X
S Y=-1
F PC=2:1:$L(L,";") S B=1,X=$P(L,";",PC) D Q:Y>0
. S %DT="T"
. S:X?.E1"["1.2N1"/"1.2N1"/"2.4N.E1"]".E X=$P($P(X,"[",2),"]",1) ;Look for [10/23/2008 14:23]
. I X?1.2N1P1.2N1P2.4N.E D ^%DT Q:Y>0
. F %=1:1:$L(X) D Q:Y>0
. . S S=$E(X,%)?1P S:B&S X=$E(X,1,%-1)_$E(X,%+1,999),%=%-1
. . S:'S B=0 S:$E(X,%+1,999)?1N.N1":".E X=$E(X,1,%-1)_"@"_$E(X,%+1,999),%=999
. . I %>$L(X) N % D ^%DT
. . Q
. Q
Q Y
;,X=$P(ZTP,"" ;"",3) X A(1) S B=1,X=$P(ZTP,"";"",4) X:Y<0 A(1)
;
PATCH ;Sort by first patch number
N S2
F S2=0:0 S RN=$O(^UTILITY($J,RN)) Q:RN="" D
. N L S L=0 D LOAD(RN,.L)
. S X=$P(L(2),";",5) I X]"" S S=+$P(X,"**",2) D KEEP(S,RN)
S HED=" PATCHED ROUTINES "
G LIST
;
SIZE2(CCNT) ; Return size in bytes of routine in ^TMP($J)
N NUM,LINE,SIZE,R4,I ; line number, line text, size
S (SIZE,CCNT)=0
F NUM=1:1 S LINE=$G(^TMP($J,NUM,0)) Q:LINE="" S SIZE=SIZE+$L(LINE)+2,R4=$P(LINE," ",2,999) D
. S I=0 I " ."[$E(R4) F I=1:1:$L(R4) Q:" ."'[$E(R4,I)
. I I S R4=$E(R4,I,$L(R4))
. I $E(R4)=";",$E(R4,2)'=";" S CCNT=CCNT+$L(R4) ;Comment size
Q SIZE
;
BUILD ;
N Y,BLDA,%N,S2
I '$D(^XPD(9.6,0)) W !,"No BUILD file to work from." Q
S Y=$$BUILD^XTRUTL1 G KIL:Y'>0 S BLDA=+Y
D RTN^XTRUTL1(BLDA)
I '$D(^UTILITY($J)) W !,"No routines in this build." G KIL
G A1
;
POST ;POST-INIT
N %D,%S,I,SCR,ZTOS,ZTMODE
S ZTMODE=2,ZTOS=$$OS^ZTMGRSET()
S %S="ZTP1^ZTPP",%D="%ZTP1^%ZTPP",SCR="I 1" D MOVE^ZTMGRSET
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTP1 4630 printed Apr 09, 2024@21:10:19 Page 2
%ZTP1 ;SF/RWF - Prints 1ST lines in Name, Date, Patch or Size order ;08/18/09 16:25
+1 ;;7.3;TOOLKIT;**20,70,91,105,122**;Apr 25, 1995;Build 4
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
A WRITE !!,"PRINTS FIRST LINES",!!
+1 KILL ^UTILITY($JOB)
SET DTIME=$GET(DTIME,300)
+2 XECUTE ^%ZOSF("RSEL")
if $ORDER(^UTILITY($JOB,0))=""
GOTO KIL
A1 ;
+1 NEW ZTP1,ZTP2,X
A2 READ !,"(A)lpha, (D)ate ,(P)atched, OR (S)ize ORDER: A//",ZTP1:DTIME
+1 if ZTP1=""
SET ZTP1="A"
SET ZTP1=$EXTRACT(ZTP1,1)
if ZTP1="^"
GOTO KIL
if "ADPS"'[ZTP1
GOTO A2
+2 SET ZTP2=$SELECT(ZTP1="P":"2",1:"None")
A3 WRITE !,"Include line (2), Include lines 2&(3), (N)one: ",ZTP2,"//"
READ X:DTIME
+1 SET X=$TRANSLATE(X,"n","N")
+2 if X["^"!('$TEST)
GOTO KIL
if X=""
SET X=ZTP2
if "23N"'[$EXTRACT(X)
GOTO A3
SET ZTP2=+X
+3 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO KIL
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 KILL IO("Q")
SET ZTRTN="DQ^%ZTP1"
SET ZTSAVE("ZTP1")=""
SET ZTSAVE("^UTILITY($J,")=""
SET ZTSAVE("ZTP2")=""
SET ZTDESC="FIRST LINES PRINT"
+6 DO ^%ZTLOAD
KILL ZTSK
QUIT
End DoDot:1
DO ^%ZISC
QUIT
+7 ;Set RN for all loops
DQ ;Taskman entry point
+1 NEW %L,%R,%ZN,A,B,C,HED,JR,S,X,Y,ZTP,ZP,RN,CCNT
+2 SET RN=2
if ZTP1="D"
GOTO DATE
if ZTP1="S"
GOTO SIZE
if ZTP1="P"
GOTO PATCH
+3 ;
ALPHA ;By name
+1 FOR JP=1:1
SET RN=$ORDER(^UTILITY($JOB,RN))
if RN=""
QUIT
SET ^UTILITY($JOB,1,JP,RN)=0
+2 SET HED=" FIRST LINE LIST "
+3 GOTO LIST
+4 ;
SIZE ;Sort by routine size
+1 FOR
SET RN=$ORDER(^UTILITY($JOB,RN))
if RN=""
QUIT
Begin DoDot:1
+2 DO LOAD(RN)
+3 SET Y=$$SIZE2(.CCNT)
IF '$DATA(ZTQUEUED)
WRITE RN," ",Y,?$X\19+1*19
if $X>66
WRITE !
+4 DO KEEP(Y,RN,CCNT)
End DoDot:1
+5 SET HED=" SIZE RANKING "
+6 GOTO LIST
+7 ;
LOAD(X,R) ;Load routine
+1 NEW DIF,XCNP
KILL ^TMP($JOB)
+2 SET DIF="^TMP($J,"
SET XCNP=0
XECUTE ^%ZOSF("LOAD")
+3 IF $DATA(R)
SET R(1)=$GET(^TMP($JOB,1,0))
SET R(2)=$GET(^TMP($JOB,2,0))
SET R(3)=$GET(^TMP($JOB,3,0))
+4 QUIT
+5 ;
KEEP(IX1,IX2,IX4) ;
+1 SET ^UTILITY($JOB,1,IX1,IX2)=2
+2 SET ^UTILITY($JOB,1,IX1,IX2,1)=^TMP($JOB,1,0)
SET ^UTILITY($JOB,1,IX1,IX2,2)=^TMP($JOB,2,0)
SET ^UTILITY($JOB,1,IX1,IX2,3)=$GET(^TMP($JOB,3,0))
+3 if $DATA(IX4)
SET ^UTILITY($JOB,1,IX1,IX2,4)=IX4
+4 QUIT
+5 ;
LIST ;All 3 sorts come here to print the list.
+1 NEW %X,QUIT,L,L1,L2,S,PL,X
+2 SET PL=IOSL-3-ZTP2
SET X=$HOROLOG
XECUTE ^%ZOSF("ZD")
+3 XECUTE ^%ZOSF("UCI")
SET HED=HED_" UCI: "_Y
SET X=$HOROLOG
XECUTE ^%ZOSF("ZD")
+4 SET HED=HED_" "_Y
SET HED(1)="Total/Comments"
+5 USE IO
DO HED
+6 SET ZP=0
SET X=0
SET QUIT=0
SET S=0
+7 FOR
SET S=$ORDER(^UTILITY($JOB,1,S))
SET RN=""
if (S'>0)!(QUIT)
QUIT
Begin DoDot:1
+8 FOR
SET RN=$ORDER(^UTILITY($JOB,1,S,RN))
if '$LENGTH(RN)!QUIT
QUIT
Begin DoDot:2
+9 if $Y>PL
DO WAIT
IF X["^"
SET RN="zz"
SET QUIT=1
SET S=" "
QUIT
+10 SET ZP=ZP+1
DO L2
End DoDot:2
End DoDot:1
+11 IF 'QUIT
WRITE !!?14,ZP," ROUTINES",!
KIL DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL ^UTILITY($JOB)
+2 QUIT
+3 ;
L2 ;Write one
+1 NEW LI
+2 ;S LI(1)=^(RN,1),LI(2)=^(2),LI(3)=^(3)
IF ^UTILITY($JOB,1,S,RN)
MERGE LI=^(RN)
+3 IF '$TEST
SET LI=0
DO LOAD(RN,.LI)
SET LI(1)=$PIECE(LI(1)," ",2,999)
+4 WRITE RN,?10
if ZTP1="S"
WRITE $JUSTIFY(S,5),"/",LI(4),?20," - "
SET %X=$X-1
DO WR(LI(1))
+5 IF ZTP2
WRITE ?%X
DO WR(LI(2))
IF ZTP2>2
WRITE ?%X
DO WR(LI(3))
+6 QUIT
+7 ;
WR(STR) ;Write line w/ wrap
+1 NEW %1,%2
+2 SET %1=$X+1
SET %2=IOM-1-%1
+3 FOR
WRITE $EXTRACT(STR,1,%2)
SET STR=$EXTRACT(STR,%2+1,9999)
if '$LENGTH(STR)
QUIT
WRITE !,?%1
+4 if $X>0
WRITE !
+5 QUIT
+6 ;
WAIT ;Wait at end of page
+1 IF IOST["C-"
READ !,"Enter Return to continue ",X:DTIME
if X["^"
QUIT
HED WRITE @IOF,!?12,HED,!
if ZTP1="S"
WRITE ?10,HED(1),!
QUIT
+1 ;
DATE ;Sort by date
+1 FOR
SET RN=$ORDER(^UTILITY($JOB,RN))
if RN=""
QUIT
Begin DoDot:1
+2 NEW L
SET L=0
DO LOAD(RN,.L)
+3 SET X=$$DTF(L(1))
DO KEEP(9999999-X,RN)
+4 WRITE RN," ",X,?$X\19+1*19
if $X>66
WRITE !
+5 QUIT
End DoDot:1
+6 SET HED=" REVERSE DATE ORDER "
+7 GOTO LIST
DTF(L) ;Find the date
+1 NEW %,PC,%DT,B,S,Y,X
+2 SET Y=-1
+3 FOR PC=2:1:$LENGTH(L,";")
SET B=1
SET X=$PIECE(L,";",PC)
Begin DoDot:1
+4 SET %DT="T"
+5 ;Look for [10/23/2008 14:23]
if X?.E1"["1.2N1"/"1.2N1"/"2.4N.E1"]".E
SET X=$PIECE($PIECE(X,"[",2),"]",1)
+6 IF X?1.2N1P1.2N1P2.4N.E
DO ^%DT
if Y>0
QUIT
+7 FOR %=1:1:$LENGTH(X)
Begin DoDot:2
+8 SET S=$EXTRACT(X,%)?1P
if B&S
SET X=$EXTRACT(X,1,%-1)_$EXTRACT(X,%+1,999)
SET %=%-1
+9 if 'S
SET B=0
if $EXTRACT(X,%+1,999)?1N.N1"
SET X=$EXTRACT(X,1,%-1)_"@"_$EXTRACT(X,%+1,999)
SET %=999
+10 IF %>$LENGTH(X)
NEW %
DO ^%DT
+11 QUIT
End DoDot:2
if Y>0
QUIT
+12 QUIT
End DoDot:1
if Y>0
QUIT
+13 QUIT Y
+14 ;,X=$P(ZTP,"" ;"",3) X A(1) S B=1,X=$P(ZTP,"";"",4) X:Y<0 A(1)
+15 ;
PATCH ;Sort by first patch number
+1 NEW S2
+2 FOR S2=0:0
SET RN=$ORDER(^UTILITY($JOB,RN))
if RN=""
QUIT
Begin DoDot:1
+3 NEW L
SET L=0
DO LOAD(RN,.L)
+4 SET X=$PIECE(L(2),";",5)
IF X]""
SET S=+$PIECE(X,"**",2)
DO KEEP(S,RN)
End DoDot:1
+5 SET HED=" PATCHED ROUTINES "
+6 GOTO LIST
+7 ;
SIZE2(CCNT) ; Return size in bytes of routine in ^TMP($J)
+1 ; line number, line text, size
NEW NUM,LINE,SIZE,R4,I
+2 SET (SIZE,CCNT)=0
+3 FOR NUM=1:1
SET LINE=$GET(^TMP($JOB,NUM,0))
if LINE=""
QUIT
SET SIZE=SIZE+$LENGTH(LINE)+2
SET R4=$PIECE(LINE," ",2,999)
Begin DoDot:1
+4 SET I=0
IF " ."[$EXTRACT(R4)
FOR I=1:1:$LENGTH(R4)
if " ."'[$EXTRACT(R4,I)
QUIT
+5 IF I
SET R4=$EXTRACT(R4,I,$LENGTH(R4))
+6 ;Comment size
IF $EXTRACT(R4)=";"
IF $EXTRACT(R4,2)'=";"
SET CCNT=CCNT+$LENGTH(R4)
End DoDot:1
+7 QUIT SIZE
+8 ;
BUILD ;
+1 NEW Y,BLDA,%N,S2
+2 IF '$DATA(^XPD(9.6,0))
WRITE !,"No BUILD file to work from."
QUIT
+3 SET Y=$$BUILD^XTRUTL1
if Y'>0
GOTO KIL
SET BLDA=+Y
+4 DO RTN^XTRUTL1(BLDA)
+5 IF '$DATA(^UTILITY($JOB))
WRITE !,"No routines in this build."
GOTO KIL
+6 GOTO A1
+7 ;
POST ;POST-INIT
+1 NEW %D,%S,I,SCR,ZTOS,ZTMODE
+2 SET ZTMODE=2
SET ZTOS=$$OS^ZTMGRSET()
+3 SET %S="ZTP1^ZTPP"
SET %D="%ZTP1^%ZTPP"
SET SCR="I 1"
DO MOVE^ZTMGRSET
+4 QUIT
