| 1 | TMGIMPORT ;TMG/kst/Code for importing from legacy MEDIC PMS ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;11/01/04
|
|---|
| 3 |
|
|---|
| 4 | ;"Custom functions for importing data from legacy MEDIC system
|
|---|
| 5 |
|
|---|
| 6 | ImportLabels
|
|---|
| 7 | ;"Purpose: To import a file with patient name, DOB etc, and
|
|---|
| 8 | ;"register all these patients
|
|---|
| 9 | ;
|
|---|
| 10 | ;"This is an example entry:
|
|---|
| 11 | ;"------------------------
|
|---|
| 12 | ;"ADAM R JONES
|
|---|
| 13 | ;"123 JONESS CREEK RD
|
|---|
| 14 | ;"GREENEVILLE TN 37743
|
|---|
| 15 | ;"423 666 6666 423 666 6667
|
|---|
| 16 | ;" 123456 05151971M 040302
|
|---|
| 17 |
|
|---|
| 18 |
|
|---|
| 19 |
|
|---|
| 20 | new TMGDEBUG set TMGDEBUG=0 ;"Note: user could change this at runtime...
|
|---|
| 21 | new DBIndent set DBIndent=0
|
|---|
| 22 | new PriorErrorFound set PriorErrorFound=0
|
|---|
| 23 |
|
|---|
| 24 | new cGUI set cGUI="GUI"
|
|---|
| 25 | new cCHUI set cCHUI="CHUI"
|
|---|
| 26 | new cRoll set cRoll="Roll-n-Scroll"
|
|---|
| 27 | new DModes
|
|---|
| 28 | new cDialog set cDialog="UseDialog"
|
|---|
| 29 | set DModes(0)="x"
|
|---|
| 30 | set DModes(1)=cGUI
|
|---|
| 31 | set DModes(2)=cCHUI
|
|---|
| 32 | set DModes(3)=cRoll
|
|---|
| 33 | set DModes(4)="x"
|
|---|
| 34 |
|
|---|
| 35 | new cTrue set cTrue=1
|
|---|
| 36 | new cFalse set cFalse=0
|
|---|
| 37 | new cdbNone set cdbNone=0
|
|---|
| 38 | new cdbToScrn set cdbToScrn=1
|
|---|
| 39 | new cdbToFile set cdbToFile=2
|
|---|
| 40 | new cdbToTail set cdbToTail=3
|
|---|
| 41 |
|
|---|
| 42 | new cdbAbort set cdbAbort=-1
|
|---|
| 43 | new cOKToCont set cOKToCont=1
|
|---|
| 44 | new cAbort set cAbort=0
|
|---|
| 45 |
|
|---|
| 46 | new cName set cName="01. NAME"
|
|---|
| 47 | new cDOB set cDOB="02. DOB"
|
|---|
| 48 | new cSex set cSex="03. SEX"
|
|---|
| 49 | new cStrAddr set cStrAddr="04. STREET ADDRESS"
|
|---|
| 50 | new cCity set cCity="05. CITY"
|
|---|
| 51 | new cState set cState="06. STATE"
|
|---|
| 52 | new cZip set cZip="07. ZIP"
|
|---|
| 53 | new cPhone1 set cPhone1="08. PHONE-1"
|
|---|
| 54 | new cPhone2 set cPhone2="09. PHONE-2"
|
|---|
| 55 | new cDateReg set cDateReg="10. DATE REGISTERED"
|
|---|
| 56 | new cChartNum set cChartNum="11. CHARTNUM"
|
|---|
| 57 |
|
|---|
| 58 | new Filename
|
|---|
| 59 | new DebugFPath
|
|---|
| 60 | new DebugFName
|
|---|
| 61 | new DebugFile
|
|---|
| 62 | new LabelArray,PLabelArray
|
|---|
| 63 | new FileHandle
|
|---|
| 64 | new UserPath,UserFName
|
|---|
| 65 |
|
|---|
| 66 | new result
|
|---|
| 67 | new FileSpec
|
|---|
| 68 |
|
|---|
| 69 | new line set line=""
|
|---|
| 70 |
|
|---|
| 71 | do DebugEntry^TMGDEBUG(.DBIndent,"Main Run")
|
|---|
| 72 |
|
|---|
| 73 | ;"A local code login function.
|
|---|
| 74 | if $$XUP^TMGXUP()=0 do goto RunDone
|
|---|
| 75 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Error setting up a user privilages for configuration.")
|
|---|
| 76 |
|
|---|
| 77 | ;"------------------------------------------------------------------------------------
|
|---|
| 78 | if ($data(DispMode)#10=0)!($get(DispMode)>3)!($get(DispMode)<1) do
|
|---|
| 79 | . set DispMode=$$GetDispMode()
|
|---|
| 80 | set DispMode=DModes(DispMode)
|
|---|
| 81 | if DispMode="x" goto RunDone
|
|---|
| 82 | set DispMode(cDialog)=(DispMode'=cRoll)
|
|---|
| 83 | if ($data(DebugMode)#10=0)!($get(DebugMode)<0)!($get(DebugMode)>3)!(($get(DebugMode)=1)&(DispMode'=cGUI)) do
|
|---|
| 84 | . set TMGDEBUG=$$GetDebugMode^TMGDEBUG(cdbNone)
|
|---|
| 85 | else do
|
|---|
| 86 | . set TMGDEBUG=DebugMode
|
|---|
| 87 | if TMGDEBUG=cdbAbort goto RunDone
|
|---|
| 88 |
|
|---|
| 89 | do
|
|---|
| 90 | . new DefPath set DefPath="/tmp/"
|
|---|
| 91 | . new DefName set DefName="M_Import_DebugLog.tmp"
|
|---|
| 92 | . new DefFName set DefFName=DefPath_DefName
|
|---|
| 93 | . do OpenLogFile^TMGDEBUG(DefPath,DefName)
|
|---|
| 94 | . if TMGDEBUG=cdbToTail do
|
|---|
| 95 | . . set result=$$Tail^TMGXDLG(DefFName,0,0,0)
|
|---|
| 96 |
|
|---|
| 97 | ;"------------------------------------------------------------------------------------
|
|---|
| 98 | if ($data(UserPath)#10=0)!($data(UserFName)#10=0) do
|
|---|
| 99 | . set result=$$GetFName(.UserPath,.UserFName)
|
|---|
| 100 | . if result=cAbort do PopupBox^TMGUSRIF("<!> No file selected.","Come back again soon!")
|
|---|
| 101 | else do
|
|---|
| 102 | . set result=cOKToCont
|
|---|
| 103 | if (result=cAbort)!($data(UserPath)=0)!($data(UserFName)=0) goto RunDone
|
|---|
| 104 | set Filename=UserPath_"/"_UserFName
|
|---|
| 105 | ;"------------------------------------------------------------------------------------
|
|---|
| 106 |
|
|---|
| 107 | ;new Array
|
|---|
| 108 | new InFile,RecNum,EOF
|
|---|
| 109 | new counter set counter=0
|
|---|
| 110 |
|
|---|
| 111 | write "Please be patient...",!,!
|
|---|
| 112 |
|
|---|
| 113 | set InFile=Filename
|
|---|
| 114 | open InFile:readonly:2
|
|---|
| 115 | else do goto QLoad
|
|---|
| 116 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening file: ",UserPath_"/"_UserFName)
|
|---|
| 117 |
|
|---|
| 118 | for RecNum=1:1 do quit:EOF
|
|---|
| 119 | . ;"set EOF=$$GetRecord(.Array,RecNum)
|
|---|
| 120 | . set EOF=$$GetRecord(.Array,1)
|
|---|
| 121 | . set ArrayP=$name(Array(1))
|
|---|
| 122 | . do ParseRecord(ArrayP,.Parsed)
|
|---|
| 123 | . if $$ScreenParsed(.Parsed)=cOKToCont do
|
|---|
| 124 | . . if $$FileParsed(.Parsed)=cOKToCont do
|
|---|
| 125 | . . . write "."
|
|---|
| 126 | . . else do
|
|---|
| 127 | . . . write "!"
|
|---|
| 128 | . else write "X"
|
|---|
| 129 | . set counter=counter+1
|
|---|
| 130 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Counter=",counter)
|
|---|
| 131 | . if counter=80 do
|
|---|
| 132 | . . ;"write @IOF
|
|---|
| 133 | . . write !,RecNum," records processed so far.",!
|
|---|
| 134 | . . set counter=0
|
|---|
| 135 | . ;"write "hit key.."
|
|---|
| 136 | . read *KeyPress:0
|
|---|
| 137 | . if KeyPress=27 set EOF=1
|
|---|
| 138 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"End of loop. EOF=",EOF)
|
|---|
| 139 |
|
|---|
| 140 | close InFile
|
|---|
| 141 |
|
|---|
| 142 | write !,!,RecNum," Records processed.",!,!
|
|---|
| 143 |
|
|---|
| 144 | goto RunDone
|
|---|
| 145 |
|
|---|
| 146 | RunDone
|
|---|
| 147 | write "Goodbye",!,!
|
|---|
| 148 |
|
|---|
| 149 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"Main Run")
|
|---|
| 150 |
|
|---|
| 151 | quit
|
|---|
| 152 |
|
|---|
| 153 |
|
|---|
| 154 |
|
|---|
| 155 |
|
|---|
| 156 | GetFName(Path,Filename)
|
|---|
| 157 | ;"Purpose: Interact with user to get path and filename
|
|---|
| 158 | ;"Input: Path--should be passed by reference, used to pass back result
|
|---|
| 159 | ;" Filename--should be passed by reference, used to pass back result
|
|---|
| 160 | ;"Output: Results passed in Path and Filename
|
|---|
| 161 | ;" Function will result in 0 if user 'cancelled', 1 otherwise
|
|---|
| 162 |
|
|---|
| 163 | new result set result=cAbort
|
|---|
| 164 | new FullNamePath
|
|---|
| 165 | new PathNode
|
|---|
| 166 | set Path="/"
|
|---|
| 167 | set Filename=""
|
|---|
| 168 |
|
|---|
| 169 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetFName")
|
|---|
| 170 |
|
|---|
| 171 | if DispMode=cRoll goto GFNRoll
|
|---|
| 172 |
|
|---|
| 173 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling $$FileSel()")
|
|---|
| 174 | set FullNamePath=$$FileSel^TMGXDLG("Please select script to process . . .","~/MedicLabels")
|
|---|
| 175 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Results=",FullNamePath)
|
|---|
| 176 | if FullNamePath="" goto GFNDone ;"result=cAbort still --> cancelled.
|
|---|
| 177 |
|
|---|
| 178 | ;"Separate path from filename
|
|---|
| 179 | GFNL1
|
|---|
| 180 | if '(FullNamePath["/") set Filename=FullNamePath goto GFNL2
|
|---|
| 181 | set PathNode=$piece(FullNamePath,"/",1)
|
|---|
| 182 | set Path=Path_PathNode_"/"
|
|---|
| 183 | set $piece(FullNamePath,"/",1)=""
|
|---|
| 184 | set FullNamePath=$extract(FullNamePath,2,255)
|
|---|
| 185 | goto GFNL1
|
|---|
| 186 | GFNL2
|
|---|
| 187 | set result=cOKToCont
|
|---|
| 188 | goto GFNDone
|
|---|
| 189 |
|
|---|
| 190 | GFNRoll
|
|---|
| 191 | new DefFName set DefFName="MedicLabels"
|
|---|
| 192 | new DefPath set DefPath="/home/kdt0p"
|
|---|
| 193 | ;"write !,"------------------------------------------",!
|
|---|
| 194 | write !
|
|---|
| 195 | write "Enter filename with path:",!
|
|---|
| 196 | write " ['^'] = Abort",!
|
|---|
| 197 | write " [Enter] = '",DefPath,"/",DefFName,"'",!
|
|---|
| 198 | write "> "
|
|---|
| 199 | read Filename:240
|
|---|
| 200 | write !
|
|---|
| 201 | if Filename="^" goto GFNDone
|
|---|
| 202 | if Filename="" do
|
|---|
| 203 | . set Filename=DefFName
|
|---|
| 204 | . set Path=DefPath
|
|---|
| 205 | . write "Using default: ",Path,"/",Filename,!,!,!
|
|---|
| 206 | set result=cOKToCont
|
|---|
| 207 |
|
|---|
| 208 | GFNDone
|
|---|
| 209 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetFName")
|
|---|
| 210 | quit result
|
|---|
| 211 |
|
|---|
| 212 |
|
|---|
| 213 |
|
|---|
| 214 |
|
|---|
| 215 |
|
|---|
| 216 | GetDispMode()
|
|---|
| 217 | ;"Purpose: To determine with form of input user wants
|
|---|
| 218 | ;"Results: 1=GUI,2=CHUI,3=RollNScroll,0=abort
|
|---|
| 219 | new Input
|
|---|
| 220 | new result set result=cAbort
|
|---|
| 221 | new Default set Default=3
|
|---|
| 222 |
|
|---|
| 223 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetDispMode")
|
|---|
| 224 |
|
|---|
| 225 | write "Select interface option:",!
|
|---|
| 226 | write " 0. Quit. (Goodbye!)",!
|
|---|
| 227 | write " 1. Linux X graphics/ 'GUI' (Recommended)",!
|
|---|
| 228 | write " 2. Text graphics / 'CHUI' (Incomplete)",!
|
|---|
| 229 | write " 3. Line-by-Line / 'Roll-and-scroll'",!
|
|---|
| 230 |
|
|---|
| 231 | write "Enter option number ("_Default_"): "
|
|---|
| 232 | read Input,!
|
|---|
| 233 | if Input="" do
|
|---|
| 234 | . ;"write "Defaulting to: ",Default,!
|
|---|
| 235 | . set Input=Default
|
|---|
| 236 | else if +Input>4 do
|
|---|
| 237 | . set Input=Default
|
|---|
| 238 |
|
|---|
| 239 | set result=+Input
|
|---|
| 240 | if (Input=1)!(Input=2) do
|
|---|
| 241 | . do SetupConsts^TMGXDLG()
|
|---|
| 242 | . do SetGUI^TMGXDLG(Input=1)
|
|---|
| 243 | ;"if Input=2 do goto GIMDone
|
|---|
| 244 | ;". do SetupConsts^TMGXDLG()
|
|---|
| 245 | ;". do SetGUI^TMGXDLG(0)
|
|---|
| 246 |
|
|---|
| 247 | GIMDone
|
|---|
| 248 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Display mode set at: ",result)
|
|---|
| 249 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetDispMode")
|
|---|
| 250 | quit result
|
|---|
| 251 |
|
|---|
| 252 |
|
|---|
| 253 | LogSkipped
|
|---|
| 254 |
|
|---|
| 255 | use OutFile
|
|---|
| 256 |
|
|---|
| 257 |
|
|---|
| 258 |
|
|---|
| 259 | GetRecord(Array,RecNum)
|
|---|
| 260 | ;"Purpose:
|
|---|
| 261 | ;"
|
|---|
| 262 |
|
|---|
| 263 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetRecord")
|
|---|
| 264 |
|
|---|
| 265 | new done,i
|
|---|
| 266 | new BlankLine set BlankLine=""
|
|---|
| 267 | new Parsed,ArrayP
|
|---|
| 268 |
|
|---|
| 269 | use InFile
|
|---|
| 270 |
|
|---|
| 271 | for i=1:1:6 do quit:($zeof)
|
|---|
| 272 | . if line="" read line
|
|---|
| 273 | . set Array(RecNum,i)=line
|
|---|
| 274 | . set line=""
|
|---|
| 275 | . if $zeof quit
|
|---|
| 276 | . ;"read BlankLine ;"read and discard blank line
|
|---|
| 277 | . ;"if BlankLine'="" set line=BlankLine
|
|---|
| 278 |
|
|---|
| 279 | ;"for do quit:($zeof)!(line'="")
|
|---|
| 280 | ;". read line
|
|---|
| 281 | ;". set line=$$Trim^TMGSTUTL(line)
|
|---|
| 282 |
|
|---|
| 283 | use 0
|
|---|
| 284 |
|
|---|
| 285 | QLoad
|
|---|
| 286 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetRecord")
|
|---|
| 287 | quit $zeof
|
|---|
| 288 |
|
|---|
| 289 |
|
|---|
| 290 |
|
|---|
| 291 | ParseRecord(ArrayP,Parsed)
|
|---|
| 292 |
|
|---|
| 293 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ParseRecord")
|
|---|
| 294 |
|
|---|
| 295 | new s,s1,s2
|
|---|
| 296 | new NameArray
|
|---|
| 297 | new MaxNode,i
|
|---|
| 298 |
|
|---|
| 299 | kill Parsed
|
|---|
| 300 |
|
|---|
| 301 | ;"temp
|
|---|
| 302 | new tempDEBUG set tempDEBUG=$get(TMGDEBUG)
|
|---|
| 303 | set TMGDEBUG=0
|
|---|
| 304 |
|
|---|
| 305 | set s=$get(@ArrayP@(1))
|
|---|
| 306 | ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Init Name Line=",s)
|
|---|
| 307 | if s'="" do
|
|---|
| 308 | . new Suffix set Suffix=""
|
|---|
| 309 | . do CleaveToArray^TMGSTUTL(s," ",.NameArray,1)
|
|---|
| 310 | . if $get(NameArray(1))="BABY" quit
|
|---|
| 311 | . set MaxNode=+$get(NameArray("MAXNODE"))
|
|---|
| 312 | . if MaxNode'>0 do quit
|
|---|
| 313 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Error after CleaveToArray. Here is NameArray:")
|
|---|
| 314 | . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("NameArray")
|
|---|
| 315 | . if (NameArray(MaxNode)="JR")!(NameArray(MaxNode)="SR") do
|
|---|
| 316 | . . set Suffix=NameArray(MaxNode)
|
|---|
| 317 | . . kill NameArray(MaxNode)
|
|---|
| 318 | . . set MaxNode=MaxNode-1
|
|---|
| 319 | . set s1=NameArray(MaxNode)_","
|
|---|
| 320 | . for i=1:1:MaxNode-1 do
|
|---|
| 321 | . . set s1=s1_NameArray(i)_" "
|
|---|
| 322 | . set s1=s1_Suffix
|
|---|
| 323 | . set s1=$$Trim^TMGSTUTL(s1)
|
|---|
| 324 | . if $extract(s1,1,2)="ZZ" set s1="" ;"DROP ZZ NAMES
|
|---|
| 325 | . if (s1'["0")&(s1'["1")&(s1'["2")&(s1'["3")&(s1'["4")&(s1'["5")&(s1'["6")&(s1'["7")&(s1'["8")&(s1'["9") do
|
|---|
| 326 | . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"final Name Line=",s1)
|
|---|
| 327 | . . if s1'="" set Parsed(cName)=s1
|
|---|
| 328 |
|
|---|
| 329 | set s=$get(@ArrayP@(2))
|
|---|
| 330 | set s2=$$Trim^TMGSTUTL(s)
|
|---|
| 331 | if $length(s2)>34 set s2=$extract(s2,1,34)
|
|---|
| 332 | if $length(s2)<3 set s2=""
|
|---|
| 333 | if s2'="" set Parsed(cStrAddr)=s2
|
|---|
| 334 |
|
|---|
| 335 | set s=$get(@ArrayP@(3))
|
|---|
| 336 | set s1=$extract(s,1,16)
|
|---|
| 337 | set s2=$$Trim^TMGSTUTL(s1)
|
|---|
| 338 | if s2'="" set Parsed(cCity)=s2
|
|---|
| 339 |
|
|---|
| 340 | set s1=$extract(s,17,18)
|
|---|
| 341 | set s2=$$Trim^TMGSTUTL(s1)
|
|---|
| 342 | if $length(s2)'=2 set s2=""
|
|---|
| 343 | if s2'="" set Parsed(cState)=s2
|
|---|
| 344 |
|
|---|
| 345 | set s1=$extract(s,19,256)
|
|---|
| 346 | set s2=$$Trim^TMGSTUTL(s1)
|
|---|
| 347 | if s2'="" set Parsed(cZip)=s2
|
|---|
| 348 |
|
|---|
| 349 | set s=$get(@ArrayP@(4))
|
|---|
| 350 | set s2=$$Trim^TMGSTUTL($extract(s,1,12))
|
|---|
| 351 | if s2="000 000 0000" set s2=""
|
|---|
| 352 | if s2'="" set Parsed(cPhone1)=s2
|
|---|
| 353 | set s2=$$Trim^TMGSTUTL($extract(s,16,27))
|
|---|
| 354 | if s2="000 000 0000" set s2=""
|
|---|
| 355 | if s2'="" set Parsed(cPhone2)=s2
|
|---|
| 356 |
|
|---|
| 357 | set s=$get(@ArrayP@(5))
|
|---|
| 358 | set s1=$extract(s,1,10)
|
|---|
| 359 | set s2=$$Trim^TMGSTUTL(s1)
|
|---|
| 360 | set s2=$translate(s2,"DPWCI\*","") ;"Clean off alpha characters -- not needed.
|
|---|
| 361 | if $extract(s2,1,2)="ZZ" set s2=""
|
|---|
| 362 | if s2'="" set Parsed(cChartNum)=s2
|
|---|
| 363 |
|
|---|
| 364 | set s1=$extract(s,11,18)
|
|---|
| 365 | set s1=$$FixDate(s1)
|
|---|
| 366 | if s1'="" set Parsed(cDOB)=s1
|
|---|
| 367 |
|
|---|
| 368 | set s1=$extract(s,19,19)
|
|---|
| 369 | if (s1'="M")&(s1'="F") do
|
|---|
| 370 | . set s1="M" ;"NOTE, I AM SETTING ALL UNKNOWN SEX's TO MALE
|
|---|
| 371 | if s1'="" set Parsed(cSex)=s1
|
|---|
| 372 |
|
|---|
| 373 | set s1=$extract(s,21,26)
|
|---|
| 374 | set s1=$$FixDate(s1)
|
|---|
| 375 | if s1'="" set Parsed(cDateReg)=s1
|
|---|
| 376 |
|
|---|
| 377 | ;"temp
|
|---|
| 378 | set TMGDEBUG=tempDEBUG
|
|---|
| 379 |
|
|---|
| 380 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ParseRecord")
|
|---|
| 381 |
|
|---|
| 382 | quit
|
|---|
| 383 |
|
|---|
| 384 |
|
|---|
| 385 | FixDate(Date)
|
|---|
| 386 |
|
|---|
| 387 | new Month,Day,Year
|
|---|
| 388 | new result set result=""
|
|---|
| 389 |
|
|---|
| 390 | set Date=$$Trim^TMGSTUTL(Date)
|
|---|
| 391 | set Month=$$Trim^TMGSTUTL($extract(Date,1,2))
|
|---|
| 392 | if +Month>0 do
|
|---|
| 393 | . set result=Month
|
|---|
| 394 | . set Day=$$Trim^TMGSTUTL($extract(Date,3,4))
|
|---|
| 395 | . if +Day>0 do
|
|---|
| 396 | . . set result=result_"/"_Day
|
|---|
| 397 | . . set Year=$$Trim^TMGSTUTL($extract(Date,5,8))
|
|---|
| 398 | . . if +Year>0 do
|
|---|
| 399 | . . . set result=result_"/"_Year
|
|---|
| 400 |
|
|---|
| 401 | quit result
|
|---|
| 402 |
|
|---|
| 403 |
|
|---|
| 404 | ScreenParsed(Parsed)
|
|---|
| 405 | ;"Purpose: Screen record. If not appropriate for filing, then
|
|---|
| 406 | ;" Parsed(*) is emptied
|
|---|
| 407 | ;"Result: 0 if Parsed is ok to file, 1 if killed
|
|---|
| 408 |
|
|---|
| 409 | if $get(Parsed(cName))="" do goto SPKill
|
|---|
| 410 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"No name found!")
|
|---|
| 411 | if $get(Parsed(cChartNum))="" do goto SPKill
|
|---|
| 412 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"No chart number found!")
|
|---|
| 413 | if $get(Parsed(cDOB))="" do goto SPKill
|
|---|
| 414 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"No DOB found!")
|
|---|
| 415 |
|
|---|
| 416 | quit cOKToCont
|
|---|
| 417 |
|
|---|
| 418 | SPKill
|
|---|
| 419 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Killing Parsed. Here it is first...")
|
|---|
| 420 | if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Parsed")
|
|---|
| 421 | kill Parsed
|
|---|
| 422 | quit cAbort
|
|---|
| 423 |
|
|---|
| 424 |
|
|---|
| 425 |
|
|---|
| 426 | FileParsed(Parsed)
|
|---|
| 427 |
|
|---|
| 428 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"FileParsed")
|
|---|
| 429 |
|
|---|
| 430 | new cOKToCont set cOKToCont=1
|
|---|
| 431 | new cAbort set cAbort=0
|
|---|
| 432 | new cFile set cFile="FILE"
|
|---|
| 433 | new cEntries set cEntries="Entries"
|
|---|
| 434 | new cMatchThis set cMatchThis="MATCHTHIS" ;"MatchThis"
|
|---|
| 435 |
|
|---|
| 436 | new result set result=cOKToCont
|
|---|
| 437 | new Data
|
|---|
| 438 |
|
|---|
| 439 | ;"The Data array will be filed with data. (An example)
|
|---|
| 440 | ;" Data(0,cFile)="1234.1" <-- "NEW PERSON" Note conversion
|
|---|
| 441 | ;" Data(0,cFile,cGlobal)="^DIC(200)" <-- note, NOT "^DIC(200,"
|
|---|
| 442 | ;" Data(0,cRecNum)=2 <-- only if user-specified.
|
|---|
| 443 | ;" Data(0,cEntries)=1
|
|---|
| 444 | ;" Data(1,".01")="MyData1"
|
|---|
| 445 | ;" Data(1,".01",cMatchValue)="MyData1"
|
|---|
| 446 | ;" Data(1,".01",cFlags)=any flags given (only present if user specified)
|
|---|
| 447 | ;" Data(1,".02")="Bill"
|
|---|
| 448 | ;" Data(1,".02",cMatchValue)="John"
|
|---|
| 449 | ;" Data(1,".03")="MyData3"
|
|---|
| 450 | ;" Data(1,".04")="MyData4"
|
|---|
| 451 | ;" Data(1,".06")="MyData5" <-- note "NAME" was converted to ".06"
|
|---|
| 452 | ;" Data(1,".07",0,cEntries)=2 <-- "ITEM" converted to ".07"
|
|---|
| 453 | ;" Data(1,".07",0,cParentIENS)=",10033,"
|
|---|
| 454 | ;" Data(1,".07",1,".01")="SubEntry1"
|
|---|
| 455 | ;" Data(1,".07",1,".02")="SE1"
|
|---|
| 456 | ;" Data(1,".07",1,".03")="'Some Info'"
|
|---|
| 457 | ;" Data(1,".07",2,".01")="SubEntry2"
|
|---|
| 458 | ;" Data(1,".07",2,".02")="SE2"
|
|---|
| 459 | ;" Data(1,".07",2,".04",0,cEntries)=1 ;"TEXT converted to .04
|
|---|
| 460 | ;" Data(1,".07",2,".04",0,cParentIENS)=",3,10033,"
|
|---|
| 461 | ;" Data(1,".07",2,".04",1,".01")="JD"
|
|---|
| 462 | ;" Data(1,".07",2,".04",1,".02")="DOE,JOHN"
|
|---|
| 463 |
|
|---|
| 464 |
|
|---|
| 465 | if $get(Parsed(cName))="" do goto UploadDone
|
|---|
| 466 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"No name found!")
|
|---|
| 467 | . set result=cAbort
|
|---|
| 468 |
|
|---|
| 469 | set Data(0,cFile)=2 ;"file 2=PATIENT file
|
|---|
| 470 | set Data(0,cEntries)=1
|
|---|
| 471 | if $data(Parsed(cName)) do
|
|---|
| 472 | . set Data(1,.01)=Parsed(cName)
|
|---|
| 473 | . set Data(1,.01,cMatchThis)=1
|
|---|
| 474 | if $data(Parsed(cSex)) set Data(1,.02)=Parsed(cSex)
|
|---|
| 475 | if $data(Parsed(cDOB)) set Data(1,.03)=Parsed(cDOB)
|
|---|
| 476 | ;"if $data(Parsed(cDateReg)) set Data(1,.097)=Parsed(cDateReg) ;".097 = DATE ENTERED INTO FILE
|
|---|
| 477 | if $data(Parsed(cStrAddr)) set Data(1,.111)=Parsed(cStrAddr) ;".111 = STREED ADDRESS [LINE 1]
|
|---|
| 478 | if $data(Parsed(cZip)) set Data(1,.1112)=Parsed(cZip) ;".1112 = ZIP+4
|
|---|
| 479 | if $data(Parsed(cCity)) set Data(1,.114)=Parsed(cCity)
|
|---|
| 480 | if $data(Parsed(cState)) set Data(1,.115)=Parsed(cState)
|
|---|
| 481 | if $data(Parsed(cPhone1)) set Data(1,.131)=Parsed(cPhone1) ;".131 = PHONE NUMBER [RESIDENCE]
|
|---|
| 482 | if $data(Parsed(cPhone2)) set Data(1,.132)=Parsed(cPhone2) ;".132 = PHONE NUMBER [WORK]
|
|---|
| 483 | if $data(Parsed(cChartNum)) set Data(1,22700)=Parsed(cChartNum);"22700 = MEDIC ACCOUNT NUMBER
|
|---|
| 484 |
|
|---|
| 485 |
|
|---|
| 486 | new result
|
|---|
| 487 |
|
|---|
| 488 | new tempDebug set tempDebug=TMGDEBUG
|
|---|
| 489 | set TMGDEBUG=0 ;"DISALLOW DEBUG OF UPLOAD -- TOO MUCH INFORMATION!
|
|---|
| 490 | set result=$$UploadData^TMGDBAPI(.Data)
|
|---|
| 491 | set TMGDEBUG=tempDebug
|
|---|
| 492 |
|
|---|
| 493 | if result=cAbort do
|
|---|
| 494 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Error uploading record")
|
|---|
| 495 | . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Data")
|
|---|
| 496 |
|
|---|
| 497 | UploadDone
|
|---|
| 498 |
|
|---|
| 499 | if result=cAbort do
|
|---|
| 500 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"This record not uploaded")
|
|---|
| 501 | . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Parsed")
|
|---|
| 502 |
|
|---|
| 503 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"FileParsed")
|
|---|
| 504 |
|
|---|
| 505 | quit result
|
|---|
| 506 |
|
|---|
| 507 |
|
|---|
| 508 | ;"=====================================================================================
|
|---|
| 509 |
|
|---|
| 510 | Purge
|
|---|
| 511 | ;"ENTRY POINT...
|
|---|
| 512 | ;"Purge: Purge duplicate records
|
|---|
| 513 | new index
|
|---|
| 514 | new CurPt
|
|---|
| 515 | new Count set Count=0
|
|---|
| 516 | new Inc set Inc=0
|
|---|
| 517 |
|
|---|
| 518 | kill ^TMP("TMG","DUPLICATE")
|
|---|
| 519 | set ^TMP("TMG","DUPLICATE","NEXT")=1
|
|---|
| 520 |
|
|---|
| 521 | write !,!,"Starting to check for duplicate entries.",!,!
|
|---|
| 522 | set index=$order(^DPT(0))
|
|---|
| 523 |
|
|---|
| 524 | for do quit:index=""
|
|---|
| 525 | . set CurPt=$piece($get(^DPT(index,0)),"^",1)
|
|---|
| 526 | . set index=$order(^DPT(index))
|
|---|
| 527 | . set Count=Count+1
|
|---|
| 528 | . set Inc=Inc+1
|
|---|
| 529 | . if Inc>999 do
|
|---|
| 530 | . . write !,Count," records processed so far. (",Count/69758*100,"%)",!
|
|---|
| 531 | . . set Inc=0
|
|---|
| 532 | . if CurPt="" quit
|
|---|
| 533 | . ;"write "Considering ",CurPt,!
|
|---|
| 534 | . write "."
|
|---|
| 535 | . new lname,fname,PtName
|
|---|
| 536 | . set lname=$piece(CurPt,",",1)
|
|---|
| 537 | . set fname=$piece(CurPt,",",2)
|
|---|
| 538 | . set fname=$extract(fname,1,3) ;"only check first 3 letters of first name
|
|---|
| 539 | . set PtName=lname_","_fname
|
|---|
| 540 | . ;"--------
|
|---|
| 541 | . new Matches,TMGMsg
|
|---|
| 542 | . new FileNumber,IENS,Fields,Flags,MatchValue,ScreenCode
|
|---|
| 543 | . set FileNumber=2
|
|---|
| 544 | . set IENS=""
|
|---|
| 545 | . set Fields="@;.01;.02;.03;.09;22700"
|
|---|
| 546 | . set Flags=""
|
|---|
| 547 | . set MatchValue=PtName
|
|---|
| 548 | . set ScreenCode=""
|
|---|
| 549 | . ;"Call FIND^DIC
|
|---|
| 550 | . ;"FILE,IENS,FIELDS,FLAGS,VALUE,NUMBER,INDEXES,SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOTS
|
|---|
| 551 | . do FIND^DIC(FileNumber,$get(IENS),Fields,Flags,MatchValue,"*",,ScreenCode,,"Matches","TMGMsg")
|
|---|
| 552 | . ;"======================================================
|
|---|
| 553 | . if $data(Matches("DILIST",0))'=0 do
|
|---|
| 554 | . . new NumMatches set NumMatches=$piece(Matches("DILIST",0),"^",1)
|
|---|
| 555 | . . if NumMatches>1 do
|
|---|
| 556 | . . . if $$DoComp(.Matches)>0 do
|
|---|
| 557 | . . . . ;"write "*** Multiple entries found!",!
|
|---|
| 558 | . read *KeyPress:0
|
|---|
| 559 | . if KeyPress=27 do quit:index=""
|
|---|
| 560 | . . new Answer
|
|---|
| 561 | . . write !
|
|---|
| 562 | . . read "Do yu want to quit (y/n)?",Answer
|
|---|
| 563 | . . if Answer="y" set index=""
|
|---|
| 564 | . . write !,!
|
|---|
| 565 |
|
|---|
| 566 | zwr ^TMP("TMG","DUPLICATE",*)
|
|---|
| 567 |
|
|---|
| 568 | quit
|
|---|
| 569 |
|
|---|
| 570 | DoComp(Matches)
|
|---|
| 571 | ;"Purpose: to find duplicate entries
|
|---|
| 572 | ;"result 0=no duplicates, 1=duplicate 2=exact match found (and killed)
|
|---|
| 573 |
|
|---|
| 574 | new index1,index2
|
|---|
| 575 | new result set result=0
|
|---|
| 576 |
|
|---|
| 577 | new MaxCount set MaxCount=$piece(Matches("DILIST",0),"^",1)
|
|---|
| 578 | for index1=1:1:(MaxCount-1) do quit:(result>0)
|
|---|
| 579 | . new A
|
|---|
| 580 | . merge A=Matches("DILIST","ID",index1)
|
|---|
| 581 | . set A("IEN")=Matches("DILIST",2,index1)
|
|---|
| 582 | . for index2=index1+1:1:MaxCount do quit:(result>0)
|
|---|
| 583 | . . new B
|
|---|
| 584 | . . merge B=Matches("DILIST","ID",index2)
|
|---|
| 585 | . . set B("IEN")=Matches("DILIST",2,index2)
|
|---|
| 586 | . . set result=$$CompRecs(.A,.B)
|
|---|
| 587 | . . if result>0 do
|
|---|
| 588 | . . . ;"write !,"Duplicate found.",!
|
|---|
| 589 | . . . new NextI set NextI=^TMP("TMG","DUPLICATE","NEXT")
|
|---|
| 590 | . . . merge ^TMP("TMG","DUPLICATE",NextI,"A")=A
|
|---|
| 591 | . . . merge ^TMP("TMG","DUPLICATE",NextI,"B")=B
|
|---|
| 592 | . . . set ^TMP("TMG","DUPLICATE","NEXT")=NextI+1
|
|---|
| 593 | . . . if result=1 do
|
|---|
| 594 | . . . . new KeepRec set KeepRec=$$WhichToKeep(.A,.B)
|
|---|
| 595 | . . . . if KeepRec=1 do MergeAIntoB(B("IEN"),A("IEN")) ;"Keep A & Kill B,
|
|---|
| 596 | . . . . if KeepRec=2 do MergeAIntoB(A("IEN"),B("IEN")) ;"Keep B & Kill A,
|
|---|
| 597 | . . . . if KeepRec=3 do
|
|---|
| 598 | . . . . . do KillRec(B("IEN"))
|
|---|
| 599 | . . . . . do KillRec(A("IEN"))
|
|---|
| 600 | . . . . else write "?",KeepRec
|
|---|
| 601 | . . . if result=2 do ;"exact match
|
|---|
| 602 | . . . . do KillRec(B("IEN"))
|
|---|
| 603 |
|
|---|
| 604 | quit result
|
|---|
| 605 |
|
|---|
| 606 |
|
|---|
| 607 | WhichToKeep(A,B)
|
|---|
| 608 | ;"Purpose: Decide if to keep A or B
|
|---|
| 609 | ;"ONLY LOOKS AT NAME
|
|---|
| 610 | ;"Result: 0=Keep both
|
|---|
| 611 | ;" 1=Keep A & Kill B,
|
|---|
| 612 | ;" 2=Keep B & Kill A,
|
|---|
| 613 | ;" 3=Kill both,
|
|---|
| 614 |
|
|---|
| 615 | new NameA,NameB
|
|---|
| 616 | set NameA=$get(A(.01))
|
|---|
| 617 | set NameB=$get(B(.01))
|
|---|
| 618 | new lenA,lenB
|
|---|
| 619 | set lenA=$length(NameA)
|
|---|
| 620 | set lenB=$length(NameB)
|
|---|
| 621 | new result set result=0
|
|---|
| 622 |
|
|---|
| 623 | if NameA["ZZ" set result=2 ;"(Kill A)
|
|---|
| 624 | if NameB["ZZ" do
|
|---|
| 625 | . if result=2 set result=3 ;"Kill (A & B)
|
|---|
| 626 | . else set result=2 ;"(Kill A)
|
|---|
| 627 | if result>0 goto WTKDone
|
|---|
| 628 |
|
|---|
| 629 | new aIEN,bIEN
|
|---|
| 630 | set aIEN=$get(A("IEN"))
|
|---|
| 631 | set bIEN=$get(B("IEN"))
|
|---|
| 632 |
|
|---|
| 633 | ;"Because record A or B might have already been killed as part of another set,
|
|---|
| 634 | ;" Don't kill either if one already deleted.
|
|---|
| 635 | if $data(^TMP("TMG","KILLED",aIEN))>0 set result=3 W "%" goto WTKDone ;"no killing
|
|---|
| 636 | if $data(^TMP("TMG","KILLED",bIEN))>0 set result=3 W "%" goto WTKDone ;"no killing
|
|---|
| 637 |
|
|---|
| 638 | new AMainName,AInitial
|
|---|
| 639 | new BMainName,BInitial
|
|---|
| 640 | set AMainName=$piece(NameA," ",1)
|
|---|
| 641 | set BMainName=$piece(NameB," ",1)
|
|---|
| 642 | set AInitial=$piece(NameA," ",2)
|
|---|
| 643 | set BInitial=$piece(NameB," ",2)
|
|---|
| 644 |
|
|---|
| 645 | if (lenA>lenB)&($extract(NameA,1,lenB)=NameB) set result=1 ;"kill B
|
|---|
| 646 | else if (lenB>lenA)&($extract(NameB,1,lenA)=NameA) set result=2 ;"kill A
|
|---|
| 647 | else if NameA=NameB do
|
|---|
| 648 | . set result=1
|
|---|
| 649 | else if (AMainName=BMainName)&($length(AInitial)=1)&($length(BInitial)=1) do
|
|---|
| 650 | . ;"Names only differ by a one letter middle initial.
|
|---|
| 651 | . ;"Arbitrarily kill B
|
|---|
| 652 | . set result=1
|
|---|
| 653 | else do
|
|---|
| 654 | . new Answer
|
|---|
| 655 | . write !,"Which record to KILL?",!
|
|---|
| 656 | . write "a --> Kill: ",NameA,!
|
|---|
| 657 | . write "b --> Kill: ",NameB,!
|
|---|
| 658 | . write "x. --> Kill ",NameA,", but remember as ALIAS for ",NameB,!
|
|---|
| 659 | . write "y. --> Kill ",NameB,", but remember as ALIAS for ",NameA,!
|
|---|
| 660 | . write "^ --> KEEP BOTH",!
|
|---|
| 661 | . read Answer
|
|---|
| 662 | . if Answer="x" do AddAlias(NameA,bIEN) set Answer="a"
|
|---|
| 663 | . if Answer="y" do AddAlias(NameB,aIEN) set Answer="b"
|
|---|
| 664 | . if Answer="a" set result=2
|
|---|
| 665 | . if Answer="b" set result=1
|
|---|
| 666 |
|
|---|
| 667 | WTKDone
|
|---|
| 668 | ;"if result=0 do
|
|---|
| 669 | ;". zwr A(*)
|
|---|
| 670 | ;". zwr B(*)
|
|---|
| 671 | ;". new temp
|
|---|
| 672 | ;". read "Hit Enter",temp
|
|---|
| 673 | quit result
|
|---|
| 674 |
|
|---|
| 675 |
|
|---|
| 676 | AddAlias(AName,IEN)
|
|---|
| 677 | ;"Put Alias Name into record IEN
|
|---|
| 678 | new SubFNum set SubFNum=2.01 ;"Field 1 (alias) in File 2
|
|---|
| 679 |
|
|---|
| 680 | new TMGFDA,TMGMsg
|
|---|
| 681 |
|
|---|
| 682 | if $get(AName)'="" do
|
|---|
| 683 | . set TMGFDA(SubFNum,"?+1,"_IEN_",",.01)=AName
|
|---|
| 684 | . do UPDATE^DIE("EK","TMGFDA","TMGMsg")
|
|---|
| 685 | . if $data(TMGMsg("DILIST")) zwr TMGMsg(*)
|
|---|
| 686 | . set ^TMP("TMG","ALIAS-ADDED",IEN)=AName
|
|---|
| 687 | quit
|
|---|
| 688 |
|
|---|
| 689 |
|
|---|
| 690 | MergeAIntoB(DelRecN,SaveRecN)
|
|---|
| 691 | ;"Put Chat number from record to be deleted into Saved record
|
|---|
| 692 | ;" THEN delete the deletable record
|
|---|
| 693 | new ChartNum
|
|---|
| 694 | new TMGFDA
|
|---|
| 695 | new SubFNum set SubFNum=2.227005 ;"Field 22700.5 in File 2
|
|---|
| 696 |
|
|---|
| 697 | set ChartNum=$piece($get(^DPT(DelRecN,"TMG")),"^",1)
|
|---|
| 698 |
|
|---|
| 699 | if +ChartNum>0 do
|
|---|
| 700 | . set TMGFDA(SubFNum,"?+1,"_SaveRecN_",",.01)=ChartNum
|
|---|
| 701 | . do UPDATE^DIE("EK","TMGFDA","TMGMsg")
|
|---|
| 702 | . if $data(TMGMsg("DILIST")) zwr TMGMsg(*)
|
|---|
| 703 |
|
|---|
| 704 | do KillRec(DelRecN)
|
|---|
| 705 |
|
|---|
| 706 | quit
|
|---|
| 707 |
|
|---|
| 708 |
|
|---|
| 709 |
|
|---|
| 710 | KillRec(IEN)
|
|---|
| 711 | new TMGFDA
|
|---|
| 712 | write "#[",IEN,"]"
|
|---|
| 713 | merge ^TMP("TMG","KILLED",IEN)=^DPT(IEN)
|
|---|
| 714 |
|
|---|
| 715 | set TMGFDA(2,IEN_",",.01)="@"
|
|---|
| 716 | do FILE^DIE("EK","TMGFDA","TMGMsg")
|
|---|
| 717 | write "#"
|
|---|
| 718 | if $data(TMGMsg("DILIST")) write !,! zwr TMGMsg(*)
|
|---|
| 719 | quit
|
|---|
| 720 |
|
|---|
| 721 |
|
|---|
| 722 | CompRecs(A,B)
|
|---|
| 723 | new result set result=0
|
|---|
| 724 |
|
|---|
| 725 | if $get(A(.03))=$get(B(.03)) do
|
|---|
| 726 | . if $get(A(.02))=$get(B(.02)) do
|
|---|
| 727 | . . set result=1
|
|---|
| 728 | . . if $get(A(.01))=$get(B(.01)) do
|
|---|
| 729 | . . . if $get(A(.09))=$get(B(.09)) do
|
|---|
| 730 | . . . . set result=2 ;"exact match
|
|---|
| 731 |
|
|---|
| 732 |
|
|---|
| 733 | quit result
|
|---|
| 734 |
|
|---|
| 735 |
|
|---|
| 736 | FixFName(CurPt)
|
|---|
| 737 |
|
|---|
| 738 | new lname,fname,PtName
|
|---|
| 739 | set lname=$piece(CurPt,",",1)
|
|---|
| 740 | set fname=$piece(CurPt,",",2)
|
|---|
| 741 | new name set name=$$FixName(.lname,.fname)
|
|---|
| 742 |
|
|---|
| 743 | quit name
|
|---|
| 744 |
|
|---|
| 745 |
|
|---|
| 746 | FixName(lname,fname)
|
|---|
| 747 | ;"Purpose: change III,ALLEN J BROWN to BROWN,ALLEN J III
|
|---|
| 748 | ;"Results: returns BROWN,ALLEN J III
|
|---|
| 749 | new NameArray
|
|---|
| 750 | new MaxNode
|
|---|
| 751 | new Suffix set Suffix=lname
|
|---|
| 752 | new i,s
|
|---|
| 753 |
|
|---|
| 754 | set s=fname set fname=""
|
|---|
| 755 | do CleaveToArray^TMGSTUTL(s," ",.NameArray,1)
|
|---|
| 756 | set MaxNode=+$get(NameArray("MAXNODE"))
|
|---|
| 757 | if MaxNode=0 goto FixDone
|
|---|
| 758 | set lname=NameArray(MaxNode)
|
|---|
| 759 | for i=1:1:MaxNode-1 do
|
|---|
| 760 | . set fname=fname_NameArray(i)_" "
|
|---|
| 761 | set fname=fname_Suffix
|
|---|
| 762 |
|
|---|
| 763 | new result
|
|---|
| 764 | set result=lname_","_fname
|
|---|
| 765 |
|
|---|
| 766 | FixDone
|
|---|
| 767 | quit result
|
|---|
| 768 |
|
|---|
| 769 |
|
|---|
| 770 |
|
|---|
| 771 | FixAllNames
|
|---|
| 772 | ;"ENTRY POINT...
|
|---|
| 773 | ;"Purge: To change all names that erroneously have a last name of "SR","JR","III","II"
|
|---|
| 774 | new index
|
|---|
| 775 | new PtName,index
|
|---|
| 776 |
|
|---|
| 777 | ;new Matches,TMGMsg
|
|---|
| 778 | new FileNumber,IENS,Fields,Flags,MatchValue,ScreenCode
|
|---|
| 779 | set FileNumber=2
|
|---|
| 780 | set IENS=""
|
|---|
| 781 | set Fields="@;.01;.02;.03;.09;22700"
|
|---|
| 782 | set Flags=""
|
|---|
| 783 | set ScreenCode=""
|
|---|
| 784 |
|
|---|
| 785 | for PtName="JR,","SR,","III,","II" do
|
|---|
| 786 | . write "Looking for patients with a last name of: ",PtName,!
|
|---|
| 787 | . set MatchValue=PtName
|
|---|
| 788 | . ;"Call FIND^DIC
|
|---|
| 789 | . ;"FILE,IENS,FIELDS,FLAGS,VALUE,NUMBER,INDEXES,SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOTS
|
|---|
| 790 | . do FIND^DIC(FileNumber,IENS,Fields,Flags,MatchValue,"*",,ScreenCode,,"Matches","TMGMsg")
|
|---|
| 791 | . ;"======================================================
|
|---|
| 792 | . if $data(Matches("DILIST",0))'=0 do
|
|---|
| 793 | . . ;"write "Here are the names found:",!
|
|---|
| 794 | . . ;"zwr Matches("DILIST",*)
|
|---|
| 795 | . . new NumMatches set NumMatches=$piece(Matches("DILIST",0),"^",1)
|
|---|
| 796 | . . write "Found "_NumMatches_" matches.",!
|
|---|
| 797 | . . if NumMatches>1 for index=1:1:NumMatches do
|
|---|
| 798 | . . . write "index=",index,!
|
|---|
| 799 | . . . new IEN set IEN=Matches("DILIST",2,index)
|
|---|
| 800 | . . . write "IEN=",IEN,!
|
|---|
| 801 | . . . new OldName set OldName=$piece($get(^DPT(IEN,0)),"^",1)
|
|---|
| 802 | . . . write "OldName=",OldName,!
|
|---|
| 803 | . . . new NewName set NewName=$$FixFName(OldName)
|
|---|
| 804 | . . . new IENS set IENS=IEN_","
|
|---|
| 805 | . . . write "Changing "_OldName_" to "_NewName,!
|
|---|
| 806 | . . . ;new TMGFDA
|
|---|
| 807 | . . . set TMGFDA(FileNumber,IENS,.01)=NewName
|
|---|
| 808 | . . . kill TMGMsg
|
|---|
| 809 | . . . write "Calling FILE^DIE",!
|
|---|
| 810 | . . . write "TMGFDA:",!
|
|---|
| 811 | . . . zwr TMGFDA(*)
|
|---|
| 812 | . . . do FILE^DIE("EK","TMGFDA","TMGMsg")
|
|---|
| 813 | . . . write "Done Calling FILE^DIE",!
|
|---|
| 814 | . . . if $data(TMGMsg) zwr TMGMsg(*)
|
|---|
| 815 |
|
|---|
| 816 | write !,!,!,"Done!",!
|
|---|
| 817 |
|
|---|
| 818 | quit
|
|---|
| 819 |
|
|---|
