| 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 |  ;
 | 
|---|