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

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 3.8 KB
Line 
1ZIBER ;BFH;MSM ERROR REPORT; [ 07/17/91 12:19 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;COPYRIGHT MICRONETICS DESIGN CORP @1982
4 S $ZT="ERROR^ZIBER",%DEV=$I
5 W !?10,$P($P($ZV,","),"-")," - Error Report Utility"
6 I '$D(^UTILITY("%ER")) W !!,"NO ERRORS HAVE BEEN LOGGED" G EXIT
7 D ^%GUCI K %,%UCN
8 G PACKAGE
9OPT I $D(%AZ("PACKAGE")) K %AZ G PACKAGE
10 U 0 W !!,?5,"1 - Display errors",!,?5,"2 - Print errors",!,?5,"3 - Erase errors",!,?5,"4 - Summarize errors"
11 R !!,"Enter option: ",%X G EXIT:"^Q"=%X!("^"[%X)
12 I %X="?" S %XQF="7,8,9,6,3,4" D QUE^ZIBER1 G OPT
13 I $E("Display",1,$L(%X))=%X W $E("Display",$L(%X)+1,99) S %SUM=0 G DAT
14 I %X=1 W " - Display" S %SUM=0 G DAT
15 I $E("Print",1,$L(%X))=%X W $E("Print",$L(%X)+1,99) G PRINT^ZIBER1
16 I %X=2 W " - Print" G PRINT^ZIBER1
17 I $E("Erase",1,$L(%X))=%X W $E("Erase",$L(%X)+1,99) G DELETE^ZIBER1
18 I %X=3 W " - Erase" G DELETE^ZIBER1
19 I $E("Summarize",1,$L(%X))=%X W $E("Summarize",$L(%X)+1,99) G DAT1
20 I %X=4 W " - Summarize" G DAT1
21 W *7," ..Invalid" G OPT
22 ;
23PACKAGE W ! K DIC S DIC(0)="QEAM",DIC=9.4 D ^DIC G EXIT:Y<1!$D(DTOUT)!$D(DUOUT) S %AZ("PACKAGE")=$P(^DIC(9.4,+Y,0),U,2) D ^%GUCI K %,%UCN G DAT1
24 ;
25DAT S %DIS=1,FLG=0 R !!,"Enter date > ",%X G OPT:"^"[%X,EXIT:%X="^Q",DINFO:%X="?" D DCHK^ZIBER1 G DAT:%QF,NE
26 ;
27DAT1 S %DEL=0,%DIS=0,%SUM=1 ;ENTRY POINT TO SUMMARIZE ERRORS
28 G DAT^ZIBER1
29DINFO S %J=$N(^UTILITY("%ER",-1)) I %J<0 W !!,"No errors have been logged for this UCI" G EXIT
30 W !!,"Errors have been logged for the following days: "
31 F %J=$N(^UTILITY("%ER",-1)):0 Q:%J<0 S %I=%J W "T",$P(",-",",",%I<+$H+1) W:+$H-%I +$H-%I,"," S %J=$N(^(%J))
32 S %XQF="1,2,11" D QUE^ZIBER1 G DAT
33DINFO1 S %J=$N(^UTILITY("%ER",-1)) I %J<0 W !!,"No errors have been logged for this UCI" G EXIT
34 W !!,"Errors have been logged for the following days: "
35 F %J=$N(^UTILITY("%ER",-1)):0 Q:%J<0 S %I=%J W "T",$P(",-",",",%I<+$H+1) W:+$H-%I +$H-%I,"," S %J=$N(^(%J))
36 S %XQF="1,2,11,12,20" D QUE^ZIBER1 G DAT1:%SUM,DAT^ZIBER1
37NE S %NE=$D(^UTILITY("%ER",%DAT,0)) I '%NE D E1 G DAT1:%SUM,DAT
38 S %NE=^(0) D E1
39ERR K %LIST R !!,"Error # > ",%X G DAT:"^"[%X,EXIT:%X="^Q" I %X="^L" G:%NE>0 LIST D E1 G ERR
40 I %X="?" D E1 S %XQF="1,2,14,18" D QUE^ZIBER1 G ERR
41 I %X'?1N.N!(%X>%NE) W *7," ..Invalid" G ERR
42 S %NUM=%X
43 I '$D(^UTILITY("%ER",%DAT,%NUM,0)) W !!,"Error not on file" G ERR
44WRT R !!,"Symbol > ",%X G ERR:"^"[%X,EXIT:%X="^Q",PMODE:%X="^S"
45 I %X="?" S %XQF="1,2,13,10,15,16" D QUE^ZIBER1 G WRT
46 S %FND=1,%Q=0 I %X="^L" S %SYM="" G WF^ZIBER1
47 S %SYM=%X G WF^ZIBER1
48E1 S %A=%NE S:'%A %A="NO" W !,%A," ERROR" W:%A'=1 "S" W " LOGGED ON ",$ZD(%DAT) Q
49E2 W !!,"No errors logged between ",$ZD(%DAT)," and "
50 S %DAT=%D2 W $ZD(%DAT) Q
51EXIT U 0 S $ZT="" C:%DEV'=$I %DEV
52KILL K %A,%B,%CASE,%D,%D1,%D2,%DAT,%DEL,%DEV,%DIS,%DUM,%FND,%I,%J,%K,%L,%M,%LIST,%NE,%NE1,%NUM,%PG,%Q,%QF,%RDTE,%RTME,%SYM,%TAG,%UCI,%SUM,%X,%XQF,%Y,%Z,FLG,X,%AZ Q
53LIST S %LIST=1,%J=0,FLG=0 W ! S $Y=0
54L1 S %J=%J+1 G:%J>%NE ERR
55 I $D(%AZ("PACKAGE")) S %AZ("P")=%J D TMD2^ZIBER1 I '%AZ("PHIT") S %J=%J-1 G L1
56 I $D(^UTILITY("%ER",%DAT,%J,0)) D:$Y>20 NPAGE^ZIBER1 G:FLG=1 ERR W %J,") ",^(0),!! G L1
57LIST1 S %LIST=1,%J=0 W !
58L2 S %J=%J+1 Q:%J>%NE
59 I $D(%AZ("PACKAGE")) S %AZ("P")=%J D TMD2^ZIBER1 I '%AZ("PHIT") S %J=%J-1 G L2
60 I $D(^UTILITY("%ER",%DAT,%J,0)) W %J,") ",^(0),!! G L2
61PMODE S %(1)=%DAT,%(2)=%NUM K (%) F %=$N(^(100)):0 Q:%<0!(%>1E5) D SET S %=$N(^(%))
62 W !!,"Symbols have been set into this partition",!!,"You are exiting this utility" K % W !!,"Error defined as: ",^(0) S $ZT="" S:$D(^(7)) %=$P(^(7),"=",2) I $D(%) I %'="" I $D(@%)
63 K % Q
64SET ;
65 I ^(%)'?1";".E S @($P(^(%),"=",1))=$P(^(%),"=",2,999) Q
66 I $D(^(1E8+99-%))<10 S @($P($E(^(%),2,999),"=",1))=^(1E8+99-%) Q
67 S %(3)="" F %(4)=1:1 Q:'$D(^UTILITY("%ER",%(1),%(2),1E8+99-%,%(4))) S %(3)=%(3)_^(%(4))
68 S @($P($E(^UTILITY("%ER",%(1),%(2),%),2,999),"=",1))=%(3)
69 Q
70ERROR U 0
71 I $F($ZE,"<INRPT>") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2
72 ZQ
Note: See TracBrowser for help on using the repository browser.