- 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 Feb 18, 2025@23:53:01 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 ;