TMGNDF2G ;TMG/kst/FDA Import: Setup shortened drug names ;03/25/06 ;;1.0;TMG-LIB;**1**;02/24/07 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS ;" Creation of shortened version of drug names ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"2-24-2007 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"Menu -- Ensure other version of drug names available. ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"MakeAltNames -- scan through all entries and set up shortened names. ;"Make1Alt(IEN) --fix the names for just 1 record in 22706.9 ;"GetIENArray(Array) -- Gather IENS to work on ;"GetPrepArray(IENArray,PrepArray) -- Prepare names for addition into 40 length fields ;"PrepNames(IEN,Value55,Value56,Value75,Value76,PrepArray,AllowCut) -- Get names for IEN ;"AskArray(IENArray,PrepArray) -- get array with possible fixes for 1 record ;"Write1(IEN,name55,name56,name75,namd76) --write 1 record in 22706.9 file ;"DispFixArray(PrepArray,MapArray,compactMode) -- Display values in PrepArray ;"======================================================================= Menu ;"Purpose: -- Ensure shortened version of drug names available. new Menu,UsrSlct set Menu(0)="Pick Option to Ensure All Versions of Names (2G)" set Menu(1)="Ensure all drug names are ready"_$char(9)_"MakeAltNames" set Menu(2)="Check for blank names"_$char(9)_"CheckForBlanks" set Menu(3)="Check for BAD names"_$char(9)_"ScanBadName" set Menu(4)="Ask and fix name for ONE import"_$char(9)_"FixOneName" set Menu("P")="Prev Stage"_$char(9)_"Prev" set Menu("N")="Next Stage"_$char(9)_"Next" M1 write # set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") if UsrSlct="MakeAltNames" do MakeAltNames goto M1 if UsrSlct="CheckForBlanks" do CheckForBlanks goto M1 if UsrSlct="FixOneName" do AskMake1 goto M1 if UsrSlct="ScanBadName" do ScanBadName goto M1 if UsrSlct="Prev" goto Menu^TMGNDF2E ;"quit can occur from there... if UsrSlct="Next" goto Menu^TMGNDF2H ;"quit can occur from there... if UsrSlct="^" goto MenuDone if UsrSlct=0 set UsrSlct="" goto M1 MenuDone quit ;"======================================================================================= ;"======================================================================================= MakeAltNames ;"Purpose: To scan through all entries and set up alternative names. ;"Input: none ;"Results: none. ;"Output: Fields .055, .056, .075, .076 will be filled ;"Results: none new IENArray,PrepArray write "Scanning existing names of imports not skipped...",! do GetIENArray(.IENArray) write "Preparing suggested names...",! do GetPrepArray(.IENArray,.PrepArray) if $data(PrepArray)=0 do goto MKSNDone . write "No fixes required. Great!",! . do PressToCont^TMGUSRIF do AskArray(.IENArray,.PrepArray) MKSNDone write "Goodbye.",! quit AskMake1 ;"Purpose: Ask user for record in 22706.9, and then fix new DIC,X,Y set DIC=22706.9,DIC(0)="MAEQ" do ^DIC write ! if +Y>0 do Make1Alt(+Y) quit Make1Alt(IEN,Option) ;"Purpose: to fix the names for just 1 record in 22706.9 ;"Input: IEN -- IEN in 22706.9 ;" Option -- OPTIONAL. Format: ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward ;" to file 50, POI, OI, OQV etc. ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN ;"Note: ignores if drug is to be skipped. new IENArray,PrepArray set IENArray(IEN,.04)=$piece($get(^TMG(22706.9,IEN,7)),"^",6) ;" .04, LONG NAME set IENArray(IEN,.055)=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;".055, TRADENAME - 40 set IENArray(IEN,.056)=$piece($get(^TMG(22706.9,IEN,8)),"^",1) ;".056, TRADENAME DOSE UNIT FORM - 40 set IENArray(IEN,.075)=$piece($get(^TMG(22706.9,IEN,7)),"^",4) ;".075, GENERIC NAME - 40 set IENArray(IEN,.076)=$piece($get(^TMG(22706.9,IEN,8)),"^",1) ;".076 GENERICNAME DOSE UNT FORM - 40 do GetPrepArray(.IENArray,.PrepArray,0) ;"0=no allow cut if $data(PrepArray)=0 do goto MKSNDone . write "No drug name fixes required. Great!",! . do PressToCont^TMGUSRIF do AskArray(.IENArray,.PrepArray) if $get(Option("FIX CHAIN"))=1 do . set OPTION("FIX CHAIN","IEN22706d9")=IEN . do Refresh1^TMGNDF3C(IEN22706d9,.Option) M1ADone write "Goodbye.",! quit GetIENArray(Array) ;"Purpose: Gather IENS to work on ;"Input: Array -- PASS BY REFERENCE Output Format: ;" Note: IEN is from file 22706.9 ;" Array(IEN,.04)=currentValue ;" Array(IEN,.05)=currentValue ;" Array(IEN,.055)=currentValue ;" Array(IEN,.056)=currentValue ;" Array(IEN,.07)=currentValue ;" Array(IEN,.075)=currentValue ;" Array(IEN,.076)=currentValue ;"Results: none new Itr,IEN new abort set abort=0 set IEN=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP . new s0,s7,s8 . set s0=$get(^TMG(22706.9,IEN,0)) . set s7=$get(^TMG(22706.9,IEN,7)) . set s8=$get(^TMG(22706.9,IEN,8)) . set Array(IEN,.04)=$piece(s7,"^",6) ;" .04 LONG NAME . set Array(IEN,.05)=$piece(s0,"^",4) ;" .05 TRADENAME . set Array(IEN,.055)=$piece(s7,"^",3) ;".055 TRADENAME - 40 . set Array(IEN,.056)=$piece(s8,"^",1) ;".056 TRADENAME DOSE UNIT FORM - 40 . set Array(IEN,.07)=$piece(s0,"^",6) ;" .07 GENERIC NAME . set Array(IEN,.075)=$piece(s7,"^",4) ;".075 GENERIC NAME - 40 . set Array(IEN,.076)=$piece(s8,"^",2) ;".076 GENERICNAME DOSE UNT FORM - 40 quit GetPrepArray(IENArray,PrepArray,AllowCut) ;"Purpose: Prepare names for addition into .055 (TRADENAME - 40) ;" and .075 (GENERIC NAME - 40) fields ;"Input: IENArray -- PASS BY REFERENCE Format: ;" Array(IEN,.04)=currentValue ;" Array(IEN,.055)=currentValue ;" Array(IEN,.075)=currentValue ;" PrepArray -- PASS BY REFERENCE Format: ;" PrepArray(IEN1,.04)=Name for .04 ;" PrepArray(IEN1,.055)=Name for .055 ;" PrepArray(IEN1,.056)=Name for .056 ;" PrepArray(IEN1,.075)=Name for .075 ;" PrepArray(IEN1,.076)=Name for .076 ;" AllowCut -- OPTIONAL. Default=1. If 1, then automatic shortening of names allowed ;"Output: PrepArray is Filled ;"Results: none set AllowCut=$get(AllowCut,1) new Itr,IEN,abort set abort=0 set IEN=$$ItrAInit^TMGITR("IENArray",.Itr) do PrepProgress^TMGITR(.Itr,20,1,"IEN") if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort . if $$UserAborted^TMGUSRIF() set abort=1 quit . new Cur04Value set Cur04Value=$get(IENArray(IEN,.04)) . new Cur55Value set Cur55Value=$get(IENArray(IEN,.055)) . new Cur56Value set Cur56Value=$get(IENArray(IEN,.056)) . new Cur75Value set Cur75Value=$get(IENArray(IEN,.075)) . new Cur76Value set Cur76Value=$get(IENArray(IEN,.076)) . set abort=$$PrepNames(IEN,Cur04Value,Cur55Value,Cur56Value,Cur75Value,Cur76Value,.PrepArray,AllowCut) do ProgressDone^TMGITR(.Itr) quit PrepNames(IEN,Value04,Value55,Value56,Value75,Value76,PrepArray,AllowCut) ;"Purpose: To get names for IEN ;"Input: IEN -- the ien in file 22706.9 ;" Value04 -- the current value for field .04 ;" Value55 -- the current value for field .055 ;" Value56 -- the current value for field .056 ;" Value75 -- the current value for field .075 ;" Value76 -- the current value for field .076 ;" PrepArray -- PASS BY REFERENCE. and OUT PARAMETER. ;" Format: ;" PrepArray(IEN,.04)=Name for .04 ;" PrepArray(IEN,.055)=Name for .055 ;" PrepArray(IEN,.056)=Name for .056 ;" PrepArray(IEN,.075)=Name for .075 ;" PrepArray(IEN,.076)=Name for .076 ;" AllowCut -- OPTIONAL. Default=1. If 1 then user not prompted to shorten names ;"Output: PrepArray is Filled ;"Results: 0=OK to Continue, 1=abort new result set result=0 set AllowCut=$get(AllowCut,1) new MaxLen set MaxLen=40 ;"==Set up .04 Name (LONG NAME) ========================== new New04Value set New04Value=$$MakeName(IEN,63,AllowCut,1) ;",1) Mode=Full Name if New04Value="^" set result=1 goto PNDone if $length(New04Value)>63 do . set New04Value=$extract(New04Value,1,63-3)_"..." if (New04Value["...")&(Value04'["...")&(Value04'="") set New04Value="" if (New04Value'=Value04)&(New04Value'="") do . set PrepArray(IEN,.04)=New04Value ;"==Set up .075 Name (GENERIC NAME & FORM - 40)=========== new New75Value set New75Value=$$MakeName(IEN,MaxLen,AllowCut,5) ;",5) Mode=Generic Name if New75Value="^" set result=1 goto PNDone if $length(New75Value)>MaxLen do . set New75Value=$extract(New75Value,1,MaxLen-3)_"..." if (New75Value["...")&(Value75'["...")&(Value75'="") set New75Value="" if (New75Value'=Value75)&(New75Value'="") do . set PrepArray(IEN,.075)=New75Value ;"==Set up .076 Name (GENERICNAME FORM DOSE UNT - 40) ==== new New76Value set New76Value=$$MakeName(IEN,MaxLen,AllowCut,3) ;"3 -> GenericName DrugForm Strength Units if New76Value="^" set result=1 goto PNDone if $length(New76Value)>MaxLen do . set New76Value=$extract(New76Value,1,MaxLen-3)_"..." if (New76Value["...")&(Value76'["...")&(Value76'="") set New76Value="" if (New76Value'=Value76)&(New76Value'="") do . set PrepArray(IEN,.076)=New76Value ;"==Set up .055 Name (TRADE NAME & FORM - 40) ============ new New55Value set New55Value=$$MakeName(IEN,MaxLen,AllowCut,4) ;",4) Mode=TradeName if New55Value="^" set result=1 goto PNDone if $length(New55Value)>MaxLen do . set New55Value=$extract(New55Value,1,MaxLen-3)_"..." if (New55Value["...")&(Value55'["...")&(Value55'="") set New55Value="" if New55Value=New75Value set New55Value="" ;"WAS "@" if (New55Value'=Value55)&(New55Value'="") do . ;"if (New55Value="@")&(Value55="") quit . set PrepArray(IEN,.055)=New55Value ;"==Set up .056 Name (TRADENAME FORM DOSE UNIT - 40) ==== new New56Value set New56Value=$$MakeName(IEN,MaxLen,AllowCut,6) ;"6 -> TradeName DrugForm Strength Units if New56Value="^" set result=1 goto PNDone if $length(New56Value)>MaxLen do . set New56Value=$extract(New56Value,1,MaxLen-3)_"..." if (New56Value["...")&(Value56'["...")&(Value56'="") set New56Value="" if New56Value=New76Value set New56Value="" ;"WAS "@" if (New56Value'=Value56)&(New56Value'="") do . ;"if (New56Value="@")&(Value56="") quit . set PrepArray(IEN,.056)=New56Value PNDone quit result MakeName(IEN,MaxLen,AllowCut,Mode) ;"Purpose: to make a special name from drug info ;"Input: IEN -- IEN in file 22706.9 ;" MaxLen -- OPTIONAL. default=256. The maximum length ;" AllowCut -- OPTIONAL If 1 then name may be cut off with ... to reach target length ;" If 2 then name will be shorteneded as much as possible, but the ;" name will NOT be cut off to reach MaxLen ;" default=1 ;" Mode -- OPTIONAL. Default=1. ;" //1 -> GenericName (TradeName) Strength Units ;" 1 -> TradeName (GenericName) Strength Units ;changed 10/30/07 ;" 2 -> TradeName Strength Units ;" 3 -> GenericName DrugForm Strength Units ;" 4 -> TradeName (includes Drug Form) ;" 5 -> GenericName DrugForm ;" 6 -> TradeName DrugForm Strength Units ;"results: special composite name, or "^" for user abort set AllowCut=$get(AllowCut,1) set MaxLen=$get(MaxLen,256) set Mode=$get(Mode,1) new TMGunits,TMGstrength,TMGTradeName,tempS new vaGeneric,vagIEN set vagIEN=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"VA GENERIC <-Pntr [P50.6'] set vaGeneric=$$GET1^DIQ(50.6,vagIEN,.01) if vaGeneric="" set vaGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) set TMGTradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;".05 TRADENAME [F] ;e.g. DILTIAZEM HCL SR CAPSULES if $extract(TMGTradeName,1)="." set TMGTradeName="0"_TMGTradeName ;".9% saline (rejected) --> 0.9% (acceptible) if TMGTradeName["..." set TMGTradeName=$$Substitute^TMGSTUTL(TMGTradeName,"...","") set TMGstrength=$piece($get(^TMG(22706.9,IEN,0)),"^",2) ;"1 STRENGTH [F] ;e.g. 240 set TMGunits=$piece($get(^TMG(22706.9,IEN,0)),"^",3) ;"2 UNIT [F] ;e.g. MG new vadfIEN set vadfIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",7) ;"3.5 VA DOSAGE FORM new vaDoseForm if vadfIEN>0 set vaDoseForm=$piece($get(^PS(50.606,vadfIEN,0)),"^",1) ;".01 NAME else set vaDoseForm="" new hideGeneric set hideGeneric=0 new tempS if Mode=1 do ;"1 -> TradeName (GenericName) Strength Units . ;"if $extract(TMGTradeName,1,$length(vaGenericName))=vaGenericName do . if $extract(TMGTradeName,1,$length(vaGeneric))=vaGeneric do . . set tempS=TMGTradeName . . if TMGstrength'="" set tempS=tempS_" "_TMGstrength . . if TMGunits'="" set tempS=tempS_" "_TMGunits . . set hideGeneric=1 . else do . . ;"set tempS=vaGeneric_" ("_TMGTradeName_")" . . set tempS=TMGTradeName_" ("_vaGeneric_")" . . if TMGstrength'="" set tempS=tempS_" "_TMGstrength . . if TMGunits'="" set tempS=tempS_" "_TMGunits . if $length(tempS)>MaxLen do . . set tempS=$$ShortNetName^TMGSHORT(vaGeneric,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut) if Mode=2 do ;"2 -> TradeName Strength Units . set tempS=TMGTradeName . if TMGstrength'="" set tempS=tempS_" "_TMGstrength . if TMGunits'="" set tempS=tempS_" "_TMGunits . if $length(tempS)>MaxLen do . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut) if Mode=3 do ;"3 -> GenericName DrugForm Strength Units . set tempS=vaGeneric . if vaDoseForm'="" set tempS=tempS_" "_vaDoseForm . if TMGstrength'="" set tempS=tempS_" "_TMGstrength . if TMGunits'="" set tempS=tempS_" "_TMGunits . if $length(tempS)>MaxLen do . . set tempS=$$ShortNetName^TMGSHORT(vaGeneric,,TMGstrength,TMGunits,MaxLen,.AllowCut) if Mode=4 do ;"4 -> TradeName (includes Drug Form) . set tempS=TMGTradeName . if $length(tempS)>MaxLen do . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,,,MaxLen,.AllowCut) if Mode=5 do ;"5 -> GenericName DrugForm . set tempS=vaGeneric . if vaDoseForm'="" set tempS=tempS_" "_vaDoseForm . if $length(tempS)>MaxLen do . . set tempS=$$ShortNetName^TMGSHORT(tempS,,,,MaxLen,.AllowCut) if Mode=6 do ;" 6 -> TradeName DrugForm Strength Units . set tempS=TMGTradeName ;"Note: TradeName includes Drug Form . if TMGstrength'="" set tempS=tempS_" "_TMGstrength . if TMGunits'="" set tempS=tempS_" "_TMGunits . if $length(tempS)>MaxLen do . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut) set tempS=$$Trim^TMGSTUTL(tempS) if $extract(tempS,1,1)="(" do ;"Input transform doesn't allow first chart to be '(' . ;"NOTE: I should write better code to change only the LAST ) to "", i.e. not cut out ALL ()'s . set tempS=$translate(tempS,"(","") . set tempS=$translate(tempS,")","") if $extract(tempS,1,1)="/" do ;"Input transform doesn't allow first chart to be '/' . set tempS=$extract(tempS,2,999) set tempS=$translate(tempS,";",":") ;"some input transforms don't allow ';' character quit tempS AskArray(IENArray,PrepArray) ;"Purpose: to get array with possible fixes for one record in 22706.9 file ;"Input: Array -- PASS BY REFERENCE (Used if rescanning needed) ;" Array(IEN)="" ;" Array(IEN)="" ;" FixArray -- PASS BY REFERENCE. Format: ;" FixArray(IEN,.04)=Name for .04 ;" FixArray(IEN,.055)=Name for .055 ;" FixArray(IEN,.056)=Name for .056 ;" FixArray(IEN,.075)=Name for .075 ;" FixArray(IEN,.076)=Name for .076 ;"Results: None ;"Output: records in 50.68 will be changed, field .055,.056,.075, and .076 will be checked and fixed new input,list new cmd,nums new compactMode set compactMode=1 new MapArray AA1 do DispFixArray(.PrepArray,.MapArray,compactMode) write !,"E to manually edit entries; D to delete (skip) entries",! write "R to rescan; A To accept entries",! write "C turn Compact display ",$select((compactMode=1):"OFF",1:"ON"),! write "ALL to accept all entries WITHOUT any '...'s",!! read "Enter Option: ^// ",input:$get(DTIME,3600),! if input="" set input="^" set input=$$UP^XLFSTR(input) if input="^" goto AADone set nums="" set cmd=input if cmd="E" do goto AA1 . if nums="" do . . write "Enter number(s) to edit (#,#-#, etc; ^ to quit): " . . read nums:$get(DTIME,3600),! . if '$$MkMultList^TMGMISC(nums,.list) quit . new num set num="" . for set num=$order(list(num)) quit:(num="") do . . new IEN,name04,name55,name75,result . . set IEN=$get(MapArray(num)) if IEN="" quit . . set name04=$get(PrepArray(IEN,.04)) . . set name55=$get(PrepArray(IEN,.055)) . . set name56=$get(PrepArray(IEN,.056)) . . set name75=$get(PrepArray(IEN,.075)) . . set name76=$get(PrepArray(IEN,.076)) AA2 . . set result=$$PrepNames(IEN,name04,name55,name56,name75,name76,.PrepArray,0) . . if result=1 quit . . new new04Name set new04Name=$get(PrepArray(IEN,.004)) . . new new55Name set new55Name=$get(PrepArray(IEN,.055)) . . new new56Name set new56Name=$get(PrepArray(IEN,.056)) . . new new75Name set new75Name=$get(PrepArray(IEN,.075)) . . new new76Name set new76Name=$get(PrepArray(IEN,.076)) . . if new04Name=name04 set new04Name="" . . if new55Name=name55 set new55Name="" . . if new56Name=name56 set new56Name="" . . if new75Name=name75 set new75Name="" . . if new76Name=name76 set new76Name="" . . set result=$$Write1(IEN,new04Name,new55Name,new56Name,new75Name,new76Name) . . if result=0 kill PrepArray(IEN) if cmd="C" do goto AA1 . set compactMode='compactMode if cmd="ALL" do GOTO AA1 . new Itr,IEN,abort . set abort=0 . set IEN=$$ItrAInit^TMGITR("PrepArray",.Itr) . write "Storing accepted names for future use...",! . do PrepProgress^TMGITR(.Itr,20,1,"IEN") . if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort . . if $$UserAborted^TMGUSRIF() set abort=1 quit . . new name04,name55,name56,name75,name76,result . . set name04=$get(PrepArray(IEN,.04)) . . set name55=$get(PrepArray(IEN,.055)) . . set name56=$get(PrepArray(IEN,.056)) . . set name75=$get(PrepArray(IEN,.075)) . . set name76=$get(PrepArray(IEN,.076)) . . if name04["..." set name04="" . . if name55["..." set name55="" . . if name56["..." set name56="" . . if name75["..." set name75="" . . if name76["..." set name76="" . . if (name04="")&(name55="")&(name56="")&(name75="")&(name76="") quit ;"avoid delete of names with ... . . set result=$$Write1(IEN,name04,name55,name56,name75,name76) . . if result=0 kill IENArray(IEN),PrepArray(IEN) . do ProgressDone^TMGITR(.Itr) ;"if (cmd="A")!(+cmd=cmd) do goto AA1 if (cmd="A") do goto AA1 . if nums="" do . . write "Enter number(s) to accept (#,#-#, etc; ^ to quit): " . . read nums:$get(DTIME,3600),! . if '$$MkMultList^TMGMISC(nums,.list) quit . new num set num="" . for set num=$order(list(num)) quit:(num="") do . . new IEN set IEN=$get(MapArray(num)) if IEN="" quit . . new name04,name55,name75,result . . set name04=$get(PrepArray(IEN,.04)) . . set name55=$get(PrepArray(IEN,.055)) . . set name56=$get(PrepArray(IEN,.056)) . . set name75=$get(PrepArray(IEN,.075)) . . set name76=$get(PrepArray(IEN,.076)) . . new result set result=$$Write1(IEN,name04,name55,name56,name75,name76) . . if result=0 kill IENArray(IEN),PrepArray(IEN) else if $extract(cmd,1)="D" do goto AA1 . new Perm,% set Perm=0,%=2 . write "Will remove from display list.",! . write "Also perminantly mark drug so be SKIPPED" . do YN^DICN write ! . if %=-1 quit . if %=1 set Perm=1 . set nums=$extract(cmd,2,999) . if nums="" do . . write "Enter number(s) to delete (#,#-#, etc; ^ to quit): " . . read nums:$get(DTIME,3600),! . if '$$MkMultList^TMGMISC(nums,.list) quit . new num set num="" . for set num=$order(list(num)) quit:(num="") do . . new IEN set IEN=+$get(MapArray(num)) if IEN="" quit . . kill PrepArray(IEN),IENArray(IEN) . . if (Perm=1)&(IEN>0) set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"1=SKIP else if cmd="R" do goto AA1 . kill PrepArray . do GetPrepArray(.IENArray,.PrepArray) goto AA1 AADone quit Write1(IEN,name04,name55,name56,name75,name76) ;"Purpose to write 1 record in 22706.9 file ;"Input: IEN -- the ien in file 22706.9 ;" name04 -- OPTIONAL name for .04 field ;" name55 -- OPTIONAL name for .055 field ;" name56 -- OPTIONAL name for .056 field ;" name75 -- OPTIONAL name for .075 field ;" name76 -- OPTIONAL name for .076 field ;"Output: records in 22706.9 will be changed, field .055 and .075 will be checked and fixed ;"Results: 0 = OK. -1=error new result set result=0 ;"default to success new TMGFDA,TMGIEN,TMGMSG,IENS set IENS=IEN_"," if $get(name04)'="" set TMGFDA(22706.9,IENS,.04)=name04 if $get(name55)'="" set TMGFDA(22706.9,IENS,.055)=name55 if $get(name56)'="" set TMGFDA(22706.9,IENS,.056)=name56 if $get(name75)'="" set TMGFDA(22706.9,IENS,.075)=name75 if $get(name76)'="" set TMGFDA(22706.9,IENS,.076)=name76 if $data(TMGFDA)>0 do FILE^DIE("EK","TMGFDA","TMGMSG") if $data(TMGMSG("DIERR")) do goto W1NDone . set result=-1 . if $get(Quiet)=1 quit . write !,"Error writing names to file 22706.9, record# ",IEN,! . new PriorErrorFound . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) set result=0 W1NDone quit result DispFixArray(PrepArray,MapArray,compactMode) ;"Purpose: to Display values in PrepArray ;"Input: PrepArray array will be filled as follows: ;" PrepArray(IEN1,.04)=Name for .04 ;" PrepArray(IEN1,.055)=Name for .055 ;" PrepArray(IEN1,.056)=Name for .056 ;" PrepArray(IEN1,.075)=Name for .075 ;" PrepArray(IEN1,.076)=Name for .076 ;" MapArray PASS BY REFERENCE, an OUT PARAMETER ;" MapPrep(1)=IEN ;" MapPrep(2)=IEN ;" MapPrep(3)=IEN ;" MapPrep(4)=IEN ;" compactMode -- OPTIONAL. Default=1 ;" if =1, then only end of list shown ;"Output: will dump array ;"Result: none write ! write "--------------------",! kill MapArray new IEN,Num set Num=1 set compactMode=$get(compactMode,1) new someShown set someShown=0 if compactMode=0 do set IEN=$order(PrepArray("")) else do . new i . set IEN="" . for i=1:1:10 do quit:(IEN="") . . set IEN=$order(PrepArray(IEN),-1) . if IEN="" set IEN=$order(PrepArray("")) if +IEN>0 for do quit:(IEN="") . new s,s2,name04,name55,name56,name75,name76 . set MapArray(Num)=IEN . set someShown=1 . set s=Num_". " . set s=s_"["_IEN_"] " ;"temporary . set s2=$extract(" ",1,$length(s)) . set name04=$get(PrepArray(IEN,.04)) . set name55=$get(PrepArray(IEN,.055)) . set name56=$get(PrepArray(IEN,.056)) . set name75=$get(PrepArray(IEN,.075)) . set name76=$get(PrepArray(IEN,.076)) . write s . if name04'="" do . . write name04,! . . if name55'="" write s2 . if name55'="" do . . write name55,! . . if name75'="" write s2 . if name75'="" write name75,! . if name56'="" write name56,! . if name76'="" write name76,! . set IEN=$order(PrepArray(IEN)) . set Num=Num+1 if someShown=0 write " (List is empty)",! write "--------------------",! quit CheckForBlanks new IENArray,BlankArray new PrepArray write "Scanning existing names of imports not skipped...",! do GetIENArray(.IENArray) write "Checking for blank names...",! do Check4Blanks(.IENArray,.BlankArray) new fixNeeded set fixNeeded=0 if $data(BlankArray)'=0 do . write "Preparing suggested names...",! . do GetPrepArray(.BlankArray,.PrepArray) . if $data(PrepArray)'=0 do . . set fixNeeded=1 . . do AskArray(.BlankArray,.PrepArray) if fixNeeded=0 do . write "No fixes required. Great!",! . do PressToCont^TMGUSRIF quit Check4Blanks(IENArray,BlankArray) ;"Purpose: Check if any of the fields are blank and allow fixing ;"Input: IENArray -- PASS BY REFERENCE (Used if rescanning needed) ;" IENArray(IEN,.04)=currentValue ;" IENArray(IEN,.055)=currentValue ;" IENArray(IEN,.056)=currentValue ;" IENArray(IEN,.075)=currentValue ;" IENArray(IEN,.076)=currentValue ;" BlankArray -- PASS BY REFERENCE. An OUT PARAMETER. Format: ;" BlankArray(IEN,.04)=Name for .04 ;" BlankArray(IEN,.055)=Name for .055 ;" BlankArray(IEN,.056)=Name for .056 ;" BlankArray(IEN,.075)=Name for .075 ;" BlankArray(IEN,.076)=Name for .076 ;"Results: none new Itr,IEN,abort set abort=0 set IEN=$$ItrAInit^TMGITR("IENArray",.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort . if $$UserAborted^TMGUSRIF() set abort=1 quit . new Cur04Value set Cur04Value=$get(IENArray(IEN,.04)) . new Cur55Value set Cur55Value=$get(IENArray(IEN,.055)) . new Cur56Value set Cur56Value=$get(IENArray(IEN,.056)) . new Cur75Value set Cur75Value=$get(IENArray(IEN,.075)) . new Cur76Value set Cur76Value=$get(IENArray(IEN,.076)) . if (Cur04Value="")!(Cur55Value="")!(Cur56Value="")!(Cur75Value="")!(Cur76Value="") do . . write IEN,?8," .04 (LONG NAME) = ",Cur04Value,! . . write ?8,".055 (TRADENAME) = ",Cur55Value,! . . write ?8,".056 (TRADENAME FORM DOSE UNIT)= ",Cur56Value,! . . write ?8,".075 (GENERIC NAME & FORM) = ",Cur75Value,! . . write ?8,".076 (GENERICNAME FORM DOSE UNT) = ",Cur76Value,! . . merge BlankArray(IEN)=IENArray(IEN) do ProgressDone^TMGITR(.Itr) quit ;"========================================== ScanBadName ;"Purpose: scan for bad names, and debug the problem. ;"Input: none ;"Results: none new IENArray,PrepArray write "Scanning existing names of imports not skipped...",! do GetIENArray(.IENArray) new Menu,UsrSlct set Menu(0)="Pick Which Name to Examine (2G)" set Menu(1)=" .04 LONG NAME"_$char(9)_"LongName" set Menu(2)=" .05 TRADENAME"_$char(9)_"TradeName" set Menu(3)=".055 TRADE NAME & FORM - 40"_$char(9)_"TradeF" set Menu(4)=".056 TRADENAME FORM DOSE UNIT - 40"_$char(9)_"TradeFDU" set Menu(5)=" .07 GENERIC NAME"_$char(9)_"Generic" set Menu(6)=".075 GENERIC NAME & FORM - 40"_$char(9)_"GenericF" set Menu(7)=".076 GENERICNAME FORM DOSE UNT - 40"_$char(9)_"GenrcFDU" SBN1 write # set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") if UsrSlct="LongName" do Scan(.IENArray,.04,"LONG NAME") goto SBN1 if UsrSlct="TradeName" do Scan(.IENArray,.055,"TRADENAME") goto SBN1 if UsrSlct="TradeF" do Scan(.IENArray,.055,"TRADE NAME & FORM - 40") goto SBN1 if UsrSlct="TradeFDU" do Scan(.IENArray,.056,"TRADENAME FORM DOSE UNIT - 40") goto SBN1 if UsrSlct="Generic" do Scan(.IENArray,.07,"GENERIC NAME") goto SBN1 if UsrSlct="GenericF" do Scan(.IENArray,.075,"GENERIC NAME & FORM - 40") goto SBN1 if UsrSlct="GenrcFDU" do Scan(.IENArray,.076,"GENERICNAME FORM DOSE UNT - 40") goto SBN1 if UsrSlct="^" goto SBN2 goto SBN1 SBN2 quit Scan(IENArray,FieldNum,FldName) ;"Purpose: to do scan ;"Input: -- IENArray -- PASS BY REFERENCE. Format: ;" Note: IEN is from file 22706.9 ;" Array(IEN,.04)=currentValue ;" Array(IEN,.05)=currentValue ;" Array(IEN,.055)=currentValue ;" Array(IEN,.056)=currentValue ;" Array(IEN,.07)=currentValue ;" Array(IEN,.075)=currentValue ;" Array(IEN,.076)=currentValue new SrchRec new Itr,IEN,abort set abort=0 set IEN=$$ItrAInit^TMGITR("IENArray",.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort . if $$UserAborted^TMGUSRIF() set abort=1 quit . new s set s=$get(IENArray(IEN,FieldNum)) . if (s="")!(s="") quit . set SrchRec(s_" (#"_IEN_")",IEN_"^22706.9")="" do ProgressDone^TMGITR(.Itr) new Results write "Passing off to selector...",! do Slctor2^TMGUSRIF("SrchRec","Results","Pick Example(s) of Bad Drugs Names. [ESC][ESC] when done.") do HandleChain^TMGNDF4G(.Results) ;"Show forward array write "Done.",! do PressToCont^TMGUSRIF quit