OCXSEND4 ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Build Library Routine 0) ;2/01/01 09:56
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,96,105,243**;Dec 17,1997;Build 242
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
EN() ;
;
N R,LINE,TEXT,NOW,RUCI
S NOW=$$NOW^OCXSEND3,RUCI=$$NETNAME^OCXSEND
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^OCXSEND3(TEXT)
;
M ^TMP("OCXSEND",$J,"RTN")=R
;
S DIE="^TMP(""OCXSEND"","_$J_",""RTN"",",XCN=0,X=$$RNAME^OCXSEND3(0,1)
W !,X X ^%ZOSF("SAVE") K ^TMP("OCXSEND",$J,"RTN")
;
Q " "
;
TEXT ;
;;|$$RNAME^OCXSEND3(0,1)| ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE |OCXPATCH| ;|NOW|
;;|OCXLIN2|
;;|OCXLIN3|
;; ;
;;S ;
;; ;
;; Q
;; ;
;;WARN(RTN,MSG,LINES) ;
;; ;
;; Q:$G(OCXAUTO)
;; ;
;; N DASH,LINE,NLINE,PLINE
;; ;
;; S DASH="",$P(DASH,"-",(55-$L(MSG)-2))="-"
;; W !!,"--------------",MSG,DASH
;; ;
;; W !,RTN,?10,"[|RUCI|] -> [",$$NETNAME^OCXSEND,"] Line"
;; ;
;; I $O(LINES($O(LINES(0)))) W "s: "
;; E W ": "
;; ;
;; S LINE=0 F S LINE=$O(LINES(LINE)) Q:'LINE D
;; .W:($X>60) !,?40
;; .S NLINE=LINE F S PLINE=NLINE,NLINE=$O(LINES(NLINE)) Q:(NLINE-PLINE-1)
;; .I (PLINE=LINE) W " ",LINE
;; .E W " ",LINE,"-",PLINE S LINE=PLINE
;; ;
;; W ! Q
;; ;
;;TEXT(RTN,LINE) ;
;; ;
;; N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
;; ;
;;HEADER ;
;; ;
;; W !," Created: |NOW| at |RUCI|"
;; W !," Current Date: ",$$NOW," at ",$$NETNAME^OCXSEND,!!
;; S LASTFILE=0 K ^TMP("OCXRULE",$J)
;; S ^TMP("OCXRULE",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
;; Q
;; ;
;;GETFILE(FILE,RECNAME,ARRAY) ;
;; ;
;; N CHECK,GLNEXT,GLREF,LINES,REC,DD,FLD
;; S REC=$$LOOKUP(FILE,RECNAME)
;; I 'REC W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME Q 0
;; I (REC=-1) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME," duplicate local entries.",! Q 0
;; I (REC=-2) W !!,$$FILENAME^OCXSENDD(FILE)," (",FILE,") local file not found." W ! Q:$$PAUSE -10 Q REC
;; I (REC<0) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME," unknown lookup error." W ! Q:$$PAUSE -10 Q REC
;; I (REC>0) D
;; .S CHECK=0,LINES=0
;; .D GETREC($$FILE^OCXSENDD(FILE,"GLOBAL NAME"),"ARRAY(",REC,.ARRAY)
;; .S GLREF="ARRAY" F S GLREF=$Q(@GLREF) Q:'$L(GLREF) Q:'($E(GLREF,1,6)="ARRAY(") K:'$L(@GLREF) @GLREF
;; ;
;; Q REC
;; ;
;;LKUPARRY(DD,KEY,ARRAY) ;
;; ;
;; N D0 S D0=0 F S D0=$O(ARRAY(DD,D0)) Q:'D0 Q:($G(ARRAY(DD,D0,.01,"E"))=KEY)
;; Q D0
;; ;
;;LOOKUP(FILE,KEY) ;
;; I $O(^TMP("OCXRULE",$J,"B",FILE,KEY,0)) Q 0
;; N RECNAM,REC,D0,CNT,SHORT S (REC,CNT)=0
;; S GL=$$FILE^OCXSENDD(FILE,"GLOBAL NAME") Q:'$L(GL) -2 S GL=$E(GL,1,$L(GL)-1)_")"
;; S SHORT=$E(KEY,1,30),RECNAM=SHORT D F S RECNAM=$O(@GL@("B",RECNAM)) Q:'$L(RECNAM) Q:'($E(RECNAM,1,$L(SHORT))=SHORT) D
;; .S D0=0 F S D0=$O(@GL@("B",RECNAM,D0)) Q:'D0 I ($P($G(@GL@(D0,0)),U,1)=KEY) S CNT=CNT+1,REC=D0_U_RECNAME
;; Q:(CNT>1) -1
;; S:$L($P(REC,U,2)) ^TMP("OCXRULE",$J,"A",FILE,$P(REC,U,2))=""
;; Q +REC
;; ;
;;GETREC(GL,PATH,D0,REM) ;
;; ;
;; Q:'($P($G(@(GL_"0)")),U,2))
;; N S1,DATA,DD
;; S DATA="" D DIQ(GL,D0,.DATA)
;; S DD=$O(DATA(0)) Q:'DD
;; ;
;; I $L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_""""_DD_":"_D0_""""
;; I '$L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_","""_DD_":"_D0_""""
;; M @(PATH_")")=DATA(DD,D0)
;; ;
;; S S1="" F S S1=$O(@(GL_D0_","_$$SUB(S1)_")")) Q:'$L(S1) I ($D(@(GL_D0_","_$$SUB(S1)_")"))>3) D
;; .N D1,GLREF S GLREF=GL_D0_","_$$SUB(S1)_","
;; .S D1=0 F S D1=$O(@(GLREF_D1_")")) Q:'D1 D GETREC(GLREF,PATH,D1,.REM)
;; ;
;; Q
;; ;
;;SUB(X) Q:'(X=+X) """"_X_"""" Q X
;; ;
;;DIQ(DIC,DA,OCXARY) ;
;; N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="EN" D EN^DIQ1
;; Q
;; ;
;;PAUSE() W " Press Enter " R X:DTIME W ! Q (X[U)
;; ;
;;NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXSENDD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
;; ;
;;$
;1;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXSEND4 4076 printed Dec 13, 2024@02:26:29 Page 2
OCXSEND4 ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Build Library Routine 0) ;2/01/01 09:56
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,96,105,243**;Dec 17,1997;Build 242
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
EN() ;
+1 ;
+2 NEW R,LINE,TEXT,NOW,RUCI
+3 SET NOW=$$NOW^OCXSEND3
SET RUCI=$$NETNAME^OCXSEND
+4 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^OCXSEND3(TEXT)
+5 ;
+6 MERGE ^TMP("OCXSEND",$JOB,"RTN")=R
+7 ;
+8 SET DIE="^TMP(""OCXSEND"","_$JOB_",""RTN"","
SET XCN=0
SET X=$$RNAME^OCXSEND3(0,1)
+9 WRITE !,X
XECUTE ^%ZOSF("SAVE")
KILL ^TMP("OCXSEND",$JOB,"RTN")
+10 ;
+11 QUIT " "
+12 ;
TEXT ;
+1 ;;|$$RNAME^OCXSEND3(0,1)| ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE |OCXPATCH| ;|NOW|
+2 ;;|OCXLIN2|
+3 ;;|OCXLIN3|
+4 ;; ;
+5 ;;S ;
+6 ;; ;
+7 ;; Q
+8 ;; ;
+9 ;;WARN(RTN,MSG,LINES) ;
+10 ;; ;
+11 ;; Q:$G(OCXAUTO)
+12 ;; ;
+13 ;; N DASH,LINE,NLINE,PLINE
+14 ;; ;
+15 ;; S DASH="",$P(DASH,"-",(55-$L(MSG)-2))="-"
+16 ;; W !!,"--------------",MSG,DASH
+17 ;; ;
+18 ;; W !,RTN,?10,"[|RUCI|] -> [",$$NETNAME^OCXSEND,"] Line"
+19 ;; ;
+20 ;; I $O(LINES($O(LINES(0)))) W "s: "
+21 ;; E W ": "
+22 ;; ;
+23 ;; S LINE=0 F S LINE=$O(LINES(LINE)) Q:'LINE D
+24 ;; .W:($X>60) !,?40
+25 ;; .S NLINE=LINE F S PLINE=NLINE,NLINE=$O(LINES(NLINE)) Q:(NLINE-PLINE-1)
+26 ;; .I (PLINE=LINE) W " ",LINE
+27 ;; .E W " ",LINE,"-",PLINE S LINE=PLINE
+28 ;; ;
+29 ;; W ! Q
+30 ;; ;
+31 ;;TEXT(RTN,LINE) ;
+32 ;; ;
+33 ;; N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
+34 ;; ;
+35 ;;HEADER ;
+36 ;; ;
+37 ;; W !," Created: |NOW| at |RUCI|"
+38 ;; W !," Current Date: ",$$NOW," at ",$$NETNAME^OCXSEND,!!
+39 ;; S LASTFILE=0 K ^TMP("OCXRULE",$J)
+40 ;; S ^TMP("OCXRULE",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
+41 ;; Q
+42 ;; ;
+43 ;;GETFILE(FILE,RECNAME,ARRAY) ;
+44 ;; ;
+45 ;; N CHECK,GLNEXT,GLREF,LINES,REC,DD,FLD
+46 ;; S REC=$$LOOKUP(FILE,RECNAME)
+47 ;; I 'REC W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME Q 0
+48 ;; I (REC=-1) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME," duplicate local entries.",! Q 0
+49 ;; I (REC=-2) W !!,$$FILENAME^OCXSENDD(FILE)," (",FILE,") local file not found." W ! Q:$$PAUSE -10 Q REC
+50 ;; I (REC<0) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME," unknown lookup error." W ! Q:$$PAUSE -10 Q REC
+51 ;; I (REC>0) D
+52 ;; .S CHECK=0,LINES=0
+53 ;; .D GETREC($$FILE^OCXSENDD(FILE,"GLOBAL NAME"),"ARRAY(",REC,.ARRAY)
+54 ;; .S GLREF="ARRAY" F S GLREF=$Q(@GLREF) Q:'$L(GLREF) Q:'($E(GLREF,1,6)="ARRAY(") K:'$L(@GLREF) @GLREF
+55 ;; ;
+56 ;; Q REC
+57 ;; ;
+58 ;;LKUPARRY(DD,KEY,ARRAY) ;
+59 ;; ;
+60 ;; N D0 S D0=0 F S D0=$O(ARRAY(DD,D0)) Q:'D0 Q:($G(ARRAY(DD,D0,.01,"E"))=KEY)
+61 ;; Q D0
+62 ;; ;
+63 ;;LOOKUP(FILE,KEY) ;
+64 ;; I $O(^TMP("OCXRULE",$J,"B",FILE,KEY,0)) Q 0
+65 ;; N RECNAM,REC,D0,CNT,SHORT S (REC,CNT)=0
+66 ;; S GL=$$FILE^OCXSENDD(FILE,"GLOBAL NAME") Q:'$L(GL) -2 S GL=$E(GL,1,$L(GL)-1)_")"
+67 ;; S SHORT=$E(KEY,1,30),RECNAM=SHORT D F S RECNAM=$O(@GL@("B",RECNAM)) Q:'$L(RECNAM) Q:'($E(RECNAM,1,$L(SHORT))=SHORT) D
+68 ;; .S D0=0 F S D0=$O(@GL@("B",RECNAM,D0)) Q:'D0 I ($P($G(@GL@(D0,0)),U,1)=KEY) S CNT=CNT+1,REC=D0_U_RECNAME
+69 ;; Q:(CNT>1) -1
+70 ;; S:$L($P(REC,U,2)) ^TMP("OCXRULE",$J,"A",FILE,$P(REC,U,2))=""
+71 ;; Q +REC
+72 ;; ;
+73 ;;GETREC(GL,PATH,D0,REM) ;
+74 ;; ;
+75 ;; Q:'($P($G(@(GL_"0)")),U,2))
+76 ;; N S1,DATA,DD
+77 ;; S DATA="" D DIQ(GL,D0,.DATA)
+78 ;; S DD=$O(DATA(0)) Q:'DD
+79 ;; ;
+80 ;; I $L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_""""_DD_":"_D0_""""
+81 ;; I '$L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_","""_DD_":"_D0_""""
+82 ;; M @(PATH_")")=DATA(DD,D0)
+83 ;; ;
+84 ;; S S1="" F S S1=$O(@(GL_D0_","_$$SUB(S1)_")")) Q:'$L(S1) I ($D(@(GL_D0_","_$$SUB(S1)_")"))>3) D
+85 ;; .N D1,GLREF S GLREF=GL_D0_","_$$SUB(S1)_","
+86 ;; .S D1=0 F S D1=$O(@(GLREF_D1_")")) Q:'D1 D GETREC(GLREF,PATH,D1,.REM)
+87 ;; ;
+88 ;; Q
+89 ;; ;
+90 ;;SUB(X) Q:'(X=+X) """"_X_"""" Q X
+91 ;; ;
+92 ;;DIQ(DIC,DA,OCXARY) ;
+93 ;; N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="EN" D EN^DIQ1
+94 ;; Q
+95 ;; ;
+96 ;;PAUSE() W " Press Enter " R X:DTIME W ! Q (X[U)
+97 ;; ;
+98 ;;NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXSENDD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
+99 ;; ;
+100 ;;$
+101 ;1;
+102 ;
