source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOEDT6.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1OCXOEDT6 ;SLC/RJS,CLA - Edit Site's Local Terms ;5/27/99 16:52
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 N OCXERR,OCXR,DIE,DIC,DR,X,Y,OCXD0,OCXREC,IOP,IOF,OCXEDIT
8 ;
9 I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP
10 ;
11 S (OCXEDIT,OCXERR)=0 F W @IOF,!! D LIST Q:$$EDIT($$LOOKUP)
12 D:OCXEDIT QUE
13 ;
14 Q
15 ;
16LOOKUP() N DIC,X,Y S DIC("A")="Select National Term: ",DIC="^OCXS(860.9,",DIC(0)="AEQM" D ^DIC Q:(Y<0) 0 Q +Y
17 ;
18QUE ;
19 D QUE^OCXOCMPV(30)
20 W !!,"Expert system compiler queued to run in 30 seconds."
21 W !,"You will be sent a Mailman bulletin when it has finished.",!!
22 H 3
23 Q
24 ;
25LIST ;
26 N OCXD0,OCXCNT
27 W !,?10,"Order Check National Terms",!
28 S (OCXCNT,OCXD0)=0 F S OCXD0=$O(^OCXS(860.9,OCXD0)) Q:'OCXD0 D Q:(OCXCNT>9)
29 .S OCXNAME=$P($G(^OCXS(860.9,OCXD0,0)),U,1) Q:'$L(OCXNAME)
30 .S OCXCNT=OCXCNT+1
31 .W !,?5,OCXNAME
32 I OCXD0 W !!,?5," < Enter ?? to see the rest of the national terms on this list>"
33 W !
34 Q
35 ;
36EDIT(OCXD0) ;
37 ;
38 Q:'OCXD0 1
39 ;
40 N OCXF,OCXFN,OCXD1,OCXD2,DA,OCXCNT,OCXX,OCXQUIT,OCXSCR
41 ;
42 F D Q:OCXQUIT
43 .;
44 .S OCXQUIT=0 D CONV(OCXD0)
45 .;
46 .S OCXF=+$P(^OCXS(860.9,OCXD0,0),U,2)
47 .S OCXSCR=$G(^OCXS(860.9,OCXD0,2))
48 .W @IOF,!!,"National Term: ",$P(^OCXS(860.9,OCXD0,0),U,1)
49 .I 'OCXF W !!," Database Error: Pointed to file not specified." S OCXD1=$$PAUSE,OCXQUIT=1 Q
50 .S OCXFN=$$FILE^OCXBDTD(OCXF,"NAME")
51 .I '$L(OCXFN) W !!," Database Error: Pointed to file (",OCXF,") does not exist." S OCXD1=$$PAUSE,OCXQUIT=1 Q
52 .;
53 .W !!," Translated from file: '",OCXFN,"' ",+OCXF
54 .;
55 .W !
56 .S OCXCNT=0,OCXD1="" F S OCXD1=$O(^OCXS(860.9,OCXD0,1,"B",OCXD1)) Q:'$L(OCXD1) D Q:OCXQUIT
57 ..S OCXD2="" F S OCXD2=$O(^OCXS(860.9,OCXD0,1,"B",OCXD1,OCXD2)) Q:'OCXD2 D Q:OCXQUIT
58 ...W !,?5,$P(^OCXS(860.9,OCXD0,1,OCXD2,0),U,1)," (",OCXD2,")"
59 ...S OCXCNT=OCXCNT+1 I '(OCXCNT#10) S OCXQUIT=($$PAUSE*10)
60 .;
61 .Q:OCXQUIT
62 .;
63 .W ! S OCXD1=$$DIC(OCXF,$G(OCXSCR)) S OCXQUIT=(OCXD1<1) Q:OCXQUIT
64 .;
65 .I $D(^OCXS(860.9,OCXD0,1,+OCXD1,0)) D Q
66 ..I $$READ("Y","Do you want remove '"_$P(^OCXS(860.9,OCXD0,1,+OCXD1,0),U,1)_" ("_(+OCXD1)_")' from the list ","NO") K ^OCXS(860.9,OCXD0,1,+OCXD1) W " removed..." S OCXEDIT=1 H 2 Q
67 ..W " not removed..." H 2 Q
68 .;
69 .S ^OCXS(860.9,OCXD0,1,0)="^860.91IA^^"
70 .S ^OCXS(860.9,OCXD0,1,+OCXD1,0)=$P(OCXD1,U,2)_U_(+OCXD1)
71 .S OCXEDIT=1
72 ;
73 Q (OCXQUIT>1)
74 ;
75DIC(OCXDIC,OCXDICS) ;
76 ;
77 ;
78 N X,Y,DIC,OCXDEL
79 S DIC=+OCXDIC Q:'$G(DIC) 0
80 S DIC(0)="AMNEQ",DIC("W")="W ""("",Y,"")"""
81 S:$L($G(OCXDICS)) DIC("S")=$G(OCXDICS)
82 D ^DIC
83 Q:(+Y<1) 0 Q Y
84 ;
85CONV(OCXD0) ;
86 ;
87 N OCXREC1,OCXREC2,OCXF,OCXF0
88 K OCXREC1,OCXREC2
89 M OCXREC1=^OCXS(860.9,OCXD0)
90 ;
91 S OCXF=+$P(OCXREC1(0),U,2) Q:'OCXF
92 ;
93 K OCXREC1(1,"B"),OCXREC1(1,"C")
94 S OCXD1=0 F S OCXD1=$O(OCXREC1(1,OCXD1)) Q:'OCXD1 D
95 .N OCXNAME,OCXPTR
96 .S OCXPTR=+$P($G(OCXREC1(1,OCXD1,0)),U,2)
97 .I 'OCXPTR K OCXREC1(1,OCXD1) Q
98 .S OCXNAME=$$PTR(OCXF,+OCXPTR)
99 .K OCXREC1(1,OCXD1)
100 .Q:'$L(OCXNAME)
101 .S OCXREC1(1,OCXD1,0)=OCXNAME_U_OCXPTR
102 .S OCXREC1(1,"C",OCXPTR,OCXD1)=""
103 ;
104 S OCXREC2(0)=OCXREC1(0)
105 S:$L($G(OCXREC1(2))) OCXREC2(2)=OCXREC1(2)
106 I $D(OCXREC1(1,0)) D
107 .N OCXD1,OCXD2,OCXD3,OCXX
108 .S OCXREC2(1,0)=$P(OCXREC1(1,0),U,1,2)
109 .S OCXD1=0 F S OCXD1=$O(OCXREC1(1,"C",OCXD1)) Q:'OCXD1 D
110 ..S OCXD2=0 F S OCXD2=$O(OCXREC1(1,"C",OCXD1,OCXD2)) Q:'OCXD2 D
111 ...Q:'$D(OCXREC1(1,OCXD2,0))
112 ...N OCXT,OCXP
113 ...S OCXT=$P(OCXREC1(1,OCXD2,0),U,1)
114 ...S OCXP=$P(OCXREC1(1,OCXD2,0),U,2)
115 ...S OCXREC2(1,OCXP,0)=OCXT_U_OCXP
116 ...S OCXREC2(1,"B",OCXT,OCXP)=""
117 ...S OCXREC2(1,"C",OCXP,OCXP)=""
118 ...S OCXREC2(1,0)="^860.91IA^"_OCXP_U_($P($G(OCXREC2(1,0)),U,4)+1)
119 ;
120 K ^OCXS(860.9,OCXD0) M ^OCXS(860.9,OCXD0)=OCXREC2
121 ;
122 Q
123 ;
124PTR(FILE,D0) ;
125 ;
126 Q:'FILE ""
127 Q:'D0 ""
128 N REF,NAME
129 S REF=$$FILE^OCXBDTD(+FILE,"GLOBAL NAME") Q:'$L(REF) ""
130 X "S NAME=$P($G("_REF_D0_",0)),U,1)"
131 Q NAME
132 ;
133PAUSE() N X W !!," Press <enter> to continue... " R X:DTIME W ! Q ((X[U)*10)
134 ;
135READ(OCX0,OCXA,OCXB,OCXL) ;
136 N X,DIR,DTOUT,DUOUT,DIRUT,DIROUT
137 Q:'$L($G(OCX0)) U
138 S DIR(0)=OCX0
139 S:$L($G(OCXA)) DIR("A")=OCXA
140 S:$L($G(OCXB)) DIR("B")=OCXB
141 F X=1:1:($G(OCXL)-1) W !
142 D ^DIR
143 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
144 Q Y
145 ;
Note: See TracBrowser for help on using the repository browser.