source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXSEND1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1OCXSEND1 ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Get List of Objects to Transport) ;2/01/01 09:06
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 N OCXFILE,OCXD0
8 ;
9 F S OCXFILE=$$GETFILE Q:'OCXFILE I (OCXFILE>1) F D ADDON Q:'$$GETREC(OCXFILE)
10 ;
11 Q
12 ;
13GETREC(OCXFILE) ;
14 ;
15 N OCXDIAG,OCXD0,OCXD1,OCXX,OCXADD,OCXSCR
16 S OCXDIAG="Select an"_$S($O(^TMP("OCXSEND",$J,"LIST",+OCXFILE,0)):"other",1:"")
17 S OCXDIAG=OCXDIAG_" "_$P(OCXFILE,U,2)_": "
18 S OCXID="I $D(^TMP(""OCXSEND"",$J,"_(+OCXFILE)_",""B"",$P(^(0),U,1))) W "" ***** Already selected for transport. *****"""
19 S:(+OCXFILE=860.8) OCXID="W:$L($P(^(0),U,2)) ?35,""$$"",$P(^(0),U,2),""() "" "_OCXID
20 S OCXSCR=""
21 W !!,OCXDIAG R OCXX:DTIME E W " <timeout>",$C(7) Q 0
22 Q:(OCXX[U) 0 Q:'$L(OCXX) 0
23 S OCXADD=1 I ($E(OCXX,1)="-") S OCXX=$E(OCXX,2,$L(OCXX)),OCXADD=0
24 ;
25 I (OCXX="?") D
26 .I '$O(^TMP("OCXSEND",$J,"LIST",+OCXFILE,0)) W !!,"None Selected for transport"
27 .E W !!,"Already selected for transport:" D
28 ..S OCXD0="" F S OCXD0=$O(^TMP("OCXSEND",$J,"LIST",+OCXFILE,"B",OCXD0)) Q:'$L(OCXD0) D
29 ...W !,?5,OCXD0
30 ...I (+OCXFILE=860.8) D
31 ....S OCXD1=$O(^TMP("OCXSEND",$J,"LIST",+OCXFILE,"B",OCXD0,0)) Q:'OCXD1
32 ....W:$L($P($G(^OCXS(860.8,+OCXD1,0)),U,2)) " $$",$P($G(^OCXS(860.8,+OCXD1,0)),U,2),"()"
33 .W !!,"Press <Enter> to continue..." R OCXD0:DTIME E Q
34 .S OCXSCR="I '$D(^TMP(""OCXSEND"",$J,"_(+OCXFILE)_",""B"",$P(^(0),U,1)))"
35 .S OCXX="??"
36 ;
37 I (OCXX["*") D Q 1
38 .N OCXPAT,OCXCNT,OCXLEN,OCXNAME
39 .S OCXPAT=""
40 .F Q:(OCXX'["**") S OCXX=$P(OCXX,"**",1)_"*"_$P(OCXX,"**",2,999)
41 .S OCXLEN=$L(OCXX,"*")
42 .F OCXCNT=1:1:OCXLEN D
43 ..S:$L($P(OCXX,"*",1)) OCXPAT=OCXPAT_"1"""_$P(OCXX,"*",1)_""""
44 ..S:(OCXX["*") OCXPAT=OCXPAT_".E"
45 ..S OCXX=$P(OCXX,"*",2,999)
46 .S OCXD0=0 F S OCXD0=$O(^OCXS(+OCXFILE,OCXD0)) Q:'OCXD0 D
47 ..S OCXNAME=$P($G(^OCXS(+OCXFILE,OCXD0,0)),U,1)
48 ..X "I OCXNAME?"_OCXPAT E Q
49 ..I OCXADD D ADDREC(+OCXFILE,OCXD0)
50 ..I 'OCXADD D DELREC(+OCXFILE,OCXD0)
51 ;
52 S OCXD0=$$DIC(+OCXFILE,"EMQ",OCXDIAG,OCXX,OCXSCR,OCXID)
53 I OCXD0 H 1 D
54 .I OCXADD D ADDREC(OCXFILE,OCXD0)
55 .I 'OCXADD D DELREC(OCXFILE,OCXD0)
56 ;
57 Q 1
58 ;
59ADDON ;
60 ;
61 I $O(^TMP("OCXSEND",$J,"LIST",0)) D
62 .S OCXD0=0 F S OCXD0=$O(^OCXS(860.9,OCXD0)) Q:'OCXD0 D
63 ..I $D(^OCXS(860.9,OCXD0,0)) D CHECK^OCXSENDB(860.9,OCXD0)
64 .D CHECK^OCXSENDB(860.8,"FILE")
65 .D CHECK^OCXSENDB(860.8,"GETDATA")
66 .D CHECK^OCXSENDB(860.8,"DT2INT")
67 .D CHECK^OCXSENDB(860.8,"INT2DT")
68 .D CHECK^OCXSENDB(860.8,"LIST")
69 .D CHECK^OCXSENDB(860.8,"CLIST")
70 .D CHECK^OCXSENDB(860.8,"EQTERM")
71 .D CHECK^OCXSENDB(860.8,"NEWRULE")
72 .D CHECK^OCXSENDB(860.8,"POINTER")
73 .D CHECK^OCXSENDB(860.4,"PATIENT IEN")
74 ;
75 Q
76 ;
77ADDREC(FILE,REC) ;
78 ;
79 N LLAB
80 S FILE=+FILE,REC=+REC
81 Q:'$D(^OCXS(FILE,REC))
82 Q:$D(^TMP("OCXSEND",$J,"LIST",FILE,REC))
83 S ^TMP("OCXSEND",$J,"LIST",FILE,REC)=$P($G(^OCXS(FILE,REC,0)),U,1)
84 S ^TMP("OCXSEND",$J,"LIST",FILE,"B",$P($G(^OCXS(FILE,REC,0)),U,1),REC)=""
85 W !,$P(^OCXS(FILE,0),U,1)," --> ",$P($G(^OCXS(FILE,REC,0)),U,1)," added to list."
86 ;
87 S LLAB=$TR(FILE,".","")_"^OCXSENDB"
88 X "I $L($T("_LLAB_"))" E Q
89 D @LLAB
90 Q
91 ;
92DELREC(FILE,REC) ;
93 ;
94 N OCXNAME
95 S OCXNAME=$G(^TMP("OCXSEND",$J,"LIST",+FILE,+REC)) Q:'$L(OCXNAME)
96 K ^TMP("OCXSEND",$J,"LIST",+FILE,+REC)
97 K ^TMP("OCXSEND",$J,"LIST",+FILE,"B",OCXNAME,+REC)
98 W !,OCXNAME," removed from list."
99 Q
100 ;
101GETFILE() ;
102 ;
103 N OCXDIAG,OCXD0,OCXX,OCXADD
104 S OCXDIAG="Select a"_$S($O(^TMP("OCXSEND",$J,"LIST",0)):"nother",1:"")_" File: "
105 S OCXSCR="I $D(^OCXS(+$P(^(0),U,2),0)),$O(^OCXS(+$P(^(0),U,2),0))"
106 S OCXID="N OCXCNT S OCXCNT=$$CNT^OCXSEND1(+$P(^(0),U,2)) I OCXCNT W ?50,$J(OCXCNT,5),"" selected for transport."""
107 W !!,OCXDIAG R OCXX:DTIME E W " <timeout>",$C(7) Q 0
108 Q:(OCXX[U) 0 Q:'$L(OCXX) 0
109 ;
110 I (OCXX="?") S OCXX="??"
111 ;
112 S OCXD0=$$DIC(1,"EMQ",OCXDIAG,OCXX,OCXSCR,OCXID)
113 ;
114 Q:OCXD0 OCXD0 Q:$L(OCXX) 1 Q 0
115 ;
116CNT(OCXFILE) ;
117 ;
118 N CNT,OCXD0
119 S OCXD0=0 F CNT=0:1 S OCXD0=$O(^TMP("OCXSEND",$J,"LIST",OCXFILE,OCXD0)) Q:'OCXD0
120 Q CNT
121 ;
122DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXW) ;
123 ;
124 N DIC,X,Y
125 S DIC=$G(OCXDIC) Q:'$L(DIC) -1
126 S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
127 S:$L($G(OCXDICS)) DIC("S")=OCXDICS
128 S:$L($G(OCXDICA)) DIC("A")=OCXDICA
129 S:$L($G(OCXW)) DIC("W")=OCXW
130 D ^DIC Q:(Y<1) 0 Q Y
131 ;
Note: See TracBrowser for help on using the repository browser.