source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXSEND4.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1OCXSEND4 ;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 ;
5EN() ;
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 ;
18TEXT ;
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 ;
Note: See TracBrowser for help on using the repository browser.