ZIBRPRTD ; IHS/ADC/GTH - ROUTINE PRINT ; [ 10/29/2002 7:42 AM ]
;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
; This routine lists routines edited after given date.
;
BEGIN ;
;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
;I ^%ZOSF("OS")'["MSM" D OSNO^XB Q
;S X="ERR^ZIBRPRTD",@^%ZOSF("TRAP")
;W !?10,$P($P($ZV,","),"-")," - Routine Print Utility"
NEW ZIBOS
S ZIBOS=$$VERSION^%ZOSV(1)
I '(ZIBOS["Cache"),'(ZIBOS["MSM") D OSNO^XB Q
I ZIBOS["MSM" S X="ERR^ZIBRPRTD",@^%ZOSF("TRAP")
I ZIBOS["Cache" S X="BACK^%ETN",@^%ZOSF("TRAP")
W !?10,ZIBOS," - Routine Print Utility"
;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
RSEL ;
S %DEV=$I
U 0
KILL QUIT
;X ^%ZOSF("RSEL") ;IHS/SET/GTH XB*3*9 10/29/2002
S %R=1 X ^%ZOSF("RSEL") ;IHS/SET/GTH XB*3*9 10/29/2002
;I $D(QUIT) W !,"No routines selected" G EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
I $D(QUIT)!(%R=0) W !,"No routines selected" G EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
S XBTYPE="PRINT"
D ^XBDATE ;ADDED TO SPECIFY A DATE AND SCREEN OUT ROUTINES EDITED SINCE SPECIFIED DATE
I $D(QUIT) W !,"No routines will be printed." H 2 G EXIT
SDEV ;
;I %DEV=$I D PR^%SDEV G:$D(QUIT) EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
D ^%ZIS G:POP EXIT S %DEV=IO ;IHS/SET/GTH XB*3*9 10/29/2002
F1 ;
S %LPP=60,%W=132
W !!,"Lines per page <",%LPP,">: "
R %I:$G(DTIME,999)
I %I="" S %I=%LPP W %I
I %I'?1N.N G:%I="^" SDEV:$I'=%DEV,RSEL G:%I="^Q" EXIT W !,*7,"Response must be positive numeric" G F1
S %LPP=+%I
F2 ;
W !,"Characters per line <",%W,">: "
R %I:$G(DTIME,999)
I %I="" S %I=%W W %I
I %I'?1N.N G EXIT:%I="^Q",F1:%I="^" W !,*7,"Response must be positive numeric" G F2
S %W=+%I,%L=%W-18-63,%CMT=""
G:%L'>0 START
CMT ;
R !,"Enter comment for page header : ",%CMT:$G(DTIME,999)
G F2:%CMT="^",CMT1:%CMT'="?"
W !,"The comment will be displayed with the UCI, date, and time on each page header."
G CMT
;
CMT1 ;
I $L(%CMT)>%L W !,*7,"Too long. Maximum comment length is ",%L G CMT
START ;
D INT^%T,INT^%D
D FORMAT
U %DEV
;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
;W !!
;I %DEV<20!(%DEV>63) U %DEV:%W
;U 0
I ZIBOS["Cache" W @IOF
I %DEV<20!(%DEV>63),ZIBOS["MSM" U %DEV:%W
U $P
;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
W !!,"Done. "
EXIT ;
;U 0 ;IHS/SET/GTH XB*3*9 10/29/2002
;I '$D(QUIT),%DEV'=$I,+%DEV S IO=%DEV D ^%ZISC ;IHS/SET/GTH XB*3*9 10/29/2002
I '$D(QUIT),%DEV'=$I S IO=%DEV D ^%ZISC ;IHS/SET/GTH XB*3*9 10/29/2002
KILL %DEV,%LPP,%W,%I,%J,%CMT,%TIM,%TIM1,%DAT,%DAT1,%PG,%PGG,%RN,%L,%R,%X,%,%BLK,QUIT
Q
;
ERR ;EP - If error, from error trap.
I $F($$Z^ZIBNSSV("ERROR"),"<INRPT>") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2
ZQ
;
FORMAT ;
S %PG=1,%PGG=1
W !!,"Printing ...",!
F3 ;
;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
;S %X="W:$Y # W !,""Routine: "",%RN,?20,""UCI: "",$ZU(0),"" Date/Time: "",%DAT1,"", "",%TIM1,?$X+3,%CMT,?%W-18,""Page: "",%PG,""-"",%PGG,! S %PGG=%PGG+1"
;U %DEV
;I %DEV<20!(%DEV>63) U %DEV:%W
;S %RN=""
;F %I=1:1 S %RN=$O(^UTILITY($J,%RN)) Q:%RN="" X:$V(8,$J,2)'=$I "U 0 W ?$S($X=0:0,1:$X+10\10*10-1),%RN W:$X>70 ! U %DEV" D F4 S %PG=%PG+1,%PGG=1
S:ZIBOS["MSM" %X="W:$Y # W !,""Routine: "",%RN,?20,""UCI: "",$ZU(0),"" Date/Time: "",%DAT1,"", "",%TIM1,?$X+3,%CMT,?%W-18,""Page: "",%PG,""-"",%PGG,! S %PGG=%PGG+1"
S:ZIBOS["Cache" %X="W:$Y # W !,""Routine: "",%RN,?20,""Namespace: "",$ZU(5),"" Date/Time: "",%DAT,"", "",%TIM,?$X+3,%CMT,?%W-18,""Page: "",%PG,""-"",%PGG,! S %PGG=%PGG+1"
U %DEV
I ZIBOS["MSM" D
. I %DEV<20!(%DEV>63) U %DEV:%W
. S %RN=""
. F %I=1:1 S %RN=$O(^UTILITY($J,%RN)) Q:%RN="" X:$V(8,$J,2)'=$I "U 0 W ?$S($X=0:0,1:$X+10\10*10-1),%RN W:$X>70 ! U %DEV" D F4 S %PG=%PG+1,%PGG=1
I ZIBOS["Cache" D
. S %RN=0
. F %I=1:1 S %RN=$O(^UTILITY($J,%RN)) Q:%RN="" X "U $P W ?$S($X=0:0,1:$X+10\10*10-1),%RN W:$X>70 ! U %DEV" D F4 S %PG=%PG+1,%PGG=1
;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
Q
;
F4 ;
X %X
X "ZL @%RN F %I=1:1 S %J=$T(+%I) Q:%J="""" S %L=$P(%J,"" ""),%R=$P(%J,"" "",2,255) X:$Y>%LPP %X W !,%L,?10 F %J=1:%W-10:255 S %L=$E(%R,1,%W-10),%R=$E(%R,%W-10+1,255) W %L Q:%R="""" X:$Y>%LPP %X W !,"".........."""
Q
;
ZIBRPRTD ; IHS/ADC/GTH - ROUTINE PRINT ; [ 10/29/2002 7:42 AM ]
+1 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
+2 ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
+3 ; This routine lists routines edited after given date.
+4 ;
BEGIN ;
+1 ;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
+2 ;I ^%ZOSF("OS")'["MSM" D OSNO^XB Q
+3 ;S X="ERR^ZIBRPRTD",@^%ZOSF("TRAP")
+4 ;W !?10,$P($P($ZV,","),"-")," - Routine Print Utility"
+5 NEW ZIBOS
+6 SET ZIBOS=$$VERSION^%ZOSV(1)
+7 IF '(ZIBOS["Cache")
IF '(ZIBOS["MSM")
DO OSNO^XB
QUIT
+8 IF ZIBOS["MSM"
SET X="ERR^ZIBRPRTD"
SET @^%ZOSF("TRAP")
+9 IF ZIBOS["Cache"
SET X="BACK^%ETN"
SET @^%ZOSF("TRAP")
+10 WRITE !?10,ZIBOS," - Routine Print Utility"
+11 ;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
RSEL ;
+1 SET %DEV=$IO
+2 USE 0
+3 KILL QUIT
+4 ;X ^%ZOSF("RSEL") ;IHS/SET/GTH XB*3*9 10/29/2002
+5 ;IHS/SET/GTH XB*3*9 10/29/2002
SET %R=1
XECUTE ^%ZOSF("RSEL")
+6 ;I $D(QUIT) W !,"No routines selected" G EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
+7 ;IHS/SET/GTH XB*3*9 10/29/2002
IF $DATA(QUIT)!(%R=0)
WRITE !,"No routines selected"
GOTO EXIT
+8 SET XBTYPE="PRINT"
+9 ;ADDED TO SPECIFY A DATE AND SCREEN OUT ROUTINES EDITED SINCE SPECIFIED DATE
DO ^XBDATE
+10 IF $DATA(QUIT)
WRITE !,"No routines will be printed."
HANG 2
GOTO EXIT
SDEV ;
+1 ;I %DEV=$I D PR^%SDEV G:$D(QUIT) EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
+2 ;IHS/SET/GTH XB*3*9 10/29/2002
DO ^%ZIS
IF POP
GOTO EXIT
SET %DEV=IO
F1 ;
+1 SET %LPP=60
SET %W=132
+2 WRITE !!,"Lines per page <",%LPP,">: "
+3 READ %I:$GET(DTIME,999)
+4 IF %I=""
SET %I=%LPP
WRITE %I
+5 IF %I'?1N.N
IF %I="^"
IF $IO'=%DEV
GOTO SDEV
GOTO RSEL
IF %I="^Q"
GOTO EXIT
WRITE !,*7,"Response must be positive numeric"
GOTO F1
+6 SET %LPP=+%I
F2 ;
+1 WRITE !,"Characters per line <",%W,">: "
+2 READ %I:$GET(DTIME,999)
+3 IF %I=""
SET %I=%W
WRITE %I
+4 IF %I'?1N.N
IF %I="^Q"
GOTO EXIT
IF %I="^"
GOTO F1
WRITE !,*7,"Response must be positive numeric"
GOTO F2
+5 SET %W=+%I
SET %L=%W-18-63
SET %CMT=""
+6 IF %L'>0
GOTO START
CMT ;
+1 READ !,"Enter comment for page header : ",%CMT:$GET(DTIME,999)
+2 IF %CMT="^"
GOTO F2
IF %CMT'="?"
GOTO CMT1
+3 WRITE !,"The comment will be displayed with the UCI, date, and time on each page header."
+4 GOTO CMT
+5 ;
CMT1 ;
+1 IF $LENGTH(%CMT)>%L
WRITE !,*7,"Too long. Maximum comment length is ",%L
GOTO CMT
START ;
+1 DO INT^%T
DO INT^%D
+2 DO FORMAT
+3 USE %DEV
+4 ;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
+5 ;W !!
+6 ;I %DEV<20!(%DEV>63) U %DEV:%W
+7 ;U 0
+8 IF ZIBOS["Cache"
WRITE @IOF
+9 IF %DEV<20!(%DEV>63)
IF ZIBOS["MSM"
USE %DEV:%W
+10 USE $PRINCIPAL
+11 ;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
+12 WRITE !!,"Done. "
EXIT ;
+1 ;U 0 ;IHS/SET/GTH XB*3*9 10/29/2002
+2 ;I '$D(QUIT),%DEV'=$I,+%DEV S IO=%DEV D ^%ZISC ;IHS/SET/GTH XB*3*9 10/29/2002
+3 ;IHS/SET/GTH XB*3*9 10/29/2002
IF '$DATA(QUIT)
IF %DEV'=$IO
SET IO=%DEV
DO ^%ZISC
+4 KILL %DEV,%LPP,%W,%I,%J,%CMT,%TIM,%TIM1,%DAT,%DAT1,%PG,%PGG,%RN,%L,%R,%X,%,%BLK,QUIT
+5 QUIT
+6 ;
ERR ;EP - If error, from error trap.
+1 IF $FIND($$Z^ZIBNSSV("ERROR"),"<INRPT>")
USE 0
WRITE !!,"...Aborted."
DO EXIT
VIEW 0:$JOB:$ZB($VIEW(0,$JOB,2),#0400,7):2
+2
*** ERROR ***
+3 ;
FORMAT ;
+1 SET %PG=1
SET %PGG=1
+2 WRITE !!,"Printing ...",!
F3 ;
+1 ;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
+2 ;S %X="W:$Y # W !,""Routine: "",%RN,?20,""UCI: "",$ZU(0),"" Date/Time: "",%DAT1,"", "",%TIM1,?$X+3,%CMT,?%W-18,""Page: "",%PG,""-"",%PGG,! S %PGG=%PGG+1"
+3 ;U %DEV
+4 ;I %DEV<20!(%DEV>63) U %DEV:%W
+5 ;S %RN=""
+6 ;F %I=1:1 S %RN=$O(^UTILITY($J,%RN)) Q:%RN="" X:$V(8,$J,2)'=$I "U 0 W ?$S($X=0:0,1:$X+10\10*10-1),%RN W:$X>70 ! U %DEV" D F4 S %PG=%PG+1,%PGG=1
+7 IF ZIBOS["MSM"
SET %X="W:$Y # W !,""Routine: "",%RN,?20,""UCI: "",$ZU(0),"" Date/Time: "",%DAT1,"", "",%TIM1,?$X+3,%CMT,?%W-18,""Page: "",%PG,""-"",%PGG,! S %PGG=%PGG+1"
+8 IF ZIBOS["Cache"
SET %X="W:$Y # W !,""Routine: "",%RN,?20,""Namespace: "",$ZU(5),"" Date/Time: "",%DAT,"", "",%TIM,?$X+3,%CMT,?%W-18,""Page: "",%PG,""-"",%PGG,! S %PGG=%PGG+1"
+9 USE %DEV
+10 IF ZIBOS["MSM"
Begin DoDot:1
+11 IF %DEV<20!(%DEV>63)
USE %DEV:%W
+12 SET %RN=""
+13 FOR %I=1:1
SET %RN=$ORDER(^UTILITY($JOB,%RN))
IF %RN=""
QUIT
IF $VIEW(8,$JOB,2)'=$IO
XECUTE "U 0 W ?$S($X=0:0,1:$X+10\10*10-1),%RN W:$X>70 ! U %DEV"
DO F4
SET %PG=%PG+1
SET %PGG=1
End DoDot:1
+14 IF ZIBOS["Cache"
Begin DoDot:1
+15 SET %RN=0
+16 FOR %I=1:1
SET %RN=$ORDER(^UTILITY($JOB,%RN))
IF %RN=""
QUIT
XECUTE "U $P W ?$S($X=0:0,1:$X+10\10*10-1),%RN W:$X>70 ! U %DEV"
DO F4
SET %PG=%PG+1
SET %PGG=1
End DoDot:1
+17 ;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
+18 QUIT
+19 ;
F4 ;
+1 XECUTE %X
+2 XECUTE "ZL @%RN F %I=1:1 S %J=$T(+%I) Q:%J="""" S %L=$P(%J,"" ""),%R=$P(%J,"" "",2,255) X:$Y>%LPP %X W !,%L,?10 F %J=1:%W-10:255 S %L=$E(%R,1,%W-10),%R=$E(%R,%W-10+1,255) W %L Q:%R="""" X:$Y>%LPP %X W !,"".........."""
+3 QUIT
+4 ;
