source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXODSP1.m@ 861

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

initial load of WorldVistAEHR
File size: 4.5 KB
Line 
1OCXODSP1 ;SLC/RJS,CLA - Rule Display (Display a Rule) ;3/26/01 15:03
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5EN(OCXD0,OCXTAB,OCXRM) ;
6 ;
7 N OCXD1,OCXD,OCXRD,OCXE,OCXSUB
8 ;
9 S OCXTAB=+$G(OCXTAB) S:'$G(OCXD0) OCXD0=+$$DIC("^OCXS(860.2,","AEMQ") Q:'OCXD0
10 ;
11 S OCXRD="" D DIQ("^OCXS(860.2,",OCXD0,.OCXRD)
12 F OCXSUB="C","R" S OCXD1=0 F S OCXD1=$O(^OCXS(860.2,OCXD0,OCXSUB,OCXD1)) Q:'OCXD1 D
13 .S OCXD(0)=OCXD0,OCXD=OCXD1 D DIQ("^OCXS(860.2,"_OCXD0_","""_OCXSUB_""",",.OCXD,.OCXRD)
14 ;
15 W !
16 W ! D FIELD("Rule:",$G(OCXRD(860.2,OCXD0,.01,"E"))_" ("_$G(OCXRD(860.2,OCXD0,.02,"E"),"ACTIVE")_" Status)",OCXTAB,OCXRM)
17 ;
18 S OCXD1=0 F S OCXD1=$O(OCXRD(860.21,OCXD1)) Q:'OCXD1 D
19 .N OUTSTR,OCXE
20 .W !
21 .W ! D FIELD("Rule Element Label:",$G(OCXRD(860.21,OCXD1,.01,"E")),OCXTAB,OCXRM)
22 .I $G(OCXRD(860.21,OCXD1,.02,"I")) D Q
23 ..W ! D FIELD(" Expression:",$G(OCXRD(860.21,OCXD1,2,"E")),OCXTAB,OCXRM)
24 ..I ($G(OCXRD(860.21,OCXD1,2,"E"))["|") D
25 ...N PTR,EXPVAL,DFLD
26 ...S EXPVAL=$G(OCXRD(860.21,OCXD1,2,"E")) F PTR=2:2:$L(EXPVAL,"|") S DFLD=$P(EXPVAL,"|",PTR) D GETDF(DFLD)
27 .;
28 .S OUTSTR=$G(OCXRD(860.21,OCXD1,1,"E"))
29 .W ! D FIELD(" Element:",OUTSTR,OCXTAB,OCXRM)
30 .S OCXE=+$G(OCXRD(860.21,OCXD1,1,"I")) I +OCXE D EN^OCXODSP2(OCXE,OCXTAB+OCXOFF,OCXRM)
31 ;
32 S OCXD1=0 F S OCXD1=$O(OCXRD(860.22,OCXD1)) Q:'OCXD1 D
33 .N EXPVAL,DFLD,PTR S DFLD=""
34 .W !
35 .W ! D FIELD("Relation Expression:",$G(OCXRD(860.22,OCXD1,1,"E")),OCXTAB,OCXRM)
36 .I $D(OCXRD(860.22,OCXD1,2,"E")) W ! D FIELD(" Order Check:",$G(OCXRD(860.22,OCXD1,2,"E")),OCXTAB,OCXRM)
37 .I $D(OCXRD(860.22,OCXD1,3,"E")) W ! D FIELD(" Notification:",$G(OCXRD(860.22,OCXD1,3,"E")),OCXTAB,OCXRM)
38 .I $D(OCXRD(860.22,OCXD1,4,"E")) W ! D FIELD(" Report Device:",$G(OCXRD(860.22,OCXD1,4,"E")),OCXTAB,OCXRM)
39 .I $D(OCXRD(860.22,OCXD1,5,"E")) W ! D FIELD(" Notification Message:",$G(OCXRD(860.22,OCXD1,5,"E")),OCXTAB,OCXRM)
40 .I $D(OCXRD(860.22,OCXD1,6,"E")) W ! D FIELD(" Order Check Message:",$G(OCXRD(860.22,OCXD1,6,"E")),OCXTAB,OCXRM)
41 .I $D(OCXRD(860.22,OCXD1,7,"E")) W ! D FIELD(" Schedule Action:",$G(OCXRD(860.22,OCXD1,7,"E")),OCXTAB,OCXRM)
42 .I $D(OCXRD(860.22,OCXD1,8,"E")) W ! D FIELD(" Schedule Frequency:",$G(OCXRD(860.22,OCXD1,8,"E")),OCXTAB,OCXRM)
43 .I $D(OCXRD(860.22,OCXD1,9,"E")) W ! D FIELD(" Execute Code:",$G(OCXRD(860.22,OCXD1,9,"E")),OCXTAB,OCXRM)
44 .I ($G(OCXRD(860.22,OCXD1,5,"E"))["|") S EXPVAL=$G(OCXRD(860.22,OCXD1,5,"E")) F PTR=2:2:$L(EXPVAL,"|") S DFLD=$P(EXPVAL,"|",PTR) S:$L(DFLD) DFLD(DFLD)=""
45 .I ($G(OCXRD(860.22,OCXD1,6,"E"))["|") S EXPVAL=$G(OCXRD(860.22,OCXD1,6,"E")) F PTR=2:2:$L(EXPVAL,"|") S DFLD=$P(EXPVAL,"|",PTR) S:$L(DFLD) DFLD(DFLD)=""
46 .S DFLD="" F S DFLD=$O(DFLD(DFLD)) Q:'$L(DFLD) D GETDF(DFLD)
47 ;
48 Q
49 ;
50 ;
51GETDF(DFLD) ;
52 ;
53 N DFLDN,DCONT,DELEM,DELEMN
54 I (DFLD[".") D Q
55 .S DELEM=$P(DFLD,".",1),DFLD=$P(DFLD,".",2)
56 .S DFLDN=$O(^OCXS(860.4,"C",DFLD,0))
57 .I 'DFLDN S DFLDN=0 F S DFLDN=$O(^OCXS(860.4,"B",$E(DFLD,1,30),DFLDN)) Q:'DFLDN Q:($P(^OCXS(860.4,DFLDN,0),U,1)=DFLD)
58 .S DELEMN=0 F S DELEMN=$O(OCXRD(860.21,DELEMN)) Q:'DELEMN Q:(OCXRD(860.21,DELEMN,.01,"E")=DELEM)
59 .Q:'DELEMN S DELEM=+$G(OCXRD(860.21,DELEMN,1,"I")) Q:'DELEM
60 .S DCONT=+$P($G(^OCXS(860.3,DELEM,0)),U,2) Q:'DCONT
61 .D EN^OCXODSP3(DFLDN,OCXTAB+OCXOFF,OCXRM,DCONT)
62 ;
63 I '(DFLD[".") D
64 .S DFLDN=$O(^OCXS(860.4,"C",DFLD,0))
65 .I 'DFLDN S DFLDN=0 F S DFLDN=$O(^OCXS(860.4,"B",$E(DFLD,1,30),DFLDN)) Q:'DFLDN Q:($P(^OCXS(860.4,DFLDN,0),U,1)=DFLD)
66 .S DELEMN=0 F S DELEMN=$O(OCXRD(860.21,DELEMN)) Q:'DELEMN D
67 ..S DELEM=+$G(OCXRD(860.21,DELEMN,1,"I")) Q:'DELEM
68 ..S DCONT=+$P($G(^OCXS(860.3,DELEM,0)),U,2) Q:'DCONT
69 ..S DCONT(DCONT)=""
70 .S DCONT=0 F S DCONT=$O(DCONT(DCONT)) Q:'DCONT D EN^OCXODSP3(DFLDN,OCXTAB+OCXOFF,OCXRM,DCONT)
71 ;
72 Q
73 ;
74FIELD(TITLE,STRING,TAB,MARGIN) ;
75 ;
76 W ?TAB,TITLE
77 ;
78 N PTR,SUBSTR,STRLEN
79 ;
80 S STRLEN=MARGIN-($L(TITLE)+TAB)-5
81 S SUBSTR="" F PTR=1:1:$L(STRING," ") D
82 .I ($L(SUBSTR)>STRLEN) W ?(TAB+$L(TITLE)+1),SUBSTR W:$L($P(STRING," ",PTR+1)) ! S SUBSTR=""
83 .S:$L(SUBSTR) SUBSTR=SUBSTR_" " S SUBSTR=SUBSTR_$P(STRING," ",PTR)
84 W:$L(SUBSTR) ?(TAB+$L(TITLE)+1),SUBSTR
85 Q
86 ;
87DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR) ;
88 ;
89 N DIC,X,Y
90 S DIC=$G(OCXDIC) Q:'$L(DIC) -1
91 S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
92 S:$L($G(OCXDICS)) DIC("S")=OCXDICS
93 S:$L($G(OCXDICA)) DIC("A")=OCXDICA
94 S:$L($G(OCXDR)) DIC("DR")=OCXDR
95 D ^DIC Q:(Y<1) 0 Q Y
96 ;
97 ;
98DIQ(DIC,DA,OCXARY) ;
99 ;
100 N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="IEN" D EN^DIQ1
101 Q
102 ;
Note: See TracBrowser for help on using the repository browser.