OCXBDT3 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Build Routines) ;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
;
EN() ;
;
N LAST,RLINE,RNUM,RTEXT,TOTLINE
K ^TMP("OCXBDT",$J,"RTN") S ^TMP("OCXBDT",$J,"RTN",100,0)=" ;"
S (TOTLINE,RSIZE,RLINE,RCNT)=0,RNUM=1 F S RLINE=$O(^TMP("OCXBDT",$J,RLINE)) Q:'RLINE D
.S RTEXT=$G(^TMP("OCXBDT",$J,RLINE)) Q:'$L(RTEXT)
.S LAST=$O(^TMP("OCXBDT",$J,"RTN",""),-1)+1,RCNT=RCNT+1,RSIZE=RSIZE+$L(RTEXT)
.S ^TMP("OCXBDT",$J,"RTN",LAST,0)=" ;;"_RTEXT
.I (RSIZE>4000) S TOTLINE=TOTLINE+$$RFILE($O(^TMP("OCXBDT",$J,RLINE)),.RNUM) S (RSIZE,RCNT)=0
I $O(^TMP("OCXBDT",$J,"RTN",100)) S TOTLINE=TOTLINE+$$RFILE(0,.RNUM)
;
Q TOTLINE
;
RFILE(LINK,RNUM) ;
;
N DIE,LAST,X,XCN,XCM
D HDR(LINK,RNUM)
S LAST=$O(^TMP("OCXBDT",$J,"RTN",""),-1)+1
S ^TMP("OCXBDT",$J,"RTN",LAST,0)=" ;1;"
S ^TMP("OCXBDT",$J,"RTN",LAST+1,0)=" ;"
S ^TMP("OCXBDT",$J,"RTN",LAST+2,0)="$"
S DIE="^TMP(""OCXBDT"","_$J_",""RTN"",",XCN=0
S X=$$RNAME(RNUM)
W !,X
X ^%ZOSF("SAVE")
W " ... ",XCM," Lines filed"
S RNUM=RNUM+1
K ^TMP("OCXBDT",$J,"RTN") S ^TMP("OCXBDT",$J,"RTN",100,0)=" ;"
Q XCM
;
NOW() ;
N X,Y,%DT
S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXBDTD(Y)
I (Y["@") S Y=$P(Y,"@",1)_" at "_$P(Y,"@",2)
Q Y
;
HDR(LINK,RNUM) ;
;
N R,LINE,TEXT,RNAME,RLINK,NOW
S NOW=$$NOW
I 'LINK S RLINK=";"
E S RLINK="G ^"_$$RNAME(RNUM+1)
S RNAME=$$RNAME(RNUM),(HEADER1,HEADER2,HEADER3,HEADER4,HEADER5)=";"
;
F LINE=1:1:999 S TEXT=$P($T(TEXT+LINE),";",2,999) Q:TEXT S TEXT=$P(TEXT,";",2,999) S R(LINE,0)=$$CONV(TEXT)
;
M ^TMP("OCXBDT",$J,"RTN")=R
;
Q
;
HEX(X) Q:'X "" Q $$HEX(X\36)_$E("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",((X#36)+1))
;
RNAME(X) Q:'X "" S X=$$HEX(X) Q "OCXDI"_$E("000",$L(X),2)_X
;
CONV(X) ;
F Q:'(X["|") S X=$P(X,"|",1)_(@$P(X,"|",2))_$P(X,"|",3,999)
I '(X="$"),'$L($P(X," ",2)) S X=X_" ;"
Q X
;
TEXT ;
;;|RNAME| ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC ROUTINES ;|NOW|
;;|OCXLIN2|
;;|OCXLIN3|
;; ;
;;S ;
;; ;
;; D DOT^OCXDIAG
;; ;
;; ;
;; K REMOTE,LOCAL,OPCODE,REF
;; F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT
;; .S ^TMP("OCXDIAG",$J,$O(^TMP("OCXDIAG",$J,"A"),-1)+1)=TEXT
;; ;
;; |RLINK|
;; ;
;; Q
;; ;
;;DATA ;
;1;
;
OCXBDT3 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Build Routines) ;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 ;
EN() ;
+1 ;
+2 NEW LAST,RLINE,RNUM,RTEXT,TOTLINE
+3 KILL ^TMP("OCXBDT",$JOB,"RTN")
SET ^TMP("OCXBDT",$JOB,"RTN",100,0)=" ;"
+4 SET (TOTLINE,RSIZE,RLINE,RCNT)=0
SET RNUM=1
FOR
SET RLINE=$ORDER(^TMP("OCXBDT",$JOB,RLINE))
IF 'RLINE
QUIT
Begin DoDot:1
+5 SET RTEXT=$GET(^TMP("OCXBDT",$JOB,RLINE))
IF '$LENGTH(RTEXT)
QUIT
+6 SET LAST=$ORDER(^TMP("OCXBDT",$JOB,"RTN",""),-1)+1
SET RCNT=RCNT+1
SET RSIZE=RSIZE+$LENGTH(RTEXT)
+7 SET ^TMP("OCXBDT",$JOB,"RTN",LAST,0)=" ;;"_RTEXT
+8 IF (RSIZE>4000)
SET TOTLINE=TOTLINE+$$RFILE($ORDER(^TMP("OCXBDT",$JOB,RLINE)),.RNUM)
SET (RSIZE,RCNT)=0
End DoDot:1
+9 IF $ORDER(^TMP("OCXBDT",$JOB,"RTN",100))
SET TOTLINE=TOTLINE+$$RFILE(0,.RNUM)
+10 ;
+11 QUIT TOTLINE
+12 ;
RFILE(LINK,RNUM) ;
+1 ;
+2 NEW DIE,LAST,X,XCN,XCM
+3 DO HDR(LINK,RNUM)
+4 SET LAST=$ORDER(^TMP("OCXBDT",$JOB,"RTN",""),-1)+1
+5 SET ^TMP("OCXBDT",$JOB,"RTN",LAST,0)=" ;1;"
+6 SET ^TMP("OCXBDT",$JOB,"RTN",LAST+1,0)=" ;"
+7 SET ^TMP("OCXBDT",$JOB,"RTN",LAST+2,0)="$"
+8 SET DIE="^TMP(""OCXBDT"","_$JOB_",""RTN"","
SET XCN=0
+9 SET X=$$RNAME(RNUM)
+10 WRITE !,X
+11 XECUTE ^%ZOSF("SAVE")
+12 WRITE " ... ",XCM," Lines filed"
+13 SET RNUM=RNUM+1
+14 KILL ^TMP("OCXBDT",$JOB,"RTN")
SET ^TMP("OCXBDT",$JOB,"RTN",100,0)=" ;"
+15 QUIT XCM
+16 ;
NOW() ;
+1 NEW X,Y,%DT
+2 SET X="N"
SET %DT="T"
DO ^%DT
SET Y=$$DATE^OCXBDTD(Y)
+3 IF (Y["@")
SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)
+4 QUIT Y
+5 ;
HDR(LINK,RNUM) ;
+1 ;
+2 NEW R,LINE,TEXT,RNAME,RLINK,NOW
+3 SET NOW=$$NOW
+4 IF 'LINK
SET RLINK=";"
+5 IF '$TEST
SET RLINK="G ^"_$$RNAME(RNUM+1)
+6 SET RNAME=$$RNAME(RNUM)
SET (HEADER1,HEADER2,HEADER3,HEADER4,HEADER5)=";"
+7 ;
+8 FOR LINE=1:1:999
SET TEXT=$PIECE($TEXT(TEXT+LINE),";",2,999)
IF TEXT
QUIT
SET TEXT=$PIECE(TEXT,";",2,999)
SET R(LINE,0)=$$CONV(TEXT)
+9 ;
+10 MERGE ^TMP("OCXBDT",$JOB,"RTN")=R
+11 ;
+12 QUIT
+13 ;
HEX(X) IF 'X
QUIT ""
QUIT $$HEX(X\36)_$EXTRACT("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",((X#36)+1))
+1 ;
RNAME(X) IF 'X
QUIT ""
SET X=$$HEX(X)
QUIT "OCXDI"_$EXTRACT("000",$LENGTH(X),2)_X
+1 ;
CONV(X) ;
+1 FOR
IF '(X["|")
QUIT
SET X=$PIECE(X,"|",1)_(@$PIECE(X,"|",2))_$PIECE(X,"|",3,999)
+2 IF '(X="$")
IF '$LENGTH($PIECE(X," ",2))
SET X=X_" ;"
+3 QUIT X
+4 ;
TEXT ;
+1 ;;|RNAME| ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC ROUTINES ;|NOW|
+2 ;;|OCXLIN2|
+3 ;;|OCXLIN3|
+4 ;; ;
+5 ;;S ;
+6 ;; ;
+7 ;; D DOT^OCXDIAG
+8 ;; ;
+9 ;; ;
+10 ;; K REMOTE,LOCAL,OPCODE,REF
+11 ;; F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT
+12 ;; .S ^TMP("OCXDIAG",$J,$O(^TMP("OCXDIAG",$J,"A"),-1)+1)=TEXT
+13 ;; ;
+14 ;; |RLINK|
+15 ;; ;
+16 ;; Q
+17 ;; ;
+18 ;;DATA ;
+19 ;1;
+20 ;
