source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXSEND5.m@ 1204

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

revised back to 6/30/08 version

File size: 6.8 KB
Line 
1OCXSEND5 ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Build Library Routine 1) ;2/01/01 09:56
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,96,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5EN() ;
6 ;
7 N R,LINE,TEXT,NOW,RUCI,XCM
8 S NOW=$$NOW^OCXSEND3,RUCI=$$NETNAME^OCXSEND
9 F LINE=1:1:999 S TEXT=$P($T(TEXT+LINE),";",2,999) Q:TEXT S TEXT=$P(TEXT,";",2,999) S R(LINE,0)=$$CONV^OCXSEND3(TEXT)
10 ;
11 M ^TMP("OCXSEND",$J,"RTN")=R
12 ;
13 S DIE="^TMP(""OCXSEND"","_$J_",""RTN"",",XCN=0,X=$$RNAME^OCXSEND3(1,1)
14 W !,X X ^%ZOSF("SAVE") W " ... ",XCM," Lines filed" K ^TMP("OCXSEND",$J,"RTN")
15 ;
16 Q XCM
17 ;
18TEXT ;
19 ;;|$$RNAME^OCXSEND3(1,1)| ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE |OCXPATCH| ;|NOW|
20 ;;|OCXLIN2|
21 ;;|OCXLIN3|
22 ;; ;
23 ;;S ;
24 ;; ;
25 ;; Q
26 ;; ;
27 ;; ;
28 ;;COMPARE(L,R) ;
29 ;; ;
30 ;; Q:$$RES("R") 1
31 ;; ;
32 ;; Q:'$L($O(L(""))) $$ADDREC^|$$RNAME^OCXSEND3(2,1)|("R")
33 ;; ;
34 ;; N C,OCXDD M C=L,C=R S OCXDD=$O(C("")) Q $$MULT("C",OCXDD)
35 ;; ;
36 ;; Q 0
37 ;; ;
38 ;;RES(REF) ;
39 ;; ;
40 ;; N QUIT,SUB
41 ;; S QUIT=0
42 ;; S SUB="" F S SUB=$O(@REF@(SUB)) Q:'$L(SUB) I (SUB[":") D Q:QUIT
43 ;; .N DD,DA
44 ;; .S DD=$P(SUB,":",1),DA=$P(SUB,":",2)
45 ;; .I $L(DA),'(DA=+DA) D Q:QUIT
46 ;; ..N DANEW,SUBNEW
47 ;; ..S DANEW=$O(^OCXS($P(DA,U,2),"B",$P(DA,U,1),0))
48 ;; ..I 'DANEW W !!,$P($G(^OCXS(+$P(DA,U,2),0)),U,1),": ",$P(DA,U,1)," could not resolve name.",!!," End Transport." S QUIT=1 Q
49 ;; ..S SUBNEW=DD_":"_DANEW
50 ;; ..I $D(@REF@(SUBNEW)) W !!," multiple #",DANEW," already existed." S QUIT=1 Q
51 ;; ..M @REF@(SUBNEW)=@REF@(SUB)
52 ;; ..K @REF@(SUB)
53 ;; ..S SUB=""
54 ;; .I $L(SUB),($D(@REF@(SUB))>9) S QUIT=$$RES($NA(@REF@(SUB)))
55 ;; ;
56 ;; Q QUIT
57 ;; ;
58 ;;MULT(CREF,OCXDD) ;
59 ;; ;
60 ;; N OCXSUB,LREF,RREF,QUIT,OCXFLD
61 ;; S LREF="L"_$E(CREF,2,$L(CREF)),RREF="R"_$E(CREF,2,$L(CREF))
62 ;; ;
63 ;; S QUIT=0,OCXFLD="" F S OCXFLD=$O(@CREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD) D Q:QUIT
64 ;; .I (OCXFLD[":") D Q:QUIT
65 ;; ..Q:$$EXFLD(+OCXFLD,0)
66 ;; ..I '$D(@LREF@(OCXDD,OCXFLD,.01,"E")) D M @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
67 ;; ...D WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
68 ;; ...S QUIT=$$ADDMULT^|$$RNAME^OCXSEND3(3,1)|(CREF,OCXDD,OCXFLD)
69 ;; ..I '$D(@RREF@(OCXDD,OCXFLD,.01,"E")) D M @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
70 ;; ...D WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
71 ;; ...S QUIT=$$DELMULT^|$$RNAME^OCXSEND3(3,1)|($$APPEND(CREF,OCXDD),OCXFLD)
72 ;; .;
73 ;; .I (OCXFLD=+OCXFLD),'$$EXFLD(+OCXDD,OCXFLD) D
74 ;; ..I ($O(@CREF@(OCXDD,OCXFLD,""))="E") D Q
75 ;; ...I $L($G(@RREF@(OCXDD,OCXFLD,"E"))),'$L($G(@LREF@(OCXDD,OCXFLD,"E"))) D Q
76 ;; ....D WARN("Data Value Missing in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
77 ;; ....S QUIT=$$EDITFLD^|$$RNAME^OCXSEND3(4,1)|(CREF,OCXDD,OCXFLD,"E")
78 ;; ...I $L($G(@LREF@(OCXDD,OCXFLD,"E"))),'$L($G(@RREF@(OCXDD,OCXFLD,"E"))) D Q
79 ;; ....D WARN("Extra Data Value in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
80 ;; ....S QUIT=$$DELFLD^|$$RNAME^OCXSEND3(4,1)|(CREF,OCXDD,OCXFLD,"E")
81 ;; ...I '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E")) D
82 ;; ....D WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
83 ;; ....S QUIT=$$EDITFLD^|$$RNAME^OCXSEND3(4,1)|(CREF,OCXDD,OCXFLD,"E")
84 ;; ..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
85 ;; ...D WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
86 ;; ...S QUIT=$$LOADWORD^|$$RNAME^OCXSEND3(2,1)|(RREF,OCXDD,OCXFLD,OCXSUB)
87 ;; .;
88 ;; .I 'QUIT,(OCXFLD[":") S QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
89 ;; Q QUIT
90 ;; ;
91 ;;APPEND(ARRAY,OCXSUB) ;
92 ;; S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
93 ;; Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
94 ;; Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
95 ;; ;
96 ;;EXFLD(FILE,OCXFLD) ;
97 ;; N OCXFNAM
98 ;; S OCXFNAM=$$FIELD^OCXSENDD(FILE,OCXFLD,"LABEL")
99 ;; I (OCXFNAM["UNIQUE OBJECT IDENTIFIER") Q 1
100 ;; I (FILE=860.2),(OCXFLD=.02) Q 1
101 ;; I (FILE=860.22),(OCXFLD=4) Q 1
102 ;; I (FILE=860.3),(OCXFLD=3) Q 1
103 ;; I (FILE=860.9),(OCXFLD=1) Q 1
104 ;; I (FILE=860.91) Q 1
105 ;; I (FILE=860.801) Q 1
106 ;; I (FILE=860.81) Q 1
107 ;; I (FILE=861.01) Q 1
108 ;; I (FILE=863.02) Q 1
109 ;; I (FILE=863.54) Q 1
110 ;; I (FILE=863.61) Q 1
111 ;; I (FILE=863.72) Q 1
112 ;; I (FILE=863.81) Q 1
113 ;; I ($E(OCXFNAM,1)="*") Q 1
114 ;; Q 0
115 ;; ;
116 ;;WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
117 ;; ;
118 ;; Q:$G(OCXAUTO)
119 ;; ;
120 ;; N D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
121 ;; ;
122 ;; S DASH="",$P(DASH,"-",(55-$L(MSG)))="-"
123 ;; W !!,"------------",MSG,DASH
124 ;; D DSPHDR(CREF,OCXDD,OCXFLD)
125 ;; I $D(OCXSUB) D DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
126 ;; I '$D(OCXSUB) D DSPREC(CREF,OCXDD,OCXFLD)
127 ;; ;
128 ;; W ! Q
129 ;; ;
130 ;;DSPREC(CREF,OCXDD,OCXFLD) ;
131 ;; ;
132 ;; N OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
133 ;; S OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
134 ;; S OCXDDPTH=$P($P(OCXCREF,"(",2),")",1),LEVL=$L(OCXDDPTH,",")
135 ;; S OCXSUB="" F S OCXSUB=$O(@OCXCREF@(OCXSUB)) Q:'$L(OCXSUB) D
136 ;; .;
137 ;; .I '(OCXSUB[":"),'((OCXSUB=.01)&$O(@OCXCREF@(OCXSUB))) D
138 ;; ..N LINE
139 ;; ..Q:$$EXFLD(+OCXFLD,OCXSUB)
140 ;; ..I OCXFLD W !,?(5+((LEVL)*4)),$$FIELD^OCXSENDD(+OCXFLD,OCXSUB,"LABEL"),": ",$G(@OCXCREF@(OCXSUB,"E"))
141 ;; ..S LINE=0 F S LINE=$O(@OCXCREF@(OCXSUB,LINE)) Q:'LINE D
142 ;; ...W !,?(5+(LEVL*4)),$J(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
143 ;; .;
144 ;; .I (OCXSUB[":") D
145 ;; ..N D0,OCXDD,FILENAME
146 ;; ..S D0=+$P(OCXSUB,":",2),OCXDD=+OCXSUB
147 ;; ..S FILENAME=$$FILENAME^OCXSENDD(OCXDD)
148 ;; ..I $L(FILENAME) W !,?(5+($L(LEVL)*4)),FILENAME
149 ;; ..E W !!,?(5+(LEVL*4)),FILENAME
150 ;; ..W " ",D0,": ",$G(@OCXCREF@(OCXSUB,.01,"E"))
151 ;; ..D DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
152 ;; ;
153 ;; Q
154 ;; ;
155 ;;DSPHDR(CREF,OCXDD,OCXFLD) ;
156 ;; ;
157 ;; N D0,FILE,FILEID,OCXPTR,OCXDDPTH
158 ;; S OCXDDPTH=$P($P($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
159 ;; S FILE="" F OCXPTR=1:1:$L(OCXDDPTH,",") D
160 ;; .N OCXDD,D0,FILEID
161 ;; .S FILEID=$P(OCXDDPTH,",",OCXPTR)
162 ;; .I (FILEID[":") D
163 ;; ..S D0=+$P(FILEID,":",2),OCXDD=+$E(FILEID,2,$L(FILEID))
164 ;; ..W !,?(5+(OCXPTR*4)),$$FILENAME^OCXSENDD(OCXDD)
165 ;; ..S:$L(FILE) FILE=FILE_"," S FILE=FILE_FILEID
166 ;; ..I $D(@("L("_FILE_",.01,""E"")")) W ": ",@("L("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
167 ;; ..E I $D(@("R("_FILE_",.01,""E"")")) W ": ",@("R("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
168 ;; ;
169 ;; Q
170 ;; ;
171 ;;DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
172 ;; ;
173 ;; N OCXDPTR,LREF,RREF,OCXDDPTH
174 ;; ;
175 ;; S OCXDDPTH=$P($P($$APPEND(CREF,OCXDD),"(",2),")",1)
176 ;; S LREF="L("_OCXDDPTH_")",RREF="R("_OCXDDPTH_")"
177 ;; W !,?(5+(($L(OCXDDPTH,",")+1)*4)),$$FIELD^OCXSENDD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"
178 ;; I OCXSUB W " Line #",OCXSUB
179 ;; ;
180 ;; W:($D(@RREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(R) |RUCI|: ",@RREF@(OCXFLD,OCXSUB)
181 ;; W:($D(@LREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(L) ",$$NETNAME^OCXSEND,": ",@LREF@(OCXFLD,OCXSUB)
182 ;; ;
183 ;; Q
184 ;; ;
185 ;; W !,?10 Q 0 Q $$PAUSE
186 ;; ;
187 ;;PAUSE() W " Press Enter " R X:DTIME W ! Q (X[U)
188 ;; ;
189 ;;NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXSENDD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
190 ;; ;
191 ;;$
192 ;1;
193 ;
Note: See TracBrowser for help on using the repository browser.