Produced by Araxis Merge on 11/9/2018 12:34:06 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMLRMQ.m | Mon Nov 5 16:44:50 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMLRMQ.m | Mon Nov 5 17:50:40 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 690 |
Changed | 1 | 2 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | CHMLRMQ ;J EH/DEN;RED BOOK UPDAT E MANUALLY - PART I; 01/7/05 1 2:39 PM | |
2 | ;V1.0 | |
3 | ZSET S:'$D (DUZ) DUZ= 1,DUZ(0)=" " I '$D(DT ) S %DT="" ,X="T" D ^ %DT S DT=Y | |
4 | S:'$D(IOZ FO) IOZFO= "^^" S:'$D (IOZBK) IO ZBK="^" S: '$D(DTIME) DTIME=60 | |
5 | ;set var IOF for cl ear screen | |
6 | S:'$D(IOF ) IOF="#,$ C(27,91,50 ,74,27,91, 72)" | |
7 | I '$D(IOZ ) S %IS="N ",IOP=$I D ^%ZIS K I OP S IOZ=I O,IOZL=IOS L,IOZW=IOM ,IOZF=IOF, IOZT=IOST, IOZN=ION,I OZS=IOS | |
8 | S:$D(IOF) IOZF=IOF | |
9 | ZNAM ; | |
10 | ; | |
11 | BEGIN ; | |
12 | G:$D(^CHM ZHOLD("RED BOOK_RUNNI NG")) RBRN G | |
13 | D SETVAR | |
14 | I DUZ=582 43!(DUZ=20 52)!(DUZ=4 5344)!(DUZ =9855)!(DU Z=412688) D ;CHG DU Z TO RUN M ASS UP | |
15 | .S DIR(0) ="Y",DIR(" B")="No",D IR("A")="M ass update " D ^DIR K DIR | |
16 | .I Y=1 D | |
17 | ..D MASSU P | |
18 | ..S MSUP= 1 | |
19 | G:MSUP=1 EXIT | |
20 | D HDR,LOO P1 | |
21 | G EXIT | |
22 | Q | |
23 | LOOP1 ; | |
24 | W ! | |
25 | S %DT("A" )="Please enter date (mm/dd/yy ) of Manua l REDBOOK update: " | |
26 | S %DT="AE X" D ^%DT K %DT S TD =Y | |
27 | G:TD=""!( TD="^")!(T D=-1) EXIT | |
28 | S ^CHMZHO LD("REDUP" ,"CHDATE", "TD")=TD | |
29 | ;S ^CHMZP DX("REDUP" ,"CHDATE") =TD | |
30 | LP1 ;LOOP AGAIN TO A DD ANOTHER NDC | |
31 | D HDR | |
32 | D SETVAR | |
33 | S DIR("A" )=CHDSP(20 ) | |
34 | S DIR(0)= "741004,1. 02" D ^DIR K DIR Q:Y ="^"!(Y="" ) ;NDC ST ANDARD | |
35 | S CHVAR(2 0)=Y | |
36 | S CHVAR(1 9)=$E(Y,1, 5)_"-"_$E( Y,6,9)_"-" _$E(Y,10,1 1) | |
37 | I '$D(^CH MPDX("C",C HVAR(19))) D | |
38 | .D LOOP2 | |
39 | .Q:Y="^" | |
40 | XX .D HDR | |
41 | .S DIR(0) ="SO^A:Add ;C:Change; V:Verify" | |
42 | .S DIR("L ",1)="Sele ct one of the follow ing:" | |
43 | .S DIR("L ",2)="" | |
44 | .S DIR("L ",3)=" A - To a dd NDC to system" | |
45 | .S DIR("L ",4)=" C - To m ake Correc tions" | |
46 | .S DIR("L ",5)=" V - To V erify NDC" | |
47 | .S DIR("L ",6)="" | |
48 | .S DIR("L ")="<enter > - To con tinue to n ext NDC... " | |
49 | .D ^DIR K DIR S YTM P=Y | |
50 | .D:Y="V" DISPLY | |
51 | .D:Y="C" CORRCTN | |
52 | .I Y="A" D | |
53 | ..W !,"AD DING NDC T O SYSTEM.. ." | |
54 | ..S ^CHMZ PDX("REDUP ","CHDATE" )=^CHMZHOL D("REDUP", "CHDATE"," TD") | |
55 | ..S I1=0 | |
56 | ..D ^CHML RMC | |
57 | ..D ^CHML RMP | |
58 | .G:YTMP'= ""&(YTMP'= "A") XX | |
59 | E D MSG1 | |
60 | S DIR("A" )="Do you want to ad d another NDC",DIR(0 )="Y",DIR( "B")="No" | |
61 | D ^DIR K DIR | |
62 | G:Y=1 LP1 | |
63 | K ^CHMZHO LD("REDBOO K_RUNNING" ) | |
64 | Q | |
65 | ; | |
66 | LOOP2 ;GET TING NDC I NFORMATION | |
67 | S Y="" | |
68 | F I=1,2,3 ,4,5,6,8,1 2,16,17,18 ,23,29,40 D | |
69 | .I Y'="^" &(I'=19)&( I'=20) D | |
70 | DIR1 ..; | |
71 | ..S DIR(" A")=CHDSP( I) | |
72 | ..S DIR(0 )="741004, "_CHVAR(I) _"" | |
73 | ..S:I=40! (I=41) DIR (0)="74100 4.06,"_CHV AR(I)_"" | |
74 | ..S:I=42! (I=43)!(I= 44) DIR(0) ="741004.0 4,"_CHVAR( I)_"" | |
75 | ..D ^DIR K DIR | |
76 | ..Q:Y="^" | |
77 | ..G:Y=""& ((I=1)!(I= 5)!(I=8)!( I=23)!(I=4 0)) DIR1 ;REQ'D FLD S | |
78 | ..I I=8 S X=$P(Y,"^ ",1) S:X'[ 0 X="0"_X S Y=X ;SE TTG PROD C AT CODE PI ECE | |
79 | ..S:I=12 Y=X ;SETTING EXCPT DRUG IND PIECE | |
80 | ..S:I=15 Y=$P(Y,"^" ,1) ;SETTING THER CLASS CODE PIEC E | |
81 | ..S:I=17 Y=X ;SETTING GCR CODE P IECE | |
82 | ..S:I=18 Y=X ;SETTING GEN FORM C ODE PIECE | |
83 | ..S:I=23 Y=$P(Y,"^" ,2) ;SETTING FORM CODE PIECE | |
84 | ..S:I=26 Y=$P(Y,"^" ,1) ;SETTING MEAS CODE PIECE | |
85 | ..S:I=27 Y=$P(Y,"^" ,1) ;SETTING METRIC SIZ E PIECE | |
86 | ..S:I=28 Y=$P(Y,"^" ,1) ;SETTING ROA PIECE | |
87 | ..S:I=29 Y=$P(Y,"^" ,2) ;SETTING STRENGTH P IECE | |
88 | ..I (I=2! (I=3))&(Y' ="") D | |
89 | ...S:Y'[" ." Y=Y_".0 0" | |
90 | ...S:Y[". "&($L($P(Y ,".",2))=1 ) Y=Y_"0" | |
91 | ..S CHVAR (I)=Y | |
92 | F I=7,9:1 :11,13:1:1 5,21,22,24 :1:28,30:1 :39,41:1:4 4 S CHVAR( I)="" | |
93 | Q | |
94 | HDR ; | |
95 | W @IOZF | |
96 | S TITLE=" CHAMPVA CE NTER - MAN UALLY UPDA TE REDBOOK FILE" | |
97 | W ?(39-($ L(TITLE)/2 )),TITLE,! | |
98 | W !!,"* - Denotes M andatory F ield",! | |
99 | Q | |
100 | SETVAR ;SE T CHMPDX G LOBAL VARI ABLES | |
101 | S ^CHMZHO LD("REDBOO K_RUNNING" )="" | |
102 | S:$G(DUZ) ^CHMZHOLD ("REDBOOK_ RUNNING")= DUZ | |
103 | S MSUP=0 ;MASS UPDATE FL AG | |
104 | S CHVAR(1 )=.01 ;PRODUCT N AME | |
105 | S CHVAR(2 )=.02 ;AWP CURRE NT PRICE | |
106 | S CHVAR(3 )=.03 ;AWP CURRE NT UNIT PR ICE | |
107 | S CHVAR(4 )=.04 ;AWP CURRE NT PRICE E FFCTV DATE | |
108 | S CHVAR(5 )=.05 ;MANUFACTU RE NAME | |
109 | S CHVAR(6 )=.06 ;PACKAGE S IZE | |
110 | S CHVAR(7 )=.07 ;PRODUCT W EIGHT/VOLU ME | |
111 | S CHVAR(8 )=.09 ;PRODUCT C ATEGORY CO DE | |
112 | S CHVAR(9 )=.1 ;TOP VOLUM E RANKING | |
113 | S CHVAR(1 0)=.11 ;SINGLE SO URCE INDIC ATOR | |
114 | S CHVAR(1 1)=.12 ;MAINTENAN CE DRUG IN DICATOR | |
115 | S CHVAR(1 2)=.13 ;EXCEPTION AL DRUG IN DICATOR | |
116 | S CHVAR(1 3)=.15 ;DESI DRUG INDICATOR | |
117 | S CHVAR(1 4)=.16 ;DESI EFFE CTIVE DATE | |
118 | S CHVAR(1 5)=.17 ;THERAPEUT IC CLASS C ODE | |
119 | S CHVAR(1 6)=.18 ;GENERIC C LASS CODE | |
120 | S CHVAR(1 7)=.19 ;GENERIC C ROSS REFER ENCE CODE | |
121 | S CHVAR(1 8)=.2 ;GENERIC F ORMULATION CODE | |
122 | S CHVAR(1 9)=1.01 ;NDC 5-4-2 FORMAT | |
123 | S CHVAR(2 0)=1.02 ;NDC STAND ARD | |
124 | S CHVAR(2 1)=1.03 ;NDC ORIGI NAL CONFIG URATION | |
125 | S CHVAR(2 2)=1.04 ;SOLID/LIQ UID INDICA TOR | |
126 | S CHVAR(2 3)=1.05 ;FORM CODE | |
127 | S CHVAR(2 4)=1.06 ;PACKAGE Q UANTITY CO DE | |
128 | S CHVAR(2 5)=1.07 ;STANDARD PACKAGE SI ZE (SPS) | |
129 | S CHVAR(2 6)=1.08 ;MEASURE C ODE | |
130 | S CHVAR(2 7)=1.09 ;METRIC SI ZE | |
131 | S CHVAR(2 8)=1.1 ;ROUTE OF ADMINISTRA TION | |
132 | S CHVAR(2 9)=1.11 ;STRENGTH | |
133 | S CHVAR(3 0)=1.12 ;UNIT DOSE FLAG | |
134 | S CHVAR(3 1)=3.01 ;RECORD CH ANGE INDIC ATOR | |
135 | S CHVAR(3 2)=3.02 ;RECORD CH ANGE DATE | |
136 | S CHVAR(3 3)=3.03 ;PRICE CHA NGE DATE | |
137 | S CHVAR(3 4)=3.04 ;ADD INDIC ATOR | |
138 | S CHVAR(3 5)=3.05 ;ADD DATE | |
139 | S CHVAR(3 6)=3.06 ;DEACTIVAT E INDICATO R | |
140 | S CHVAR(3 7)=3.07 ;DEACTIVAT E DATE | |
141 | S CHVAR(3 8)=3.08 ;REACTIVAT E INDICATO R | |
142 | S CHVAR(3 9)=3.09 ;REACTIVAT E DATE | |
143 | S CHVAR(4 0)=.01 ;DEA CLASS CODE (741 006.06) | |
144 | S CHVAR(4 1)=.02 ;DEA END D ATE (74100 6.06) | |
145 | S CHVAR(4 2)=.01 ;AWP END D ATE (74100 4.04) | |
146 | S CHVAR(4 3)=2.02 ;AWP PRICE (741004.0 4) | |
147 | S CHVAR(4 4)=2.03 ;AWP UNIT PRICE (741 004.04) | |
148 | ; | |
149 | S CHDSP(1 )="* PRODU CT NAME" | |
150 | S CHDSP(2 )=" AWP C URRENT PRI CE" | |
151 | S CHDSP(3 )=" AWP C URRENT UNI T PRICE" | |
152 | S CHDSP(4 )=" AWP C URRENT PRI CE EFFCTV DATE" | |
153 | S CHDSP(5 )="* MANUF ACTURE NAM E" | |
154 | S CHDSP(6 )=" PACKA GE SIZE" | |
155 | S CHDSP(7 )=" PRODU CT WEIGHT/ VOLUME" | |
156 | S CHDSP(8 )="* PRODU CT CATEGOR Y CODE" | |
157 | S CHDSP(9 )=" TOP V OLUME RANK ING" | |
158 | S CHDSP(1 0)=" SING LE SOURCE INDICATOR" | |
159 | S CHDSP(1 1)=" MAIN TENANCE DR UG INDICAT OR" | |
160 | S CHDSP(1 2)=" EXCE PTIONAL DR UG INDICAT OR" | |
161 | S CHDSP(1 3)=" DESI DRUG INDI CATOR" | |
162 | S CHDSP(1 4)=" DESI EFFECTIVE DATE" | |
163 | S CHDSP(1 5)=" THER APEUTIC CL ASS CODE" | |
164 | S CHDSP(1 6)=" GENE RIC CLASS CODE" | |
165 | S CHDSP(1 7)=" GENE RIC CROSS REFERENCE CODE" | |
166 | S CHDSP(1 8)=" GENE RIC FORMUL ATION CODE " | |
167 | S CHDSP(1 9)=" NDC 5-4-2 FORM AT (as vie w only)" | |
168 | S CHDSP(2 0)="* NDC STANDARD" | |
169 | S CHDSP(2 1)=" NDC ORIGINAL C ONFIGURATI ON" | |
170 | S CHDSP(2 2)=" SOLI D/LIQUID I NDICATOR" | |
171 | S CHDSP(2 3)="* FORM CODE" | |
172 | S CHDSP(2 4)=" PACK AGE QUANTI TY CODE" | |
173 | S CHDSP(2 5)=" STAN DARD PACKA GE SIZE (S PS)" | |
174 | S CHDSP(2 6)=" MEAS URE CODE" | |
175 | S CHDSP(2 7)=" METR IC SIZE" | |
176 | S CHDSP(2 8)=" ROUT E OF ADMIN ISTRATION" | |
177 | S CHDSP(2 9)=" STRE NGTH" | |
178 | S CHDSP(3 0)=" UNIT DOSE FLAG " | |
179 | S CHDSP(3 1)=" RECO RD CHANGE INDICATOR" | |
180 | S CHDSP(3 2)=" RECO RD CHANGE DATE" | |
181 | S CHDSP(3 3)=" PRIC E CHANGE D ATE" | |
182 | S CHDSP(3 4)=" ADD INDICATOR" | |
183 | S CHDSP(3 5)=" ADD DATE" | |
184 | S CHDSP(3 6)=" DEAC TIVATE IND ICATOR" | |
185 | S CHDSP(3 7)=" DEAC TIVATE DAT E" | |
186 | S CHDSP(3 8)=" REAC TIVATE IND ICATOR" | |
187 | S CHDSP(3 9)=" REAC TIVATE DAT E" | |
188 | S CHDSP(4 0)="* DEA CLASS CODE " | |
189 | S CHDSP(4 1)=" DEA END DATE" | |
190 | S CHDSP(4 2)=" AWP END DATE" | |
191 | S CHDSP(4 3)=" AWP PRICE" | |
192 | S CHDSP(4 4)=" AWP UNIT PRICE " | |
193 | Q | |
194 | MSG1 ;MESS AGE FOR ND C IN SYSTE M | |
195 | D HDR | |
196 | W !,CHVAR (19)," is in the sys tem. Try a gain.",! | |
197 | Q | |
198 | DISPLY ;DI SPLAYS DAT A BEFORE A DDING TO G LOBAL | |
199 | D HDR | |
200 | S DCTR=1 | |
201 | F I=20,1, 2,3,4,5,6, 8,12,16,17 ,18,19,23, 29,40 D | |
202 | .W:I'=4&( I'=8)&(I'= 40) !,CHDS P(I),": ", CHVAR(I) | |
203 | .I I=4 D | |
204 | ..S Y=CHV AR(I) D DD ^%DT W !,C HDSP(I),": ",Y | |
205 | .I I=8 D | |
206 | ..S ITMP= "" S ITMP= $O(^CHMPDX (741004.12 ,"C",CHVAR (I),0)) | |
207 | ..S ITMP= $P(^CHMPDX (741004.12 ,ITMP,0)," ^",1) | |
208 | ..W !,CHD SP(I),": " ,CHVAR(I), " (",ITMP, ")" | |
209 | .I I=40 D | |
210 | ..S ITMP= "" | |
211 | ..S:CHVAR (I)="CII" ITMP="Clas s II" | |
212 | ..S:CHVAR (I)="CIII" ITMP="Cla ss III" | |
213 | ..S:CHVAR (I)="CIV" ITMP="Clas s IV" | |
214 | ..S:CHVAR (I)="CV" I TMP="Class V" | |
215 | ..S:CHVAR (I)="RX" I TMP="All O ther RX" | |
216 | ..S:CHVAR (I)="OTC" ITMP="Over The Count er" | |
217 | ..W !,CHD SP(I),": " ,CHVAR(I), " (",ITMP, ")" | |
218 | .S DCTR=D CTR+1 | |
219 | W ! | |
220 | S DIR(0)= "E" D ^DIR K DIR | |
221 | Q | |
222 | CORRCTN ;T O MAKE COR RECTIONS T O INPUT | |
223 | D HDR | |
224 | S CHTMP=" " | |
225 | F I=1,2,3 ,4,5,6,8,1 2,16,17,18 ,23,29,40 D | |
226 | .I CHTMP' ="^" D | |
227 | RR ..; | |
228 | ..I I=4!( I=14)!(I=3 2)!(I=33)! (I=35)!(I= 37)!(I=39) !(I=41)!(I =42) D | |
229 | ...D CDAT E | |
230 | ..E D | |
231 | ...S PTR= "" | |
232 | ...S:I=1 PTR=.01 | |
233 | ...S:I=2 PTR=.02 | |
234 | ...S:I=3 PTR=.03 | |
235 | ...S:I=4 PTR=.04 | |
236 | ...S:I=5 PTR=.05 | |
237 | ...S:I=6 PTR=.06 | |
238 | ...S:I=8 PTR=.09 | |
239 | ...S:I=12 PTR=.13 | |
240 | ...S:I=16 PTR=.18 | |
241 | ...S:I=17 PTR=.19 | |
242 | ...S:I=18 PTR=.2 | |
243 | ...S:I=23 PTR=1.05 | |
244 | ...S:I=29 PTR=1.11 | |
245 | ...S:I=40 PTR=.01 | |
246 | ...S DIR( "A")=CHDSP (I)_": "_C HVAR(I)_"/ / " | |
247 | ...S DIR( 0)="741004 ,"_PTR_",A " | |
248 | ...S:I=40 DIR(0)="7 41004.06," _PTR_",A" | |
249 | ...D ^DIR K DIR | |
250 | ...I I=8& (Y'="") S X=$P(Y,"^" ,1) S:X'[0 X="0"_X S Y=X | |
251 | ...S:I=23 Y=$P(Y,"^ ",2) | |
252 | ...S:I=29 Y=$P(Y,"^ ",2) | |
253 | ...S:Y=" " Y="" | |
254 | ...S:X="@ " Y="@" | |
255 | ...S CHTM P=Y | |
256 | ..Q:CHTMP ="^" | |
257 | ..I CHTMP ="@"&((I=1 )!(I=5)!(I =8)!(I=20) !(I=23)!(I =40)) W !, "Can not D elete" G R R | |
258 | ..E I CH TMP="@" D | |
259 | ...S DIR( 0)="Y",DIR ("B")="No" ,DIR("A")= "Ok to Del ete" D ^DI R K DIR | |
260 | ...S:Y=1 CHVAR(I)=" " | |
261 | ...S CHTM P="" | |
262 | ..I (I=2! (I=3))&(CH TMP'="@") D | |
263 | ...S:CHTM P'["."&(CH TMP'="") C HTMP=CHTMP _".00" | |
264 | ...S:CHTM P["."&($L( $P(CHTMP," .",2))=1) CHTMP=CHTM P_"0" | |
265 | ..I I'=4& (I'=14)&(I '=32)&(I'= 33)&(I'=35 )&(I'=37)& (I'=39)&(I '=41)&(I'= 42) D | |
266 | ...S:CHTM P'="" CHVA R(I)=CHTMP | |
267 | Q | |
268 | CDATE ; | |
269 | S Y=CHVAR (I) D DD^% DT | |
270 | S DIR("A" )=CHDSP(I) | |
271 | S:CHVAR(I )'="" DIR( "B")=Y | |
272 | S DIR(0)= "DO" D ^DI R K DIR | |
273 | S:X="^" C HTMP=X | |
274 | Q:X="^" | |
275 | I X="@" D | |
276 | .S DIR(0) ="Y",DIR(" B")="No",D IR("A")="O k to Delet e" D ^DIR K DIR | |
277 | .S:Y=1 CH VAR(I)="" | |
278 | E D | |
279 | .;S YTMP= $E(Y,1,3) S YTMP=$$F MYR^CHTFLI B(YTMP) | |
280 | .;S CHTMP D=YTMP_$E( Y,4,7) | |
281 | .;S CHVAR (I)=CHTMPD | |
282 | .S CHVAR( I)=Y | |
283 | Q | |
284 | MASSUP ;MA SS UPDATE (READ IN E XTERNAL FI LE) | |
285 | S %DT("A" )="Please enter date (mm/dd/yy ) of Manua l REDBOOK update: " | |
286 | S %DT="AE X" D ^%DT K %DT S TD =Y | |
287 | Q:TD=-1 | |
288 | S ^CHMZHO LD("REDUP" ,"CHDATE", "TD")=TD | |
289 | S AYGSYS= XQVOL | |
290 | S AYGSYS= $S(AYGSYS= "ROU":"LIV E",AYGSYS= "XOU":"TRA IN",AYGSYS ="TOU":"TE ST",AYGSYS ="DOU":"DE V") | |
291 | S ENVIR=A YGSYS | |
292 | S DIR(0)= "F",DIR("A ")="Enter File Name (include f ile extens ion)" D ^D IR K DIR S FNAME=Y | |
293 | S FILE="H ACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .CODEUPDT. REDBOOK."_ ENVIR_"]"_ FNAME ;<---JEH PUT FILE N AME HERE | |
294 | O FILE:"R ":5 | |
295 | I $T=0 W !!,"NOT AB LE TO OPEN FILE" G E ND | |
296 | S $ZE="", $ZT="PRTR^ CHMLRMQ" | |
297 | S TD=^CHM ZHOLD("RED UP","CHDAT E","TD") | |
298 | K ^CHMZHO LD("REDUP" ,"MAN",TD) | |
299 | S CTR=0,I 1=0 | |
300 | R1 U FILE R A | |
301 | ; *** REQ UIRED FIEL DS *** | |
302 | F I=1:1:4 4 S CHVAR( I)="" | |
303 | S CHVAR(1 )=$P(A,"^" ,1) ;P ROD DESC | |
304 | S CHVAR(5 )=$P(A,"^" ,2) ;M ANUFACTURE NAME | |
305 | S CHVAR(8 )=$P(A,"^" ,3) ;P RODUCT CAT EGORY CODE (PCC) (ie. Rx, OTC) | |
306 | ;S CHVAR( 19)=$E(Y,1 ,5)_"-"_$E (Y,6,9)_"- "_$E(Y,10, 11) | |
307 | ;S CHVAR( 20)=$P(A," ^",4) ; NDC | |
308 | S CHVAR(1 9)=$P(A,"^ ",4) ;USE IF IN NDC 5-4 -2 FORMAT | |
309 | S YY=$P(A ,"^",4) ;USE IF IN NDC 5-4 -2 FORMAT | |
310 | S CHVAR(2 0)=$E(YY,1 ,5)_$E(YY, 7,10)_$E(Y Y,12,14) ;USE IF IN NDC 5-4-2 FOR MAT | |
311 | S CHVAR(2 3)=$E($P(A ,"^",5),1, 4) ;FOR M CODE | |
312 | S CHVAR(4 0)=$P(A,"^ ",6) ;D EA CLASS | |
313 | S:CHVAR(4 0)=" " CHV AR(40)="" | |
314 | ; *** NOT REQUIRED FIELDS *** | |
315 | ;S CHVAR( 29)=$P(A," ^",2) ;S TRENGTH | |
316 | ;S CHVAR( 12)=$P(A," ^",7) ;E XCEPT. DRU G IND (EDI ) | |
317 | ;S CHVAR( 6)=$P(A,"^ ",5) ;P ACK SIZE | |
318 | S CHVAR(6 )=$P(A,"^" ,7) ;PA CK SIZE DPT 10/13 /10 | |
319 | ;S CHVAR( 2)=$P(A,"^ ",10) ;A WPUNPR ; <--- not used, info | |
320 | S CHVAR(4 )=$P(A,"^" ,10) ;AW PDATE (in put - mm/d d/yyyy) | |
321 | ;S CHVAR( 4)=$P(A,"^ ",8) ;AW PDATE (in put - mm/d d/yyyy) | |
322 | I CHVAR(4 )["/" S X= CHVAR(4) D ^%DT S CH VAR(4)=Y ;(output - yyymmdd) | |
323 | ; ******* ********** ********** | |
324 | ;S CHVAR( 4)=$$YR8FM YR^CHTFLIB (CHVAR(4)) ;AWPDA TE ;JEH 4/26/05 | |
325 | I '$D(^CH MPDX("C",C HVAR(19))) D | |
326 | .S CTR=CT R+1 | |
327 | .S ^CHMZP DX("REDUP" ,"CHDATE") =^CHMZHOLD ("REDUP"," CHDATE","T D") | |
328 | .D ^CHMLR MC | |
329 | ;G:CTR=2 PRTR ;<- -- SET THI S TO LIMIT # OF NDCs TO PROCES S JEH | |
330 | G R1 | |
331 | Q | |
332 | PRTR U 0 W :'$D(^CHMZ PDX("RED") ) !,"Nothi ng Added - NDC's alr eady in sy stem." | |
333 | D:$D(^CHM ZPDX("RED" )) ^CHMLRM P | |
334 | ENDM ; | |
335 | C FILE | |
336 | G EXIT | |
337 | Q | |
338 | RBRNG ;IF REDBOOK IS RUNNING | |
339 | W !,"The Weekly Mas ter Redboo k Update i s Running - Try agai n later" | |
340 | Q | |
341 | END ; | |
342 | Q | |
343 | EXIT ;EXIT ROUTINE | |
344 | K A,B,C,D ,I,II,J,J1 ,J2,J3 | |
345 | K ^CHMZHO LD("REDBOO K_RUNNING" ) | |
346 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.