- 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;
- ;
- 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 ;