source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY2430.m@ 1375

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

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1ORY2430 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*243) ;NOV 2,2006 at 12:05
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17,1997;Build 242
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 Q
8 ;
9WARN(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,"[CPRS27.FO-SLC.MED.VA.GOV] -> [",$$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 ;
31TEXT(RTN,LINE) ;
32 ;
33 N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
34 ;
35HEADER ;
36 ;
37 W !," Created: NOV 2,2006 at 12:05 at CPRS27.FO-SLC.MED.VA.GOV"
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 ;
43GETFILE(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 ;
58LKUPARRY(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 ;
63LOOKUP(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 ;
73GETREC(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 ;
90SUB(X) Q:'(X=+X) """"_X_"""" Q X
91 ;
92DIQ(DIC,DA,OCXARY) ;
93 N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="EN" D EN^DIQ1
94 Q
95 ;
96PAUSE() W " Press Enter " R X:DTIME W ! Q (X[U)
97 ;
98NOW() 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 ;
Note: See TracBrowser for help on using the repository browser.