source: IHS-VA_UTILITIES-XB/ZIBRPRTD.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 15 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 4.0 KB
Line 
1ZIBRPRTD ; IHS/ADC/GTH - ROUTINE PRINT ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
4 ; This routine lists routines edited after given date.
5 ;
6BEGIN ;
7 ;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
8 ;I ^%ZOSF("OS")'["MSM" D OSNO^XB Q
9 ;S X="ERR^ZIBRPRTD",@^%ZOSF("TRAP")
10 ;W !?10,$P($P($ZV,","),"-")," - Routine Print Utility"
11 NEW ZIBOS
12 S ZIBOS=$$VERSION^%ZOSV(1)
13 I '(ZIBOS["Cache"),'(ZIBOS["MSM") D OSNO^XB Q
14 I ZIBOS["MSM" S X="ERR^ZIBRPRTD",@^%ZOSF("TRAP")
15 I ZIBOS["Cache" S X="BACK^%ETN",@^%ZOSF("TRAP")
16 W !?10,ZIBOS," - Routine Print Utility"
17 ;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
18RSEL ;
19 S %DEV=$I
20 U 0
21 KILL QUIT
22 ;X ^%ZOSF("RSEL") ;IHS/SET/GTH XB*3*9 10/29/2002
23 S %R=1 X ^%ZOSF("RSEL") ;IHS/SET/GTH XB*3*9 10/29/2002
24 ;I $D(QUIT) W !,"No routines selected" G EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
25 I $D(QUIT)!(%R=0) W !,"No routines selected" G EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
26 S XBTYPE="PRINT"
27 D ^XBDATE ;ADDED TO SPECIFY A DATE AND SCREEN OUT ROUTINES EDITED SINCE SPECIFIED DATE
28 I $D(QUIT) W !,"No routines will be printed." H 2 G EXIT
29SDEV ;
30 ;I %DEV=$I D PR^%SDEV G:$D(QUIT) EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
31 D ^%ZIS G:POP EXIT S %DEV=IO ;IHS/SET/GTH XB*3*9 10/29/2002
32F1 ;
33 S %LPP=60,%W=132
34 W !!,"Lines per page <",%LPP,">: "
35 R %I:$G(DTIME,999)
36 I %I="" S %I=%LPP W %I
37 I %I'?1N.N G:%I="^" SDEV:$I'=%DEV,RSEL G:%I="^Q" EXIT W !,*7,"Response must be positive numeric" G F1
38 S %LPP=+%I
39F2 ;
40 W !,"Characters per line <",%W,">: "
41 R %I:$G(DTIME,999)
42 I %I="" S %I=%W W %I
43 I %I'?1N.N G EXIT:%I="^Q",F1:%I="^" W !,*7,"Response must be positive numeric" G F2
44 S %W=+%I,%L=%W-18-63,%CMT=""
45 G:%L'>0 START
46CMT ;
47 R !,"Enter comment for page header : ",%CMT:$G(DTIME,999)
48 G F2:%CMT="^",CMT1:%CMT'="?"
49 W !,"The comment will be displayed with the UCI, date, and time on each page header."
50 G CMT
51 ;
52CMT1 ;
53 I $L(%CMT)>%L W !,*7,"Too long. Maximum comment length is ",%L G CMT
54START ;
55 D INT^%T,INT^%D
56 D FORMAT
57 U %DEV
58 ;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
59 ;W !!
60 ;I %DEV<20!(%DEV>63) U %DEV:%W
61 ;U 0
62 I ZIBOS["Cache" W @IOF
63 I %DEV<20!(%DEV>63),ZIBOS["MSM" U %DEV:%W
64 U $P
65 ;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
66 W !!,"Done. "
67EXIT ;
68 ;U 0 ;IHS/SET/GTH XB*3*9 10/29/2002
69 ;I '$D(QUIT),%DEV'=$I,+%DEV S IO=%DEV D ^%ZISC ;IHS/SET/GTH XB*3*9 10/29/2002
70 I '$D(QUIT),%DEV'=$I S IO=%DEV D ^%ZISC ;IHS/SET/GTH XB*3*9 10/29/2002
71 KILL %DEV,%LPP,%W,%I,%J,%CMT,%TIM,%TIM1,%DAT,%DAT1,%PG,%PGG,%RN,%L,%R,%X,%,%BLK,QUIT
72 Q
73 ;
74ERR ;EP - If error, from error trap.
75 I $F($$Z^ZIBNSSV("ERROR"),"<INRPT>") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2
76 ZQ
77 ;
78FORMAT ;
79 S %PG=1,%PGG=1
80 W !!,"Printing ...",!
81F3 ;
82 ;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
83 ;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"
84 ;U %DEV
85 ;I %DEV<20!(%DEV>63) U %DEV:%W
86 ;S %RN=""
87 ;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
88 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"
89 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"
90 U %DEV
91 I ZIBOS["MSM" D
92 . I %DEV<20!(%DEV>63) U %DEV:%W
93 . S %RN=""
94 . 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
95 I ZIBOS["Cache" D
96 . S %RN=0
97 . 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
98 ;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
99 Q
100 ;
101F4 ;
102 X %X
103 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 !,"".........."""
104 Q
105 ;
Note: See TracBrowser for help on using the repository browser.