source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSUE.m@ 1154

Last change on this file since 1154 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1BPSOSUE ;BHAM ISC/FCS/DRS/FLS - impossible errors ;06/01/2004
2 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
3 Q
4 ;
5 ; Deal with impossible errors (errors which should never occur,
6 ; and which weren't already trapped by M).
7 ;
8IMPOSS(UETYPE,UEOPT,UEMSG,UEMSG2,UELOC,UEROU,UENOLOG) ;EP - deal with impossible errors - called from many places
9 ; $$IMPOSS^BPSOSUE(UETYPE,UEOPT,UEMSG,UELOC,UEROU)
10 ; UETYPE = kinds of problems which may have occured
11 ; ["FM" a Fileman call has returned an error
12 ; ["L" a LOCK with ample time has failed
13 ; ["DB" a database error (some missing/incorrect field)
14 ; ["P" a programming error / some unexpected condition
15 ; ["DEV" some kind of device or file error
16 ; UEOPT = options available; first one listed is the default
17 ; Defaults to "TRI"
18 ; ["R" retry - retry the operation; log err
19 ; ["I" ignore - continue as though operation had succeeded; log err
20 ; ["T" abort - log err and terminate
21 ; UEMSG = optionally, an additional message to output
22 ; can be .MSG, and we'll walk the array for you.
23 ; UEMSG2 = even more message, like UEMSG. In a Fileman call failure,
24 ; you'd probably send .FDA,.MSG
25 ; UELOC = location, any number or name unique to the calling routine
26 ; UEROU = the name of the calling routine
27 ; UENOLOG = true if you do not want error log entry to be made
28 ;
29 ; $$ returns 1 to retry, 0 to ignore
30 ;
31 ; Caller may do with these values what he desires.
32 ;
33 ; To prevent excessive errors, we won't actually log an error if
34 ; another one has been logged recently.
35 ;
36 ; This routine really isn't as important as it looks. In fact,
37 ; it will almost never be encountered in practice. Its existence
38 ; owes mostly to an outrageous ruling made in the name of,
39 ; but contrary to, the very quality and maintainability that forced
40 ; errors give you. This in turn led to a significant delay
41 ; in the release of a product which has been proven to be dependable
42 ; in practice.
43 ;
44 ; Formerly, a zero/zero forced error was found at various places
45 ; in the code. In 13 months at ANMC, 11 months at Sitka,
46 ; and several months at Pawhuska, Wewoka, Santa Fe, and Taos, the
47 ; zero div by zero traps were never encountered, but over $3,000,000
48 ; in revenues were collected. The ironic thing is,
49 ; without those extra checking, of things like Fileman return values,
50 ; sanity checks on input values, etc., the product would have been
51 ; less reliable, yet it would have sailed through the verifiction
52 ; phase of the project plan.
53 ;
54 ; Forced errors already pervade all of the M language. <UNDEF> is
55 ; a forced error, for example. And forced errors are an integral part
56 ; of the design of the very hardware that runs these programs.
57 ; Follow the anti-forced error policy to its logical end and you
58 ; go to Intersleaze and say "stop issuing <UNDEF> and instead,
59 ; prompt the user for the opportunity to continue" and then you go
60 ; to Intel and say "remove the addressing exception trap from your
61 ; microcode; our support organization wouldn't be able to cope with
62 ; the problem report on something like that."
63 ;
64 I $G(UEOPT)="" S UEOPT="TRI"
65 I $G(ZTQUEUED) S UECHOICE=$E(UEOPT) G QD
66 D:'$D(IOF) HOME^%ZIS ; make sure screen vars there
67 U IO
68 I '$D(IORVON) N IORVON,IORVOFF D
69 . N X S X="IORVON;IORVOFF" D ENDR^%ZISS
70 W !!,IORVON
71 W "An unexpected problem has been detected; notify programmer!"
72 I $D(UELOC)!$D(UEROU) D
73 . W !?5,"The problem occurred "
74 . I $D(UELOC) W "at location ",UELOC," " W:$X>60 !
75 . I $D(UEROU) W "in routine ",UEROU
76 . W ".",!
77 W !?5,"The likely source" W:UETYPE["," "s"
78 W " of such a problem " W $S(UETYPE[",":"are",1:"is"),":",!!?5
79 I UETYPE["FM" D
80 . W "Fileman has reported an error to the program.",!?5
81 I UETYPE["L" D
82 . W "An interlock could not be obtained.",!?5
83 I UETYPE["DB" D
84 . W "An inconsistency in the database was detected.",!?5
85 I UETYPE["DEV" D
86 . W "An error condition trying to open a device or a file.",!?5
87 I UETYPE["P" D
88 . W "A condition the program was unprepared to handle",!?5
89 . W "or perhaps an error in the program logic.",!?5
90 W !,"A programmer should be notified of this unfortunate event.",!
91 D MSG(.UEMSG),MSG(.UEMSG2)
92 W IORVOFF,!!
93 ;
94 N UECHOICE S UECHOICE=$$CHOICE ; Present the options; get I, R, T
95QD ;
96 D LOGERR ; always log an error (unless too soon after prev. error)
97 I UECHOICE="T" G HALT
98 ;LJE;H $R(10)+1 ; could help various things (locks, database conditions)
99 H 2
100 Q:$Q $S(UECHOICE="I":0,UECHOICE="R":1) Q
101 ;
102MSG(X) ; display message, directly or in array
103 I '$D(X) W "X is undefined",! Q
104 I $D(X)#10 W X,!
105 I $D(X)>9 D
106 . N R S R="X" F S R=$Q(@R) Q:R="" W @R,!
107 W !
108 Q
109 ;
110CHOICE() ; given UEOPT[letters, UETYPE too
111 I UEOPT="" S UEOPT="T"
112 N DIR,X,Y
113 I $L(UEOPT)=1 S X=UEOPT G CH5
114 S DIR(0)="SM^",X=""
115 I UEOPT["I" S X=X_"I:Ignore the problem and try to continue"
116 I UEOPT["R" S:X]"" X=X_";" S X=X_"R:Retry the operation"
117 I UEOPT["T" S:X]"" X=X_";" S X=X_"T:Terminate the program"
118 I UETYPE'="L" S X=X_" (WE RECOMMEND ""T"")"
119 S DIR(0)=DIR(0)_X
120 S DIR("B")=$E(UEOPT) D ^DIR
121CH5 Q $S(X?1U:X,1:"T")
122 ;
123LOGERR ; log an error
124 ; ^TMP($J,$T(+0),$J)=DUZ^$H last time we did this
125 N X S X=$G(^TMP($J,$T(+0),$J))
126 I $P(X,U)'=DUZ G LOG2
127 S X=$P(X,U,2) I +$H'=+X G LOG2
128 S X=$P(X,",",2) I $P($H,",",2)-X>300 G LOG2
129 I '$G(ZTQUEUED) D
130 . W !,"No additional error log entry will be made at this time.",!
131 Q
132LOG2 ;
133 Q:$G(UENOLOG) ; requested: no error log entry
134 I '$G(ZTQUEUED) D
135 . W !,"Now recording some error log information to help the programmer...",!
136 D @^%ZOSF("ERRTN") ; trap an error
137 S ^TMP($J,$T(+0),$J)=DUZ_U_$H
138 I '$D(ZTQUEUED) D
139 . W ?10,"..." H 2 W "done.",!
140 Q
141HALT ; halt
142 D H^XUS
143 ; at this point, the user is logged off
144 ; programmer shouldn't reach here, either, if HALT^ZU disinstackifies
145 Q "" ; <DPARM> error gets you back into programmer mode
146TEST ;
147 N MYEXMSG,I F I=1:1:4 S MYEXMSG(I)="my extra msg line "_I
148 N X S X=$$IMPOSS^BPSOSUE("P","TIR","Additional Message",.MYEXMSG,"point 1","MYROU")
149 W !,"returned value = ",X,!
150 Q
Note: See TracBrowser for help on using the repository browser.