Updated acknowledgements
[openemr.git] / contrib / util / load_hcpcs_desc.plx
blob334d8e02edfe5d51654cd5a33c2044acfc4369ee
1 #!/usr/bin/perl
2 use strict;
4 use DBI;
6 #######################################################################
7 # Copyright (C) 2005, 2008 Rod Roark <rod@sunsetsystems.com>
9 # This program is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU General Public License
11 # as published by the Free Software Foundation; either version 2
12 # of the License, or (at your option) any later version.
14 # This loads descriptions of HCPCS codes into the "codes" table of
15 # OpenEMR. Both the long and short descriptions are loaded from the
16 # same input file.
18 # For 2008, run it like this:
20 # ./load_hcpcs_desc.plx < 08anweb.txt
22 # To get this input file, download "2008 Alpha-Numeric HCPCS File" from
23 # http://www.cms.hhs.gov/HCPCSReleaseCodeSets/ANHCPCS/list.asp
24 # and unzip the resulting file.
25 #######################################################################
27 #######################################################################
28 # Parameters that you may customize #
29 #######################################################################
31 my $DBNAME = "openemr"; # database name
33 # To load the short descriptions (SHORTU.txt, not currently used by
34 # OpenEMR but probably should), change this to "code_text_short":
36 my $TEXT_COL = "code_text";
38 # You can hard-code the database user name and password (see below),
39 # or else put them into the environment with bash commands like these
40 # before running this script:
42 # export DBI_USER=username
43 # export DBI_PASS=password
45 my $dbh = DBI->connect("dbi:mysql:dbname=$DBNAME") or die $DBI::errstr;
47 # my $dbh = DBI->connect("dbi:mysql:dbname=$DBNAME", "username", "password")
48 # or die $DBI::errstr;
50 #######################################################################
51 # Startup #
52 #######################################################################
54 my $currcode = "";
55 my $currshort = "";
56 my $currlong = "";
57 my $countup = 0;
58 my $countnew = 0;
60 $| = 1; # Turn on autoflushing of stdout.
62 #######################################################################
63 # Subroutines #
64 #######################################################################
66 sub writeCurrent() {
67 return unless $currcode;
69 $currlong =~ s/ / /g;
70 $currlong =~ s/'/''/g;
71 $currshort =~ s/'/''/g;
73 my $usth = $dbh->prepare("SELECT id FROM codes " .
74 "WHERE code_type = 3 AND code = '$currcode'")
75 or die $dbh->errstr;
76 $usth->execute() or die $usth->errstr;
77 my @urow = $usth->fetchrow_array();
79 my $query;
80 if (! @urow) {
81 $query = "INSERT INTO codes " .
82 "( code_type, code, modifier, code_text_short, code_text ) VALUES " .
83 "( 3, '$currcode', '', '$currshort', '$currshort' )";
84 ++$countnew;
86 else {
87 $query = "UPDATE codes SET code_text_short = '$currshort', code_text = '$currshort' " .
88 "WHERE code_type = 3 AND code = '$currcode'";
89 ++$countup;
92 # Comment this out if you do not want to update the database here.
93 # You can save stdout to a file if you want to inspect it and then
94 # run it through the mysql utility.
96 $dbh->do($query) or die $query;
98 print $query . ";\n";
101 #######################################################################
102 # Main Loop #
103 #######################################################################
105 while (my $line = <STDIN>) {
106 my $rectype = substr($line, 10, 1);
107 next unless ($rectype eq '3' or $rectype eq '4');
109 if ($rectype eq '3') {
110 &writeCurrent();
111 $currcode = substr($line, 0, 5);
112 $currlong = "";
113 $currshort = substr($line, 91, 28);
114 $currshort =~ s/\s*$//g; # remove all trailing whitespace
117 $currlong .= substr($line, 11, 80);
118 $currlong =~ s/\s*$//g;
121 &writeCurrent();
123 #######################################################################
124 # Shutdown #
125 #######################################################################
127 print "\nInserted $countnew rows, updated $countup codes.\n";
129 $dbh->disconnect;