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