source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXDI1.m@ 1141

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

initial load of WorldVistAEHR

File size: 5.2 KB
RevLine 
[613]1OCXDI1 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;SEP 7,1999 at 10:30
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 Q
8 ;
9 ;
10COMPARE(L,R) ;
11 ;
12 Q:'$L($O(L(""))) $$ADDREC^OCXDI2("R")
13 ;
14 N C,OCXDD M C=L,C=R S OCXDD=$O(C("")) Q $$MULT("C",OCXDD)
15 ;
16 Q 0
17 ;
18MULT(CREF,OCXDD) ;
19 ;
20 N OCXSUB,LREF,RREF,QUIT,OCXFLD
21 S LREF="L"_$E(CREF,2,$L(CREF)),RREF="R"_$E(CREF,2,$L(CREF))
22 S QUIT=0,OCXFLD="" F S OCXFLD=$O(@CREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD) D Q:QUIT
23 .I (OCXFLD[":") D Q:QUIT
24 ..Q:$$EXFLD(+OCXFLD,0)
25 ..I '$D(@LREF@(OCXDD,OCXFLD,.01,"E")) D M @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
26 ...D WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
27 ...S QUIT=$$ADDMULT^OCXDI3(CREF,OCXDD,OCXFLD)
28 ..I '$D(@RREF@(OCXDD,OCXFLD,.01,"E")) D M @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
29 ...D WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
30 ...S QUIT=$$DELMULT^OCXDI3($$APPEND(CREF,OCXDD),OCXFLD)
31 .;
32 .I (OCXFLD=+OCXFLD),'$$EXFLD(+OCXDD,OCXFLD) D
33 ..I ($O(@CREF@(OCXDD,OCXFLD,""))="E") D Q
34 ...I $L($G(@RREF@(OCXDD,OCXFLD,"E"))),'$L($G(@LREF@(OCXDD,OCXFLD,"E"))) D Q
35 ....D WARN("Data Value Missing in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
36 ....S QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
37 ...I $L($G(@LREF@(OCXDD,OCXFLD,"E"))),'$L($G(@RREF@(OCXDD,OCXFLD,"E"))) D Q
38 ....D WARN("Extra Data Value in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")
39 ....S QUIT=$$DELFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
40 ...I '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E")) D
41 ....D WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
42 ....S QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")
43 ..S OCXSUB=0 F Q:QUIT S OCXSUB=$O(@CREF@(OCXDD,OCXFLD,OCXSUB)) Q:'OCXSUB I '($G(@RREF@(OCXDD,OCXFLD,OCXSUB))=$G(@LREF@(OCXDD,OCXFLD,OCXSUB))) D Q
44 ...D WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
45 ...S QUIT=$$LOADWORD^OCXDI2(RREF,OCXDD,OCXFLD,OCXSUB)
46 .;
47 .I 'QUIT,(OCXFLD[":") S QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
48 Q QUIT
49 ;
50APPEND(ARRAY,OCXSUB) ;
51 S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
52 Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
53 Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
54 ;
55EXFLD(FILE,OCXFLD) ;
56 N OCXFNAM
57 S OCXFNAM=$$FIELD^OCXBDTD(FILE,OCXFLD,"LABEL")
58 I (OCXFNAM["UNIQUE OBJECT IDENTIFIER") Q 1
59 I (FILE=860.2),(OCXFLD=.02) Q 1
60 I (FILE=860.22),(OCXFLD=4) Q 1
61 I (FILE=860.3),(OCXFLD=3) Q 1
62 I (FILE=860.9),(OCXFLD=1) Q 1
63 I (FILE=860.91) Q 1
64 I (FILE=19),(OCXFLD=.15) Q 1
65 I (FILE=19),(OCXFLD=.16) Q 1
66 I (FILE=19),(OCXFLD=.26) Q 1
67 I (FILE=19),(OCXFLD=1.1) Q 1
68 I (FILE=19),(OCXFLD=3.6) Q 1
69 I (FILE=19),(OCXFLD=14) Q 1
70 I (FILE=19),(OCXFLD=99) Q 1
71 I (FILE=19),(OCXFLD=99.1) Q 1
72 I (FILE=19),(OCXFLD=200) Q 1
73 I (FILE=19),(OCXFLD=201) Q 1
74 I (FILE=19),(OCXFLD=203) Q 1
75 I ($E(OCXFNAM,1)="*") Q 1
76 Q 0
77 ;
78WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
79 ;
80 Q:$G(OCXAUTO)
81 ;
82 N D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
83 ;
84 Q:'OCXFLGR
85 ;
86 S DASH="",$P(DASH,"-",(55-$L(MSG)))="-"
87 W !!,"----WARNING-",MSG,DASH
88 D DSPHDR(CREF,OCXDD,OCXFLD)
89 I $D(OCXSUB) D DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
90 I '$D(OCXSUB) D DSPREC(CREF,OCXDD,OCXFLD)
91 ;
92 W ! Q
93 ;
94DSPREC(CREF,OCXDD,OCXFLD) ;
95 ;
96 N OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
97 S OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
98 S OCXDDPTH=$P($P(OCXCREF,"(",2),")",1),LEVL=$L(OCXDDPTH,",")
99 S OCXSUB="" F S OCXSUB=$O(@OCXCREF@(OCXSUB)) Q:'$L(OCXSUB) D
100 .;
101 .I '(OCXSUB[":"),'((OCXSUB=.01)&$O(@OCXCREF@(OCXSUB))) D
102 ..N LINE
103 ..Q:$$EXFLD(+OCXFLD,OCXSUB)
104 ..I OCXFLD W !,?(5+((LEVL)*4)),$$FIELD^OCXBDTD(+OCXFLD,OCXSUB,"LABEL"),": ",$G(@OCXCREF@(OCXSUB,"E"))
105 ..S LINE=0 F S LINE=$O(@OCXCREF@(OCXSUB,LINE)) Q:'LINE D
106 ...W !,?(5+(LEVL*4)),$J(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
107 .;
108 .I (OCXSUB[":") D
109 ..N D0,OCXDD,FILENAME
110 ..S D0=+$P(OCXSUB,":",2),OCXDD=+OCXSUB
111 ..S FILENAME=$$FILENAME^OCXBDTD(OCXDD)
112 ..I $L(FILENAME) W !,?(5+($L(LEVL)*4)),FILENAME
113 ..E W !!,?(5+(LEVL*4)),FILENAME
114 ..W " ",D0,": ",$G(@OCXCREF@(OCXSUB,.01,"E"))
115 ..D DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
116 ;
117 Q
118 ;
119DSPHDR(CREF,OCXDD,OCXFLD) ;
120 ;
121 N D0,FILE,FILEID,OCXPTR,OCXDDPTH
122 S OCXDDPTH=$P($P($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
123 S FILE="" F OCXPTR=1:1:$L(OCXDDPTH,",") D
124 .N OCXDD,D0,FILEID
125 .S FILEID=$P(OCXDDPTH,",",OCXPTR)
126 .I (FILEID[":") D
127 ..S D0=+$P(FILEID,":",2),OCXDD=+$E(FILEID,2,$L(FILEID))
128 ..W !,?(5+(OCXPTR*4)),$$FILENAME^OCXBDTD(OCXDD)
129 ..S:$L(FILE) FILE=FILE_"," S FILE=FILE_FILEID
130 ..I $D(@("L("_FILE_",.01,""E"")")) W ": ",@("L("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
131 ..E I $D(@("R("_FILE_",.01,""E"")")) W ": ",@("R("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
132 ;
133 Q
134 ;
135DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
136 ;
137 N OCXDPTR,LREF,RREF,OCXDDPTH
138 ;
139 S OCXDDPTH=$P($P($$APPEND(CREF,OCXDD),"(",2),")",1)
140 S LREF="L("_OCXDDPTH_")",RREF="R("_OCXDDPTH_")"
141 W !,?(5+(($L(OCXDDPTH,",")+1)*4)),$$FIELD^OCXBDTD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"
142 I OCXSUB W " Line #",OCXSUB
143 ;
144 W:($D(@RREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(R) OEX,OER: ",@RREF@(OCXFLD,OCXSUB)
145 W:($D(@LREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(L) ",$$CUCI^OCXBDT,": ",@LREF@(OCXFLD,OCXSUB)
146 ;
147 Q
148 ;
149 W !,?10 Q 0 Q $$PAUSE
150 ;
151PAUSE() Q:'OCXFLGC 0 W " Press Enter " R X:DTIME W ! Q (X[U)
152 ;
153NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXBDTD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
154 ;
Note: See TracBrowser for help on using the repository browser.