OCXBDT1 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Routine Checksums) ;8/04/98 13:21
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
S ;
;
;
N RTN,RTNSET
K ^UTILITY($J),OCXPATH
S ^TMP("OCXBDT",$J,$O(^TMP("OCXBDT",$J,""),-1)+1)="RSTRT"
;
I $D(^%ZOSF("RSEL")) X ^%ZOSF("RSEL") Q:'$D(^UTILITY($J))
;
S RTN="A" F S RTN=$O(^UTILITY($J,RTN)) Q:'$L(RTN) W !,RTN,?10,$$CHKSUM(RTN)
;
S ^TMP("OCXBDT",$J,$O(^TMP("OCXBDT",$J,""),-1)+1)="REND"
;
Q
;
TEST(R) N X X "S X=''$L($T(^"_R_"))" Q X
;
CHKSUM(RTN) ; ;
;
N LINE,CHAR,CSUM,SIZE,TEXT,DATE,RSUM,X,LAST
;
I '$$TEST(RTN) Q "Routine not found"
I ($E(RTN,1,5)="OCXOZ") Q "Compiled routine not checked"
I ($E(RTN,1,5)="OCXDI") Q $$RDEL(RTN)
;
S DATE=$P($$TEXT(RTN,1),";",3)
S LAST=$O(^TMP("OCXBDT",$J,""),-1)+1,^TMP("OCXBDT",$J,LAST)="RTN"_U_RTN_U_DATE
S RSUM="RSUM",SIZE=$L($$TEXT(RTN,1))+$L($$TEXT(RTN,2))
;
F LINE=4:1:999 S TEXT=$$TEXT(RTN,LINE) Q:'$L(TEXT) D
.S CSUM=0,SIZE=SIZE+$L(TEXT)
.F CHAR=1:1:$L(TEXT) S CSUM=CSUM+($A(TEXT,CHAR)*CHAR)
.I ($L(RSUM)>200) S LAST=$O(^TMP("OCXBDT",$J,""),-1)+1,^TMP("OCXBDT",$J,LAST)=RSUM,RSUM="RSUM"
.S RSUM=RSUM_U_(+(CSUM_"."_$L(TEXT)_"1"))
;
I $P(RSUM,U,2) S LAST=$O(^TMP("OCXBDT",$J,""),-1)+1,^TMP("OCXBDT",$J,LAST)=RSUM
S LAST=$O(^TMP("OCXBDT",$J,""),-1)+1,^TMP("OCXBDT",$J,LAST)="RND"_U_RTN_U_DATE
;
I (SIZE>8000) W *7
;
Q $J(SIZE,6)_" "_DATE_" "_$S((SIZE>8000):"******* Routine too large",1:"")
;
TEXT(RTN,LINE) ;
;
N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
;
RDEL(X) ;
;
I '$D(^%ZOSF("DEL")) Q "Routine not deleted (^%ZOSF(""DEL"") undefined)"
X ^%ZOSF("DEL")
Q "Routine Deleted"
;
OCXBDT1 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Routine Checksums) ;8/04/98 13:21
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
S ;
+1 ;
+2 ;
+3 NEW RTN,RTNSET
+4 KILL ^UTILITY($JOB),OCXPATH
+5 SET ^TMP("OCXBDT",$JOB,$ORDER(^TMP("OCXBDT",$JOB,""),-1)+1)="RSTRT"
+6 ;
+7 IF $DATA(^%ZOSF("RSEL"))
XECUTE ^%ZOSF("RSEL")
IF '$DATA(^UTILITY($JOB))
QUIT
+8 ;
+9 SET RTN="A"
FOR
SET RTN=$ORDER(^UTILITY($JOB,RTN))
IF '$LENGTH(RTN)
QUIT
WRITE !,RTN,?10,$$CHKSUM(RTN)
+10 ;
+11 SET ^TMP("OCXBDT",$JOB,$ORDER(^TMP("OCXBDT",$JOB,""),-1)+1)="REND"
+12 ;
+13 QUIT
+14 ;
TEST(R) NEW X
XECUTE "S X=''$L($T(^"_R_"))"
QUIT X
+1 ;
CHKSUM(RTN) ; ;
+1 ;
+2 NEW LINE,CHAR,CSUM,SIZE,TEXT,DATE,RSUM,X,LAST
+3 ;
+4 IF '$$TEST(RTN)
QUIT "Routine not found"
+5 IF ($EXTRACT(RTN,1,5)="OCXOZ")
QUIT "Compiled routine not checked"
+6 IF ($EXTRACT(RTN,1,5)="OCXDI")
QUIT $$RDEL(RTN)
+7 ;
+8 SET DATE=$PIECE($$TEXT(RTN,1),";",3)
+9 SET LAST=$ORDER(^TMP("OCXBDT",$JOB,""),-1)+1
SET ^TMP("OCXBDT",$JOB,LAST)="RTN"_U_RTN_U_DATE
+10 SET RSUM="RSUM"
SET SIZE=$LENGTH($$TEXT(RTN,1))+$LENGTH($$TEXT(RTN,2))
+11 ;
+12 FOR LINE=4:1:999
SET TEXT=$$TEXT(RTN,LINE)
IF '$LENGTH(TEXT)
QUIT
Begin DoDot:1
+13 SET CSUM=0
SET SIZE=SIZE+$LENGTH(TEXT)
+14 FOR CHAR=1:1:$LENGTH(TEXT)
SET CSUM=CSUM+($ASCII(TEXT,CHAR)*CHAR)
+15 IF ($LENGTH(RSUM)>200)
SET LAST=$ORDER(^TMP("OCXBDT",$JOB,""),-1)+1
SET ^TMP("OCXBDT",$JOB,LAST)=RSUM
SET RSUM="RSUM"
+16 SET RSUM=RSUM_U_(+(CSUM_"."_$LENGTH(TEXT)_"1"))
End DoDot:1
+17 ;
+18 IF $PIECE(RSUM,U,2)
SET LAST=$ORDER(^TMP("OCXBDT",$JOB,""),-1)+1
SET ^TMP("OCXBDT",$JOB,LAST)=RSUM
+19 SET LAST=$ORDER(^TMP("OCXBDT",$JOB,""),-1)+1
SET ^TMP("OCXBDT",$JOB,LAST)="RND"_U_RTN_U_DATE
+20 ;
+21 IF (SIZE>8000)
WRITE *7
+22 ;
+23 QUIT $JUSTIFY(SIZE,6)_" "_DATE_" "_$SELECT((SIZE>8000):"******* Routine too large",1:"")
+24 ;
TEXT(RTN,LINE) ;
+1 ;
+2 NEW TEXT
XECUTE "S TEXT=$T(+"_(+LINE)_"^"_RTN_")"
QUIT TEXT
+3 ;
RDEL(X) ;
+1 ;
+2 IF '$DATA(^%ZOSF("DEL"))
QUIT "Routine not deleted (^%ZOSF(""DEL"") undefined)"
+3 XECUTE ^%ZOSF("DEL")
+4 QUIT "Routine Deleted"
+5 ;
