source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXSEND.m@ 1297

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

revised back to 6/30/08 version

File size: 4.0 KB
Line 
1OCXSEND ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES ;2/01/01 10:10
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,74,96,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 N X,IOP,TOTL S TOTL=0
7 N CVER,RCNT,RSIZE,LASTFILE,HEADER1,HEADER2,HEADER3,HEADER4,HEADER5
8 N OCXASK,OCXID,OCXLIN2,OCXLIN3,OCXPATCH,OCXSCR,PARM,PARMV,DIE,DIERR,DIQ2,FCPARM,TEXT
9 I '$D(IOM) S IOP=0 D ^%ZIS K IOP
10 K ^TMP("OCXSEND",$J),^UTILITY($J),OCXPATH
11 K ^UTILITY($J),OCXPATH
12 S ^TMP("OCXSEND",$J)=($P($H,",",2)+($H*86400)+(4*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
13 S OCXLIN2=$T(+2)
14 S OCXLIN3=$T(+3)
15 ;
16 D ^OCXSEND1 ; Get List of Objects to Transport
17 ;
18 I '$O(^TMP("OCXSEND",$J,"LIST",0)) K ^TMP("OCXSEND",$J) Q ; Nothing selected so Quit
19 ;
20 S OCXASK="" F D Q:$L(OCXASK)
21 .W !
22 .W !,"When the transport routine encounters locally"
23 .W !,"altered rule data at a site, do you want to:"
24 .;
25 .S OCXASK=$$READ("S^O:Overwrite local data;D:Display locally altered data only;A:Ask the site what to do","(O)verwrite, (D)isplay, or (A)sk the site ? ","Ask")
26 ;
27 Q:(OCXASK[U)
28 I (OCXASK="O") W !!,"Locally altered data will be overwritten without asking.",!!
29 I (OCXASK="D") W !!,"Locally altered data will be displayed only.",!!
30 I (OCXASK="A") W !!,"Sites will be asked before locally altered data is overwritten.",!!
31 ;
32 S OCXPATCH="" F D Q:$L(OCXPATCH)
33 .W !!,"Enter Patch ID (ex. OR*3*96): " R OCXPATCH:DTIME E S OCXPATCH="^" Q
34 .Q:(OCXPATCH="^")
35 .I '$L(OCXPATCH) S OCXPATCH="^^" Q
36 .I $L(OCXPATCH),'(OCXPATCH?1"OR*"1N1"*"1.4N) D S OCXPATCH="" Q
37 ..W !!
38 ..W:'(OCXPATCH["?") "Invalid"
39 ..W " Format -> OR*v*ppp"
40 ..W !," v = Package Version."
41 ..W !," ppp = Patch Number."
42 ..W !
43 Q:(OCXPATCH="^")
44 S:(OCXPATCH="^^") OCXPATCH=""
45 I $P(OCXPATCH,"*",3) S $P(OCXLIN2,";",5)="**"_$P(OCXPATCH,"*",3)_"**"
46 I $L(OCXPATCH) S OCXPATCH="(Delete after Install of "_OCXPATCH_")"
47 ;
48 Q:'$$RSDEL
49 ;
50 D ^OCXSEND2 ; Get File Data
51 ;
52 S TOTL=$$EN^OCXSEND3 ; File Routines
53 ;
54 S TOTL=TOTL+$$EN^OCXSENDA ; File Main Runtime Library Routine
55 ;
56 S TOTL=TOTL+$$EN^OCXSEND4 ; File Utility Runtime Library Routine 0
57 ;
58 S TOTL=TOTL+$$EN^OCXSEND5 ; File Utility Runtime Library Routine 1
59 ;
60 S TOTL=TOTL+$$EN^OCXSEND6 ; File Utility Runtime Library Routine 2
61 ;
62 S TOTL=TOTL+$$EN^OCXSEND7 ; File Utility Runtime Library Routine 3
63 ;
64 S TOTL=TOTL+$$EN^OCXSEND8 ; File Utility Runtime Library Routine 4
65 ;
66EXIT K ^TMP("OCXSEND",$J),^UTILITY($J)
67 ;
68 W !!,TOTL," total lines of code filed.",!!
69 ;
70 Q
71 ;
72READ(OCX0,OCXA,OCXB,OCXL) ;
73 N X,DIR,DTOUT,DUOUT,DIRUT,DIROUT
74 Q:'$L($G(OCX0)) U
75 S DIR(0)=OCX0
76 S:$L($G(OCXA)) DIR("A")=OCXA
77 S:$L($G(OCXB)) DIR("B")=OCXB
78 F X=1:1:($G(OCXL)-1) W !
79 D ^DIR
80 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
81 Q Y
82 ;
83CUCI() Q:'$D(^%ZOSF("UCI")) "" N Y X ^%ZOSF("UCI") Q Y
84 ;
85NETNAME() ;
86 Q:$L($G(^XMB("NETNAME"))) ^XMB("NETNAME")
87 Q:$L($G(^XMB("NAME"))) ^XMB("NAME")
88 Q $$CUCI
89 ;
90RSDEL() ;
91 ;
92 W !!,"Scanning for old rule transport routines..."
93 N X,CNT,RCNT,RLIST,RNAME
94 S RCNT=0
95 ;
96 ; Scan for Routines To Delete
97 ;
98 ; Main Routine
99 S RNAME=$$RNAME^OCXSEND3(0,0) I $$RFIND(RNAME,100) S RLIST(RNAME)=""
100 ;
101 ; Runtime Library routines
102 F CNT=0:1:35 S RNAME=$$RNAME^OCXSEND3(CNT,1) I $$RFIND(RNAME,CNT) S RLIST(RNAME)=""
103 ;
104 ; Data Routines
105 F CNT=0:1:46655 S RNAME=$$RNAME^OCXSEND3(CNT,2) I $$RFIND(RNAME,CNT) S RLIST(RNAME)=""
106 ;
107 I '$L($O(RLIST(""))) W !,"No old rule transport routines found..." H 2 Q 1
108 ;
109 W !!,"These routines will be deleted and overwritten."
110 Q:'$$READ("Y"," Do you want to proceed?","NO") 0
111 ;
112 ; Delete The routines
113 ;
114 I '$D(^%ZOSF("DEL")) W !!,"Old rule transport routines not deleted (^%ZOSF(""DEL"") undefined)" Q 0
115 ;
116 S RNAME="" F RCNT=1:1 S RNAME=$O(RLIST(RNAME)) Q:'$L(RNAME) D
117 .W !,RNAME
118 .I $$RDEL(RNAME) W " Deleted..." Q
119 .W " Not Deleted..."
120 ;
121 W !!,RCNT," routine",$S((RCNT=1):"",1:"s")," deleted."
122 ;
123 H 2 Q 1
124 ;
125RFIND(X,C) ;
126 W:($X>70) ! W:'(C#100) "."
127 Q:'$L(X) 0 X "S TEXT=$T(+1^"_X_")" Q:'$L(TEXT) 0
128 W !,X Q 1
129 Q
130 ;
131RDEL(X) ;
132 ;
133 Q:'$L(X) 0 X "S TEXT=$T(+1^"_X_")" Q:'$L(TEXT) 0
134 X ^%ZOSF("DEL") Q 1
135 ;
Note: See TracBrowser for help on using the repository browser.