1 | ORY2211 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*221) ;AUG 30,2005 at 11:41
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**221**;Dec 17,1997
|
---|
3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
---|
4 | ;
|
---|
5 | S ;
|
---|
6 | ;
|
---|
7 | Q
|
---|
8 | ;
|
---|
9 | ;
|
---|
10 | COMPARE(L,R) ;
|
---|
11 | ;
|
---|
12 | Q:$$RES("R") 1
|
---|
13 | ;
|
---|
14 | Q:'$L($O(L(""))) $$ADDREC^ORY2212("R")
|
---|
15 | ;
|
---|
16 | N C,OCXDD M C=L,C=R S OCXDD=$O(C("")) Q $$MULT("C",OCXDD)
|
---|
17 | ;
|
---|
18 | Q 0
|
---|
19 | ;
|
---|
20 | RES(REF) ;
|
---|
21 | ;
|
---|
22 | N QUIT,SUB
|
---|
23 | S QUIT=0
|
---|
24 | S SUB="" F S SUB=$O(@REF@(SUB)) Q:'$L(SUB) I (SUB[":") D Q:QUIT
|
---|
25 | .N DD,DA
|
---|
26 | .S DD=$P(SUB,":",1),DA=$P(SUB,":",2)
|
---|
27 | .I $L(DA),'(DA=+DA) D Q:QUIT
|
---|
28 | ..N DANEW,SUBNEW
|
---|
29 | ..S DANEW=$O(^OCXS($P(DA,U,2),"B",$P(DA,U,1),0))
|
---|
30 | ..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
|
---|
31 | ..S SUBNEW=DD_":"_DANEW
|
---|
32 | ..I $D(@REF@(SUBNEW)) W !!," multiple #",DANEW," already existed." S QUIT=1 Q
|
---|
33 | ..M @REF@(SUBNEW)=@REF@(SUB)
|
---|
34 | ..K @REF@(SUB)
|
---|
35 | ..S SUB=""
|
---|
36 | .I $L(SUB),($D(@REF@(SUB))>9) S QUIT=$$RES($NA(@REF@(SUB)))
|
---|
37 | ;
|
---|
38 | Q QUIT
|
---|
39 | ;
|
---|
40 | MULT(CREF,OCXDD) ;
|
---|
41 | ;
|
---|
42 | N OCXSUB,LREF,RREF,QUIT,OCXFLD
|
---|
43 | S LREF="L"_$E(CREF,2,$L(CREF)),RREF="R"_$E(CREF,2,$L(CREF))
|
---|
44 | ;
|
---|
45 | S QUIT=0,OCXFLD="" F S OCXFLD=$O(@CREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD) D Q:QUIT
|
---|
46 | .I (OCXFLD[":") D Q:QUIT
|
---|
47 | ..Q:$$EXFLD(+OCXFLD,0)
|
---|
48 | ..I '$D(@LREF@(OCXDD,OCXFLD,.01,"E")) D M @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
|
---|
49 | ...D WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
|
---|
50 | ...S QUIT=$$ADDMULT^ORY2213(CREF,OCXDD,OCXFLD)
|
---|
51 | ..I '$D(@RREF@(OCXDD,OCXFLD,.01,"E")) D M @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
|
---|
52 | ...D WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
|
---|
53 | ...S QUIT=$$DELMULT^ORY2213($$APPEND(CREF,OCXDD),OCXFLD)
|
---|
54 | .;
|
---|
55 | .I (OCXFLD=+OCXFLD),'$$EXFLD(+OCXDD,OCXFLD) D
|
---|
56 | ..I ($O(@CREF@(OCXDD,OCXFLD,""))="E") D Q
|
---|
57 | ...I $L($G(@RREF@(OCXDD,OCXFLD,"E"))),'$L($G(@LREF@(OCXDD,OCXFLD,"E"))) D Q
|
---|
58 | ....D WARN("Data Value Missing in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
|
---|
59 | ....S QUIT=$$EDITFLD^ORY2214(CREF,OCXDD,OCXFLD,"E")
|
---|
60 | ...I $L($G(@LREF@(OCXDD,OCXFLD,"E"))),'$L($G(@RREF@(OCXDD,OCXFLD,"E"))) D Q
|
---|
61 | ....D WARN("Extra Data Value in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
|
---|
62 | ....S QUIT=$$DELFLD^ORY2214(CREF,OCXDD,OCXFLD,"E")
|
---|
63 | ...I '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E")) D
|
---|
64 | ....D WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
|
---|
65 | ....S QUIT=$$EDITFLD^ORY2214(CREF,OCXDD,OCXFLD,"E")
|
---|
66 | ..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
|
---|
67 | ...D WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
|
---|
68 | ...S QUIT=$$LOADWORD^ORY2212(RREF,OCXDD,OCXFLD,OCXSUB)
|
---|
69 | .;
|
---|
70 | .I 'QUIT,(OCXFLD[":") S QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
|
---|
71 | Q QUIT
|
---|
72 | ;
|
---|
73 | APPEND(ARRAY,OCXSUB) ;
|
---|
74 | S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
|
---|
75 | Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
|
---|
76 | Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
|
---|
77 | ;
|
---|
78 | EXFLD(FILE,OCXFLD) ;
|
---|
79 | N OCXFNAM
|
---|
80 | S OCXFNAM=$$FIELD^OCXSENDD(FILE,OCXFLD,"LABEL")
|
---|
81 | I (OCXFNAM["UNIQUE OBJECT IDENTIFIER") Q 1
|
---|
82 | I (FILE=860.2),(OCXFLD=.02) Q 1
|
---|
83 | I (FILE=860.22),(OCXFLD=4) Q 1
|
---|
84 | I (FILE=860.3),(OCXFLD=3) Q 1
|
---|
85 | I (FILE=860.9),(OCXFLD=1) Q 1
|
---|
86 | I (FILE=860.91) Q 1
|
---|
87 | I (FILE=860.801) Q 1
|
---|
88 | I (FILE=860.81) Q 1
|
---|
89 | I (FILE=861.01) Q 1
|
---|
90 | I (FILE=863.02) Q 1
|
---|
91 | I (FILE=863.54) Q 1
|
---|
92 | I (FILE=863.61) Q 1
|
---|
93 | I (FILE=863.72) Q 1
|
---|
94 | I (FILE=863.81) Q 1
|
---|
95 | I ($E(OCXFNAM,1)="*") Q 1
|
---|
96 | Q 0
|
---|
97 | ;
|
---|
98 | WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
|
---|
99 | ;
|
---|
100 | Q:$G(OCXAUTO)
|
---|
101 | ;
|
---|
102 | N D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
|
---|
103 | ;
|
---|
104 | S DASH="",$P(DASH,"-",(55-$L(MSG)))="-"
|
---|
105 | W !!,"------------",MSG,DASH
|
---|
106 | D DSPHDR(CREF,OCXDD,OCXFLD)
|
---|
107 | I $D(OCXSUB) D DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
|
---|
108 | I '$D(OCXSUB) D DSPREC(CREF,OCXDD,OCXFLD)
|
---|
109 | ;
|
---|
110 | W ! Q
|
---|
111 | ;
|
---|
112 | DSPREC(CREF,OCXDD,OCXFLD) ;
|
---|
113 | ;
|
---|
114 | N OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
|
---|
115 | S OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
|
---|
116 | S OCXDDPTH=$P($P(OCXCREF,"(",2),")",1),LEVL=$L(OCXDDPTH,",")
|
---|
117 | S OCXSUB="" F S OCXSUB=$O(@OCXCREF@(OCXSUB)) Q:'$L(OCXSUB) D
|
---|
118 | .;
|
---|
119 | .I '(OCXSUB[":"),'((OCXSUB=.01)&$O(@OCXCREF@(OCXSUB))) D
|
---|
120 | ..N LINE
|
---|
121 | ..Q:$$EXFLD(+OCXFLD,OCXSUB)
|
---|
122 | ..I OCXFLD W !,?(5+((LEVL)*4)),$$FIELD^OCXSENDD(+OCXFLD,OCXSUB,"LABEL"),": ",$G(@OCXCREF@(OCXSUB,"E"))
|
---|
123 | ..S LINE=0 F S LINE=$O(@OCXCREF@(OCXSUB,LINE)) Q:'LINE D
|
---|
124 | ...W !,?(5+(LEVL*4)),$J(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
|
---|
125 | .;
|
---|
126 | .I (OCXSUB[":") D
|
---|
127 | ..N D0,OCXDD,FILENAME
|
---|
128 | ..S D0=+$P(OCXSUB,":",2),OCXDD=+OCXSUB
|
---|
129 | ..S FILENAME=$$FILENAME^OCXSENDD(OCXDD)
|
---|
130 | ..I $L(FILENAME) W !,?(5+($L(LEVL)*4)),FILENAME
|
---|
131 | ..E W !!,?(5+(LEVL*4)),FILENAME
|
---|
132 | ..W " ",D0,": ",$G(@OCXCREF@(OCXSUB,.01,"E"))
|
---|
133 | ..D DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
|
---|
134 | ;
|
---|
135 | Q
|
---|
136 | ;
|
---|
137 | DSPHDR(CREF,OCXDD,OCXFLD) ;
|
---|
138 | ;
|
---|
139 | N D0,FILE,FILEID,OCXPTR,OCXDDPTH
|
---|
140 | S OCXDDPTH=$P($P($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
|
---|
141 | S FILE="" F OCXPTR=1:1:$L(OCXDDPTH,",") D
|
---|
142 | .N OCXDD,D0,FILEID
|
---|
143 | .S FILEID=$P(OCXDDPTH,",",OCXPTR)
|
---|
144 | .I (FILEID[":") D
|
---|
145 | ..S D0=+$P(FILEID,":",2),OCXDD=+$E(FILEID,2,$L(FILEID))
|
---|
146 | ..W !,?(5+(OCXPTR*4)),$$FILENAME^OCXSENDD(OCXDD)
|
---|
147 | ..S:$L(FILE) FILE=FILE_"," S FILE=FILE_FILEID
|
---|
148 | ..I $D(@("L("_FILE_",.01,""E"")")) W ": ",@("L("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
|
---|
149 | ..E I $D(@("R("_FILE_",.01,""E"")")) W ": ",@("R("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
|
---|
150 | ;
|
---|
151 | Q
|
---|
152 | ;
|
---|
153 | DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
|
---|
154 | ;
|
---|
155 | N OCXDPTR,LREF,RREF,OCXDDPTH
|
---|
156 | ;
|
---|
157 | S OCXDDPTH=$P($P($$APPEND(CREF,OCXDD),"(",2),")",1)
|
---|
158 | S LREF="L("_OCXDDPTH_")",RREF="R("_OCXDDPTH_")"
|
---|
159 | W !,?(5+(($L(OCXDDPTH,",")+1)*4)),$$FIELD^OCXSENDD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"
|
---|
160 | I OCXSUB W " Line #",OCXSUB
|
---|
161 | ;
|
---|
162 | W:($D(@RREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(R) DEVCUR.FO-SLC.MED.VA.GOV: ",@RREF@(OCXFLD,OCXSUB)
|
---|
163 | W:($D(@LREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(L) ",$$NETNAME^OCXSEND,": ",@LREF@(OCXFLD,OCXSUB)
|
---|
164 | ;
|
---|
165 | Q
|
---|
166 | ;
|
---|
167 | W !,?10 Q 0 Q $$PAUSE
|
---|
168 | ;
|
---|
169 | PAUSE() W " Press Enter " R X:DTIME W ! Q (X[U)
|
---|
170 | ;
|
---|
171 | 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
|
---|
172 | ;
|
---|