source: cprs/branches/tmg-cprs/m_files/TMGLOAD1.m@ 1035

Last change on this file since 1035 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 2.4 KB
RevLine 
[796]1TMGLOAD1 ;TMG/kst-Functions to load ICD and CPT codes in ;11/20/08
2 ;;1.0;TMG-LIB;**1**;11/20/08
3
4 ;"Kevin Toppenberg MD
5 ;"GNU General Public License (GPL) applies
6 ;"3/24/07
7
8 ;"=======================================================================
9 ;" Public Functions.
10 ;"=======================================================================
11
12CPT
13 new cptArray
14 if $$LoadCPT("cptArray")=0 goto CPTDone
15 do CompCPT("cptArray")
16
17CPTDone
18 quit
19
20
21CompCPT(pNewCPT)
22 ;"Purpose: to compare new CPT file with existing values
23 ;"Input: name of array, as made by LoadCPT
24
25 write "Prepping..."
26
27 new scrlArray,oneLine,oldCPTName
28 new lineNum set lineNum=1
29 new cptNum set cptNum=""
30 for set cptNum=$order(@pNewCPT@(cptNum)) quit:(cptNum="") do
31 . set oldCPTName=$piece($get(^ICPT(cptNum,0)),"^",2)
32 . set oneLine=cptNum_": "_$get(@pNewCPT@(cptNum))_" <-- "_oldCPTName
33 . set scrlArray(lineNum,oneLine)=cptNum
34 . set lineNum=lineNum+1
35
36 set cptNum=0
37 for set cptNum=$order(^ICPT(cptNum)) quit:(+cptNum'>0) do
38 . if $data(@pNewCPT@(cptNum)) quit
39 . set oldCPTName=$piece($get(^ICPT(cptNum,0)),"^",2)
40 . set oneLine=cptNum_": DELETED <-- "_oldCPTName
41 . set scrlArray(lineNum,oneLine)=cptNum
42 . set lineNum=lineNum+1
43
44 new Option
45 set Option("HEADER")="Display of new <-- old CPT's"
46 do Scroller^TMGUSRIF("scrlArray",.Option)
47
48 quit
49
50LoadCPT(pArray)
51 ;"Purpose: load a CSV CPT file into an array
52 ;"Input: pArray -- PASS BY NAME, the array to be loaded with the data
53 ;" e.g. "MyArray"
54 ;"Output: If no error, then output will be:
55 ;" @pArray@(CPT#)=DescrText
56 ;" @pArray@(CPT#)=DescrText
57 ;"Results: 1=success, 0=failure
58
59 new tempArray
60 new FPath,FName,Result set Result=0
61 if $$GetFName^TMGIOUTL("Select CPT text file",,,,.FPath,.FName)="^" goto LCDone
62 set Result=$$FTG^%ZISH(FPath,FName,"tempArray(0)",1)
63 if Result=0 goto LCDone
64 new lineNum set lineNum=""
65 for set lineNum=$order(tempArray(lineNum)) quit:(lineNum="") do
66 . new cptNum set cptNum=$piece($get(tempArray(lineNum)),$char(9),1)
67 . quit:(cptNum="")
68 . new descrText set descrText=$piece($get(tempArray(lineNum)),$char(9),2)
69 . set @pArray@(cptNum)=descrText
70LCDone
71 quit Result
Note: See TracBrowser for help on using the repository browser.