source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPJ.m@ 730

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

initial load of WorldVistAEHR
File size: 5.3 KB
Line 
1OCXOCMPJ ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build LIST Function Code cont...) ;10/29/98 12:37
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 Q
6 ;
7LAST(ROOT,ELEM,INDEX,PARAM,CD) ;
8 ;
9 Q:$G(OCXWARN) 1
10 ;
11 N VARNDX,VARVAL,VARCNT,VARLIM
12 I '$L($G(ROOT)) D WARN^OCXOCMPV("'LAST' Function array root not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
13 I '$L($G(ELEM)) D WARN^OCXOCMPV("'LAST' Function element not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
14 I ($L(PARAM," ")>4) D WARN^OCXOCMPV("'LAST' Function with too many parameters.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
15 S VARNDX="OCXLX"_(+INDEX),VARVAL="OCXLV"_(+INDEX),VARCNT="OCXLC"_(+INDEX),VARLIM="OCXLB"_(+INDEX)
16 ;
17 I '$O(CD(0)),'$L(PARAM) D ; SIMPLE
18 .;
19 .S CD(1)="; LAST SIMPLE"
20 .S CD(2)="S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_",""""),-1) I "_VARNDX_" D @@@@ K "_VARNDX
21 ;
22 I '$O(CD(0)),($L(PARAM," ")=1),'($P(PARAM," ",1)=+$P(PARAM," ",1)) D ; FIELD NAME
23 .N FIELD
24 .S FIELD=$P(PARAM," ",1)
25 .;
26 .I '($E(FIELD,1)="|")!'($E(FIELD,$L(FIELD))="|") D Q
27 ..D WARN^OCXOCMPV("'LAST' Function field name missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q
28 .S FIELD=+$P(FIELD,"|",2)
29 .;
30 .S CD(1)="; LAST FIELD NAME"
31 .S CD(2)="S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_",""""),-1) I $L("_VARVAL_") D K "_VARVAL
32 .S CD(3)=".S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_","_VARNDX_",""""),-1) I "_VARNDX_" D @@@@ K "_VARNDX
33 ;
34 I '$O(CD(0)),($L(PARAM," ")=1),($P(PARAM," ",1)=+$P(PARAM," ",1)) D ; RANGE OF INSTANCES
35 .;
36 .N VSTOP S VSTOP=+$P(PARAM," ",1)
37 .;
38 .S CD(1)="; LAST RANGE OF INSTANCES"
39 .S CD(2)="S "_VARNDX_"="""" D K "_VARNDX
40 .S CD(3)=".F "_VARCNT_"=1:1:"_VSTOP_" S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_","_VARNDX_"),-1) I "_VARNDX_" D @@@@"
41 ;
42 ; FIELD NAME AND RANGE OF INSTANCES
43 ;
44 I '$O(CD(0)),($L(PARAM," ")=2),'($P(PARAM," ",1)=+$P(PARAM," ",1)),($P(PARAM," ",2)=+$P(PARAM," ",2)) D
45 .N FIELD,VSTOP
46 .S FIELD=$P(PARAM," ",1),VSTOP=+$P(PARAM," ",2)
47 .;
48 .I '($E(FIELD,1)="|")!'($E(FIELD,$L(FIELD))="|") D Q
49 ..D WARN^OCXOCMPV("'LAST' Function field name missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
50 .S FIELD=+$P(FIELD,"|",2)
51 .;
52 .S CD(1)="; LAST FIELD NAME AND RANGE OF INSTANCES"
53 .S CD(2)="S ("_VARVAL_","_VARNDX_")="""","_VARCNT_"="_VSTOP_" D K "_VARVAL_","_VARNDX_","_VARCNT
54 .S CD(3)=".F Q:'("_VARCNT_") S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_",""""),-1) Q:'$L("_VARVAL_") D"
55 .S CD(4)="..F Q:'("_VARCNT_") S "_VARNDX_"="""
56 .S CD(4)=CD(4)_" S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_VARVAL_","_VARNDX_"),-1) I "_VARNDX_" S "_VARCNT_"="_VARCNT_"-1 D @@@@"
57 ;
58 I '$O(CD(0)) D WARN^OCXOCMPV("'LAST' Function with invalid parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
59 ;
60 Q OCXWARN
61 ;
62FIRST(ROOT,ELEM,INDEX,PARAM,CD) ;
63 ;
64 Q:$G(OCXWARN) 1
65 I '$L($G(ROOT)) D WARN^OCXOCMPV("'FIRST' Function array root not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
66 I '$L($G(ELEM)) D WARN^OCXOCMPV("'FIRST' Function element not defined.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
67 I ($L(PARAM," ")>4) D WARN^OCXOCMPV("'FIRST' Function with too many parameters.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
68 S VARNDX="OCXLX"_(+INDEX),VARVAL="OCXLV"_(+INDEX),VARCNT="OCXLC"_(+INDEX),VARLIM="OCXLB"_(+INDEX)
69 ;
70 I '$O(CD(0)),'$L(PARAM) D ; SIMPLE
71 .;
72 .S CD(1)="; FIRST SIMPLE"
73 .S CD(2)="S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_","""")) I "_VARNDX_" D @@@@ K "_VARNDX
74 ;
75 I '$O(CD(0)),($L(PARAM," ")=1),'($P(PARAM," ",1)=+$P(PARAM," ",1)) D ; FIELD NAME
76 .N FIELD
77 .S FIELD=$P(PARAM," ",1)
78 .;
79 .I '($E(FIELD,1)="|")!'($E(FIELD,$L(FIELD))="|") D Q
80 ..D WARN^OCXOCMPV("'FIRST' Function field name missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q
81 .S FIELD=+$P(FIELD,"|",2)
82 .;
83 .S CD(1)="; FIRST FIELD NAME"
84 .S CD(2)="S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","""")) I $L("_VARVAL_") D K "_VARVAL
85 .S CD(3)=".S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","_VARVAL_","_VARNDX_","""")) I "_VARNDX_" D @@@@ K "_VARNDX
86 ;
87 I '$O(CD(0)),($L(PARAM," ")=1),($P(PARAM," ",1)=+$P(PARAM," ",1)) D ; RANGE OF INSTANCES
88 .;
89 .N VSTOP S VSTOP=+$P(PARAM," ",1)
90 .;
91 .S CD(1)="; FIRST RANGE OF INSTANCES"
92 .S CD(2)="S "_VARNDX_"="""" D K "_VARNDX
93 .S CD(3)=".F "_VARCNT_"=1:1:"_VSTOP_" S "_VARNDX_"=$O("_ROOT_"""C"","_ELEM_","_VARNDX_")) I "_VARNDX_" D @@@@"
94 ;
95 ; FIELD NAME AND RANGE OF INSTANCES
96 ;
97 I '$O(CD(0)),($L(PARAM," ")=2),'($P(PARAM," ",1)=+$P(PARAM," ",1)),($P(PARAM," ",2)=+$P(PARAM," ",2)) D
98 .N FIELD,VSTOP
99 .S FIELD=$P(PARAM," ",1),VSTOP=+$P(PARAM," ",2)
100 .;
101 .I '($E(FIELD,1)="|")!'($E(FIELD,$L(FIELD))="|") D Q
102 ..D WARN^OCXOCMPV("'FIRST' Function field name missing in parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
103 .S FIELD=+$P(FIELD,"|",2)
104 .;
105 .S CD(1)="; FIRST FIELD NAME AND RANGE OF INSTANCES"
106 .S CD(2)="S ("_VARVAL_","_VARNDX_")="""","_VARCNT_"="_VSTOP_" D K "_VARVAL_","_VARNDX_","_VARCNT
107 .S CD(3)=".F Q:'("_VARCNT_") S "_VARVAL_"=$O("_ROOT_"""D"","_ELEM_","_FIELD_","""")) Q:'$L("_VARVAL_") D"
108 .S CD(4)="..F Q:'("_VARCNT_") S "_VARNDX_"="""
109 .S CD(4)=CD(4)_" S "_VARNDX_"=$O("_ROOT_"""D"","_ELEM_","_VARVAL_","_VARNDX_")) I "_VARNDX_" S "_VARCNT_"="_VARCNT_"-1 D @@@@"
110 ;
111 I '$O(CD(0)) D WARN^OCXOCMPV("'FIRST' Function with invalid parameter list.",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
112 ;
113 Q OCXWARN
Note: See TracBrowser for help on using the repository browser.