| 1 | OCXBDT3 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Build Routines) ;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 | EN() ;
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  N LAST,RLINE,RNUM,RTEXT,TOTLINE
 | 
|---|
| 8 |  K ^TMP("OCXBDT",$J,"RTN") S ^TMP("OCXBDT",$J,"RTN",100,0)=" ;"
 | 
|---|
| 9 |  S (TOTLINE,RSIZE,RLINE,RCNT)=0,RNUM=1 F  S RLINE=$O(^TMP("OCXBDT",$J,RLINE)) Q:'RLINE  D
 | 
|---|
| 10 |  .S RTEXT=$G(^TMP("OCXBDT",$J,RLINE)) Q:'$L(RTEXT)
 | 
|---|
| 11 |  .S LAST=$O(^TMP("OCXBDT",$J,"RTN",""),-1)+1,RCNT=RCNT+1,RSIZE=RSIZE+$L(RTEXT)
 | 
|---|
| 12 |  .S ^TMP("OCXBDT",$J,"RTN",LAST,0)=" ;;"_RTEXT
 | 
|---|
| 13 |  .I (RSIZE>4000) S TOTLINE=TOTLINE+$$RFILE($O(^TMP("OCXBDT",$J,RLINE)),.RNUM) S (RSIZE,RCNT)=0
 | 
|---|
| 14 |  I $O(^TMP("OCXBDT",$J,"RTN",100)) S TOTLINE=TOTLINE+$$RFILE(0,.RNUM)
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 |  Q TOTLINE
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 | RFILE(LINK,RNUM) ;
 | 
|---|
| 19 |  ;
 | 
|---|
| 20 |  N DIE,LAST,X,XCN,XCM
 | 
|---|
| 21 |  D HDR(LINK,RNUM)
 | 
|---|
| 22 |  S LAST=$O(^TMP("OCXBDT",$J,"RTN",""),-1)+1
 | 
|---|
| 23 |  S ^TMP("OCXBDT",$J,"RTN",LAST,0)=" ;1;"
 | 
|---|
| 24 |  S ^TMP("OCXBDT",$J,"RTN",LAST+1,0)=" ;"
 | 
|---|
| 25 |  S ^TMP("OCXBDT",$J,"RTN",LAST+2,0)="$"
 | 
|---|
| 26 |  S DIE="^TMP(""OCXBDT"","_$J_",""RTN"",",XCN=0
 | 
|---|
| 27 |  S X=$$RNAME(RNUM)
 | 
|---|
| 28 |  W !,X
 | 
|---|
| 29 |  X ^%ZOSF("SAVE")
 | 
|---|
| 30 |  W "  ... ",XCM," Lines filed"
 | 
|---|
| 31 |  S RNUM=RNUM+1
 | 
|---|
| 32 |  K ^TMP("OCXBDT",$J,"RTN") S ^TMP("OCXBDT",$J,"RTN",100,0)=" ;"
 | 
|---|
| 33 |  Q XCM
 | 
|---|
| 34 |  ;
 | 
|---|
| 35 | NOW() ;
 | 
|---|
| 36 |  N X,Y,%DT
 | 
|---|
| 37 |  S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXBDTD(Y)
 | 
|---|
| 38 |  I (Y["@") S Y=$P(Y,"@",1)_" at "_$P(Y,"@",2)
 | 
|---|
| 39 |  Q Y
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 | HDR(LINK,RNUM) ;
 | 
|---|
| 42 |  ;
 | 
|---|
| 43 |  N R,LINE,TEXT,RNAME,RLINK,NOW
 | 
|---|
| 44 |  S NOW=$$NOW
 | 
|---|
| 45 |  I 'LINK S RLINK=";"
 | 
|---|
| 46 |  E  S RLINK="G ^"_$$RNAME(RNUM+1)
 | 
|---|
| 47 |  S RNAME=$$RNAME(RNUM),(HEADER1,HEADER2,HEADER3,HEADER4,HEADER5)=";"
 | 
|---|
| 48 |  ;
 | 
|---|
| 49 |  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)
 | 
|---|
| 50 |  ;
 | 
|---|
| 51 |  M ^TMP("OCXBDT",$J,"RTN")=R
 | 
|---|
| 52 |  ;
 | 
|---|
| 53 |  Q
 | 
|---|
| 54 |  ;
 | 
|---|
| 55 | HEX(X) Q:'X "" Q $$HEX(X\36)_$E("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",((X#36)+1))
 | 
|---|
| 56 |  ;
 | 
|---|
| 57 | RNAME(X) Q:'X "" S X=$$HEX(X) Q "OCXDI"_$E("000",$L(X),2)_X
 | 
|---|
| 58 |  ;
 | 
|---|
| 59 | CONV(X) ;
 | 
|---|
| 60 |  F  Q:'(X["|")  S X=$P(X,"|",1)_(@$P(X,"|",2))_$P(X,"|",3,999)
 | 
|---|
| 61 |  I '(X="$"),'$L($P(X," ",2)) S X=X_" ;"
 | 
|---|
| 62 |  Q X
 | 
|---|
| 63 |  ;
 | 
|---|
| 64 | TEXT ;
 | 
|---|
| 65 |  ;;|RNAME| ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC ROUTINES ;|NOW|
 | 
|---|
| 66 |  ;;|OCXLIN2|
 | 
|---|
| 67 |  ;;|OCXLIN3|
 | 
|---|
| 68 |  ;; ;
 | 
|---|
| 69 |  ;;S ;
 | 
|---|
| 70 |  ;; ;
 | 
|---|
| 71 |  ;; D DOT^OCXDIAG
 | 
|---|
| 72 |  ;; ;
 | 
|---|
| 73 |  ;; ;
 | 
|---|
| 74 |  ;; K REMOTE,LOCAL,OPCODE,REF
 | 
|---|
| 75 |  ;; F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D  Q:QUIT
 | 
|---|
| 76 |  ;; .S ^TMP("OCXDIAG",$J,$O(^TMP("OCXDIAG",$J,"A"),-1)+1)=TEXT
 | 
|---|
| 77 |  ;; ;
 | 
|---|
| 78 |  ;; |RLINK|
 | 
|---|
| 79 |  ;; ;
 | 
|---|
| 80 |  ;; Q
 | 
|---|
| 81 |  ;; ;
 | 
|---|
| 82 |  ;;DATA ;
 | 
|---|
| 83 |  ;1;
 | 
|---|
| 84 |  ;
 | 
|---|