OCXSEND3 ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Build Routines) ;1/31/01 08:51
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,74,96,105,243**;Dec 17,1997;Build 242
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
EN() ;
;
N LAST,RLINE,RNUM,RTEXT,TOTLINE
K ^TMP("OCXSEND",$J,"RTN") S ^TMP("OCXSEND",$J,"RTN",100,0)=" ;"
S (TOTLINE,RSIZE,RLINE,RCNT)=0,RNUM=1 F S RLINE=$O(^TMP("OCXSEND",$J,"DATA",RLINE)) Q:'RLINE D
.S RTEXT=$G(^TMP("OCXSEND",$J,"DATA",RLINE)) Q:'$L(RTEXT)
.S LAST=$O(^TMP("OCXSEND",$J,"RTN",""),-1)+1,RCNT=RCNT+1,RSIZE=RSIZE+$L(RTEXT)
.S ^TMP("OCXSEND",$J,"RTN",LAST,0)=" ;;"_RTEXT
.I (RSIZE>6000) S TOTLINE=TOTLINE+$$RFILE($O(^TMP("OCXSEND",$J,"DATA",RLINE)),.RNUM) S (RSIZE,RCNT)=0
I $O(^TMP("OCXSEND",$J,"RTN",100)) S TOTLINE=TOTLINE+$$RFILE(0,.RNUM)
;
Q TOTLINE
;
RFILE(LINK,RNUM) ;
;
N DIE,LAST,X,XCN
D HDR(LINK,RNUM)
S LAST=$O(^TMP("OCXSEND",$J,"RTN",""),-1)+1
S ^TMP("OCXSEND",$J,"RTN",LAST,0)=" ;1;"
S ^TMP("OCXSEND",$J,"RTN",LAST+1,0)=" ;"
S ^TMP("OCXSEND",$J,"RTN",LAST+2,0)="$"
S DIE="^TMP(""OCXSEND"","_$J_",""RTN"",",XCN=0
S X=$$RNAME(RNUM,2)
W !,X
X ^%ZOSF("SAVE")
S RNUM=RNUM+1
K ^TMP("OCXSEND",$J,"RTN") S ^TMP("OCXSEND",$J,"RTN",100,0)=" ;"
Q ""
;
NOW() ;
N X,Y,%DT
S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXSENDD(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,2)
S RNAME=$$RNAME(RNUM,2),(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("OCXSEND",$J,"RTN")=R
;
Q
;
HEX(X) Q:'X "" Q $$HEX(X\36)_$E("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",((X#36)+1))
;
RNAME(X,Y) ;
; Y=0 -> Main Routine
; Y=1 -> Runtime Library Routine
; Y=2 -> Data Routine for ORYppp
; Y=3 -> Data Routine for OCXRU
;
N OCXRN1,OCXRN2,OCXSEQ
;
S OCXRN1="OCXRULE",OCXRN2="OCXRU"
S:$L($G(OCXPATCH)) OCXRN2="ORY"_$E((1000+$P(OCXPATCH,"*",3)),2,4),OCXRN1=OCXRN2_"ES"
;
Q:'Y OCXRN1
;
I (Y=1),(X>35) Q ""
I (Y=2),'$L($G(OCXPATCH)) S Y=3
I (Y=2),(X>1295) Q ""
I (Y=3),(X>46655) Q ""
;
S OCXSEQ=0 S:X OCXSEQ=$$HEX(X)
S OCXSEQ="00000"_OCXSEQ
S OCXSEQ=$E(OCXSEQ,($L(OCXSEQ)-Y+1),$L(OCXSEQ))
;
Q OCXRN2_OCXSEQ
;
CONV(X) ;
N VAL
F Q:'(X["|") D
.S VAL=$P(X,"|",2)
.X "S VAL="_VAL
.S X=$P(X,"|",1)_VAL_$P(X,"|",3,999)
I '(X="$"),'$L($P(X," ",2)) S X=X_" ;"
Q X
;
TEXT ;
;;|RNAME| ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE |OCXPATCH| ;|NOW|
;;|OCXLIN2|
;;|OCXLIN3|
;; ;
;;S ;
;; ;
;; D DOT^|$$RNAME^OCXSEND3(0,0)|
;; ;
;; ;
;; 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("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
;; ;
;; |RLINK|
;; ;
;; Q
;; ;
;;DATA ;
;1;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXSEND3 3000 printed Dec 13, 2024@02:26:28 Page 2
OCXSEND3 ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Build Routines) ;1/31/01 08:51
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,74,96,105,243**;Dec 17,1997;Build 242
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
EN() ;
+1 ;
+2 NEW LAST,RLINE,RNUM,RTEXT,TOTLINE
+3 KILL ^TMP("OCXSEND",$JOB,"RTN")
SET ^TMP("OCXSEND",$JOB,"RTN",100,0)=" ;"
+4 SET (TOTLINE,RSIZE,RLINE,RCNT)=0
SET RNUM=1
FOR
SET RLINE=$ORDER(^TMP("OCXSEND",$JOB,"DATA",RLINE))
if 'RLINE
QUIT
Begin DoDot:1
+5 SET RTEXT=$GET(^TMP("OCXSEND",$JOB,"DATA",RLINE))
if '$LENGTH(RTEXT)
QUIT
+6 SET LAST=$ORDER(^TMP("OCXSEND",$JOB,"RTN",""),-1)+1
SET RCNT=RCNT+1
SET RSIZE=RSIZE+$LENGTH(RTEXT)
+7 SET ^TMP("OCXSEND",$JOB,"RTN",LAST,0)=" ;;"_RTEXT
+8 IF (RSIZE>6000)
SET TOTLINE=TOTLINE+$$RFILE($ORDER(^TMP("OCXSEND",$JOB,"DATA",RLINE)),.RNUM)
SET (RSIZE,RCNT)=0
End DoDot:1
+9 IF $ORDER(^TMP("OCXSEND",$JOB,"RTN",100))
SET TOTLINE=TOTLINE+$$RFILE(0,.RNUM)
+10 ;
+11 QUIT TOTLINE
+12 ;
RFILE(LINK,RNUM) ;
+1 ;
+2 NEW DIE,LAST,X,XCN
+3 DO HDR(LINK,RNUM)
+4 SET LAST=$ORDER(^TMP("OCXSEND",$JOB,"RTN",""),-1)+1
+5 SET ^TMP("OCXSEND",$JOB,"RTN",LAST,0)=" ;1;"
+6 SET ^TMP("OCXSEND",$JOB,"RTN",LAST+1,0)=" ;"
+7 SET ^TMP("OCXSEND",$JOB,"RTN",LAST+2,0)="$"
+8 SET DIE="^TMP(""OCXSEND"","_$JOB_",""RTN"","
SET XCN=0
+9 SET X=$$RNAME(RNUM,2)
+10 WRITE !,X
+11 XECUTE ^%ZOSF("SAVE")
+12 SET RNUM=RNUM+1
+13 KILL ^TMP("OCXSEND",$JOB,"RTN")
SET ^TMP("OCXSEND",$JOB,"RTN",100,0)=" ;"
+14 QUIT ""
+15 ;
NOW() ;
+1 NEW X,Y,%DT
+2 SET X="N"
SET %DT="T"
DO ^%DT
SET Y=$$DATE^OCXSENDD(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,2)
+6 SET RNAME=$$RNAME(RNUM,2)
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("OCXSEND",$JOB,"RTN")=R
+11 ;
+12 QUIT
+13 ;
HEX(X) if 'X
QUIT ""
QUIT $$HEX(X\36)_$EXTRACT("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",((X#36)+1))
+1 ;
RNAME(X,Y) ;
+1 ; Y=0 -> Main Routine
+2 ; Y=1 -> Runtime Library Routine
+3 ; Y=2 -> Data Routine for ORYppp
+4 ; Y=3 -> Data Routine for OCXRU
+5 ;
+6 NEW OCXRN1,OCXRN2,OCXSEQ
+7 ;
+8 SET OCXRN1="OCXRULE"
SET OCXRN2="OCXRU"
+9 if $LENGTH($GET(OCXPATCH))
SET OCXRN2="ORY"_$EXTRACT((1000+$PIECE(OCXPATCH,"*",3)),2,4)
SET OCXRN1=OCXRN2_"ES"
+10 ;
+11 if 'Y
QUIT OCXRN1
+12 ;
+13 IF (Y=1)
IF (X>35)
QUIT ""
+14 IF (Y=2)
IF '$LENGTH($GET(OCXPATCH))
SET Y=3
+15 IF (Y=2)
IF (X>1295)
QUIT ""
+16 IF (Y=3)
IF (X>46655)
QUIT ""
+17 ;
+18 SET OCXSEQ=0
if X
SET OCXSEQ=$$HEX(X)
+19 SET OCXSEQ="00000"_OCXSEQ
+20 SET OCXSEQ=$EXTRACT(OCXSEQ,($LENGTH(OCXSEQ)-Y+1),$LENGTH(OCXSEQ))
+21 ;
+22 QUIT OCXRN2_OCXSEQ
+23 ;
CONV(X) ;
+1 NEW VAL
+2 FOR
if '(X["|")
QUIT
Begin DoDot:1
+3 SET VAL=$PIECE(X,"|",2)
+4 XECUTE "S VAL="_VAL
+5 SET X=$PIECE(X,"|",1)_VAL_$PIECE(X,"|",3,999)
End DoDot:1
+6 IF '(X="$")
IF '$LENGTH($PIECE(X," ",2))
SET X=X_" ;"
+7 QUIT X
+8 ;
TEXT ;
+1 ;;|RNAME| ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE |OCXPATCH| ;|NOW|
+2 ;;|OCXLIN2|
+3 ;;|OCXLIN3|
+4 ;; ;
+5 ;;S ;
+6 ;; ;
+7 ;; D DOT^|$$RNAME^OCXSEND3(0,0)|
+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("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
+13 ;; ;
+14 ;; |RLINK|
+15 ;; ;
+16 ;; Q
+17 ;; ;
+18 ;;DATA ;
+19 ;1;
+20 ;
