1 | OCXBDT1 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Routine Checksums) ;8/04/98 13:21
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
|
---|
3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
---|
4 | ;
|
---|
5 | S ;
|
---|
6 | ;
|
---|
7 | ;
|
---|
8 | N RTN,RTNSET
|
---|
9 | K ^UTILITY($J),OCXPATH
|
---|
10 | S ^TMP("OCXBDT",$J,$O(^TMP("OCXBDT",$J,""),-1)+1)="RSTRT"
|
---|
11 | ;
|
---|
12 | I $D(^%ZOSF("RSEL")) X ^%ZOSF("RSEL") Q:'$D(^UTILITY($J))
|
---|
13 | ;
|
---|
14 | S RTN="A" F S RTN=$O(^UTILITY($J,RTN)) Q:'$L(RTN) W !,RTN,?10,$$CHKSUM(RTN)
|
---|
15 | ;
|
---|
16 | S ^TMP("OCXBDT",$J,$O(^TMP("OCXBDT",$J,""),-1)+1)="REND"
|
---|
17 | ;
|
---|
18 | Q
|
---|
19 | ;
|
---|
20 | TEST(R) N X X "S X=''$L($T(^"_R_"))" Q X
|
---|
21 | ;
|
---|
22 | CHKSUM(RTN) ; ;
|
---|
23 | ;
|
---|
24 | N LINE,CHAR,CSUM,SIZE,TEXT,DATE,RSUM,X,LAST
|
---|
25 | ;
|
---|
26 | I '$$TEST(RTN) Q "Routine not found"
|
---|
27 | I ($E(RTN,1,5)="OCXOZ") Q "Compiled routine not checked"
|
---|
28 | I ($E(RTN,1,5)="OCXDI") Q $$RDEL(RTN)
|
---|
29 | ;
|
---|
30 | S DATE=$P($$TEXT(RTN,1),";",3)
|
---|
31 | S LAST=$O(^TMP("OCXBDT",$J,""),-1)+1,^TMP("OCXBDT",$J,LAST)="RTN"_U_RTN_U_DATE
|
---|
32 | S RSUM="RSUM",SIZE=$L($$TEXT(RTN,1))+$L($$TEXT(RTN,2))
|
---|
33 | ;
|
---|
34 | F LINE=4:1:999 S TEXT=$$TEXT(RTN,LINE) Q:'$L(TEXT) D
|
---|
35 | .S CSUM=0,SIZE=SIZE+$L(TEXT)
|
---|
36 | .F CHAR=1:1:$L(TEXT) S CSUM=CSUM+($A(TEXT,CHAR)*CHAR)
|
---|
37 | .I ($L(RSUM)>200) S LAST=$O(^TMP("OCXBDT",$J,""),-1)+1,^TMP("OCXBDT",$J,LAST)=RSUM,RSUM="RSUM"
|
---|
38 | .S RSUM=RSUM_U_(+(CSUM_"."_$L(TEXT)_"1"))
|
---|
39 | ;
|
---|
40 | I $P(RSUM,U,2) S LAST=$O(^TMP("OCXBDT",$J,""),-1)+1,^TMP("OCXBDT",$J,LAST)=RSUM
|
---|
41 | S LAST=$O(^TMP("OCXBDT",$J,""),-1)+1,^TMP("OCXBDT",$J,LAST)="RND"_U_RTN_U_DATE
|
---|
42 | ;
|
---|
43 | I (SIZE>8000) W *7
|
---|
44 | ;
|
---|
45 | Q $J(SIZE,6)_" "_DATE_" "_$S((SIZE>8000):"******* Routine too large",1:"")
|
---|
46 | ;
|
---|
47 | TEXT(RTN,LINE) ;
|
---|
48 | ;
|
---|
49 | N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
|
---|
50 | ;
|
---|
51 | RDEL(X) ;
|
---|
52 | ;
|
---|
53 | I '$D(^%ZOSF("DEL")) Q "Routine not deleted (^%ZOSF(""DEL"") undefined)"
|
---|
54 | X ^%ZOSF("DEL")
|
---|
55 | Q "Routine Deleted"
|
---|
56 | ;
|
---|