199. EPMO Open Source Coordination Office Redaction File Detail Report

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.

199.1 Files compared

# 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

199.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 690
Changed 1 2
Inserted 0 0
Removed 0 0

199.3 Comparison options

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

199.4 Active regular expressions

No regular expressions were active.

199.5 Comparison detail

  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