1 | OCXOCMPR ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Function Library Report and code edit) ;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 | EN ;
|
---|
6 | ;
|
---|
7 | N CODE,D0,D1,IOP,LINLAB,NODE0
|
---|
8 | ;
|
---|
9 | D ^%ZIS Q:POP
|
---|
10 | ;
|
---|
11 | U IO S D0=0 F S D0=$O(^OCXS(860.8,D0)) Q:'D0 D
|
---|
12 | .S NODE0=$G(^OCXS(860.8,D0,0)) Q:'$L(NODE0)
|
---|
13 | .S LINLAB=$P(NODE0,U,2) Q:'$L(LINLAB)
|
---|
14 | .W !!,$P(NODE0,U,1)
|
---|
15 | .S LINLAB=LINLAB_"(",D1=0 F S D1=$O(^OCXS(860.8,D0,"CODE",D1)) Q:'D1 I (^(D1,0)[LINLAB) S CODE=$P($P(^(0),";",2)," ",1) Q
|
---|
16 | .W !,?5,CODE
|
---|
17 | ;
|
---|
18 | U IO W $C(12) D ^%ZISC
|
---|
19 | ;
|
---|
20 | Q
|
---|
21 | ;
|
---|
22 | DT(X,%DT) N Y D ^%DT Q +Y
|
---|
23 | ;
|
---|
24 | REPORT ;
|
---|
25 | ;
|
---|
26 | N FNAM S FNAM="" F S FNAM=$O(^OCXS(860.8,"C",FNAM)) Q:'$L(FNAM) D
|
---|
27 | .N D0
|
---|
28 | .S D0=0 F S D0=$O(^OCXS(860.8,"C",FNAM,D0)) Q:'D0 D
|
---|
29 | ..N D1,OCXCALL,OCXHDR,OCXLAB,OCXREC M OCXREC=^OCXS(860.8,D0)
|
---|
30 | ..S OCXLAB=$P(OCXREC(0),U,2),OCXHDR=""
|
---|
31 | ..S D1=0 F S D1=$O(OCXREC("CODE",D1)) Q:'D1 D
|
---|
32 | ...N OCXPC,OCXLINE S OCXLINE=OCXREC("CODE",D1,0)
|
---|
33 | ...I (OCXLINE[(";"_OCXLAB_"(")) S OCXHDR=$P($P(OCXLINE,";",2),")",1)_")"
|
---|
34 | ...I (OCXLINE["$$") F OCXPC=2:1:$L(OCXLINE,"$$") D
|
---|
35 | ....N OCXFUNC,OCXPIEC
|
---|
36 | ....S OCXPIEC=$P($P(OCXLINE,"$$",OCXPC),")",1)_")",OCXFUNC=$P(OCXPIEC,"(",1)
|
---|
37 | ....S OCXCALL((OCXFUNC[U)+1,OCXFUNC)=OCXPIEC
|
---|
38 | ..;
|
---|
39 | ..W !!,OCXHDR," ;",D0,"; ",$P(OCXREC(0),U,1)
|
---|
40 | ..S D1=0 F S D1=$O(OCXCALL(D1)) Q:'D1 D
|
---|
41 | ...N D2 S D2="" F S D2=$O(OCXCALL(D1,D2)) Q:'$L(D2) D
|
---|
42 | ....N OCXFUNC S OCXFUNC=OCXCALL(D1,D2)
|
---|
43 | ....I '(D2[U) W !,?8,"Internal Call --> ",D2
|
---|
44 | ....E W !,?5,"External Call --> ",OCXFUNC
|
---|
45 | Q
|
---|
46 | ;
|
---|
47 | SCAN ;
|
---|
48 | ;
|
---|
49 | N OCXVAL,GLREF,COUNT,ANS
|
---|
50 | W !!,"Enter value to scan for: " R OCXVAL:DTIME E Q
|
---|
51 | S GLREF="^OCX" F COUNT=1:1 S GLREF=$Q(@GLREF) Q:'$L(GLREF) D
|
---|
52 | .W:($X>70) ! W:'(COUNT#20) "."
|
---|
53 | .I (@GLREF[OCXVAL) W !!,GLREF," = ",@GLREF," press <CR> to continue... " R ANS:DTIME W !
|
---|
54 | Q
|
---|
55 | ;
|
---|
56 | ERROR ;
|
---|
57 | Q
|
---|
58 | ;
|
---|