TMGSELED ;TMG/kst/Group record selected editer ;03/25/06 ;;1.0;TMG-LIB;**1**;01/25/07 ;"TMG -- Group record selected editer ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"1-25-2007 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"ASKSELED -- A record group selecter/editor, with asking user for options ;"ASK1ED -- A record editor ;"$$SELED(Options) -- entry point for group selecting and editing of records ;" Options -- PASS BY REFERENCE. Format: ;" Options("FILE")=Filenumber^FileName ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("IEN LIST",IEN in FILE)="" ;" Options("IEN LIST",IEN in FILE)="" ;" Options("IEN LIST",IEN in FILE,"SEL")="" ;"<-- Optional. Makes preselected ;" Note: alternative Format ;" Options("FIELDS",DisplaySequence)=FldNum:FldNum2:FldNum3^Width ;" FldNum:FldNum2:FldNum3 means FldNum is ptr to file2, and ;" FldNum2 is in file2. This value is a pointer to file3, and ;" FldNum3 is a value in file3 ;" ;"$$EditRecs(pList,Options,LookupFn) -- get new values for fields in records ;"$$GetFields(Options) -- Interact with user to choose fields, and their display widths ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"GetIENs(Options) -- Interact with user to choose IENs to be edited ;"GetFldVScreen(File,FieldNum,ScrnCode,pResults,Flags) -- get List of IENs in File matching ScreenCode ;"GetFldValue(File,FieldNum,Value,pResults) --get List of IENs in File with missing Field ;"FixValue(pList,FileNum,FieldNum) -- Ask user for a valid value & apply to all entries in pList ASKSELED ;"Scope: PUBLIC ;"Purpose: A record group selecter/editor ;"Input: None ;"Output: Data in database may be edited. ;"Results: none write !,"Group Select-and-Edit Routine",! write "-------------------------------",! write "Here are the steps we will go through . . .",! write "Step #1. Pick FILE to browse",! write "Step #2. Pick FIELDS to show when browsing",! write "Step #3. Pick Records to browse from",! write "Step #4. Select sepecific Records to edit",! write "Step #5. Edit values in selected records",! write "Loop back to Step #4",! new DIC,X,Y new FileNum,IEN new UseDefault set UseDefault=1 ;"Pick file to edit from ASK1 set DIC=1 set DIC(0)="AEQM" if UseDefault do ;"leave the redundant do loop, it protects $T, so second do ^DIC isn't called . do ^DICRW ;" ^DICRW has default value of user's last response else do ^DIC ;"^DIC doesn't use a default value... write ! if +Y'>0 write ! goto ASKDone new Options set Options("FILE")=Y if $$GetFields(.Options)=0 goto ASKDone if $$GetWidths(.Options)=0 goto ASKDone ASK2 if $$GetIENs(.Options)=0 goto ASKDone if $$SELED(.Options)=2 goto ASK2 ASKDone quit ASK1ED ;"Scope: PUBLIC ;"Purpose: A record editor ;"Input: None ;"Output: Data in database may be edited. ;"Results: none new DIC,X,Y new FileNum,IEN new UseDefault set UseDefault=0 ;"Pick file to edit from AK1 kill DIC set DIC=1 set DIC(0)="AEQM" set DIC("A")="Enter Name of File Containing Record to Edit: ^// " if UseDefault do ;"leave the redundant do loop, it protects $T, so second do ^DIC isn't called . do ^DICRW ;" ^DICRW has default value of user's last response else do ^DIC ;"^DIC doesn't use a default value... write ! if +Y'>0 write ! goto AKDone new Options set Options("FILE")=Y if $$GetFields(.Options)=0 goto AKDone AK2 kill DIC set DIC("A")="Enter Record in "_$piece(Y,"^",2)_" to Edit: ^// " set DIC=+Y set DIC(0)="AEQM" do ^DIC if Y=-1 goto AK1 new list set list(+Y)="" if $$EditRecs("list",.Options)=1 goto AK2 AKDone quit GetFields(Options) ;"Purpose: Interact with user to choose fields, and their display widths ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER) ;" Note: prior entries are NOT KILLED ;" Options("FILE")=Filenumber^FileName ;" Options("FILE")=Filenumber <---- FileName will be filled in. ;"Output: Options is filled as follows: ;" Options("FILE")=Filenumber^FileName <-- left in from input ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;"Results: 1=OK To continue, 0=abort new result set result=1 new DIC,X,Y new SeqNum set SeqNum=1 new Field new FName set FName=$piece($get(Options("FILE")),"^",2) new FileNum set FileNum=+$get(Options("FILE")) if FileNum=0 set result=0 goto GFDone if FName="" do . set FName=$$GetFName^TMGDBAPI(FileNum) . set $piece(Options("FILE"),"^",2)=FName set DIC="^DD("_FileNum_"," set DIC(0)="MEQ" GFLoop write "Enter " if SeqNum=1 write "first " else write "next " write "field to display/edit (^ to abort): " read Field:$get(DTIME,3600) if Field="^" set result=0 goto GFDone if Field="" goto GFDone if Field[":" do . new i,CurFile,abort . new NewField set NewField="" . new NewFldNames set NewFldNames="" . set CurFile=FileNum,abort=0 . for i=1:1:$length(Field,":") do quit:(abort=1) . . new fld,DIC,X,Y . . set fld=$piece(Field,":",i) . . set DIC="^DD("_CurFile_"," . . set DIC(0)="MEQ" . . set X=fld . . do ^DIC . . if Y=-1 set abort=1 quit . . if NewField'="" set NewField=NewField_":" . . if NewFldNames'="" set NewFldNames=NewFldNames_":" . . set NewField=NewField_+Y . . set NewFldNames=NewFldNames_$piece(Y,"^",2) . . new FldInfo set FldInfo=$piece($get(^DD(CurFile,+Y,0)),"^",2) . . if FldInfo["P" do . . . set CurFile=+$piece(FldInfo,"P",2) . . . write "->" . set Field=NewField_"^"_NewFldNames . if Field="^" set Field="" . write ! else do . set X=Field . do ^DIC write ! . if +Y>0 set Field=Y . ;"NOTE: I need to ask for subfield if PTR to another file. . else do . . ;"if Field'["?" write "??",! . . set Field="" if Field="" goto GFLoop set Options("FIELDS",SeqNum)=Field set Options("FIELDS","MAX NUM")=SeqNum new % set %=2 write " DISPLAY only (i.e. don't allow edit)" do YN^DICN write ! if %=1 set Options("FIELDS",SeqNum,"NO EDIT")=1 if %=-1 goto GFDone set SeqNum=SeqNum+1 goto GFLoop GFDone write ! quit result GetWidths(Options) ;"Purpose: Interact with user to choose adjust widths of displayed fields ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER) ;" Note: prior entries are NOT KILLED ;" Options("FILE")=Filenumber^FileName ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber ;" Options("FIELDS",DisplaySequence)=FldNum^FldName ;" Options("FIELDS",DisplaySequence)=FldNum^FldName ;" Options("FIELDS",DisplaySequence)=FldNum^FldName ;"Output: Options is filled as follows: ;" Options("FILE")=Filenumber^FileName <-- left in from input ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;"Results: 1=OK To continue, 0=abort ;"Note: Later I could rewrite this function to allow a more graphical ;" resizing of the fields, by displaying the line with one field ;" in reverse colors, indicating that it has been selected. Then ;" left-right would adjust size, and TAB would rotate to next field. new result set result=1 new LMargin set LMargin=6 new TMGMINW set TMGMINW=3 new FldCount set FldCount=$get(Options("FIELDS","MAX NUM"),0) if FldCount=0 set result=0 goto GWDone new ScrnWidth set ScrnWidth=$get(IOM,80)-LMargin-1 ;"leave room for selector numbers new tempW set tempW=ScrnWidth\FldCount ;"Set default values new i for i=1:1:FldCount set $piece(Options("FIELDS",i),"^",3)=tempW write !,$$GetDispStr(.Options),! new %,i,Num,TMGW,Delta,MinW,TMGMAXW new SufferCol,SufferW new Menu,UsrSlct,MenuCount,MenuDflt set MenuCount=1 set MenuDflt=1 new DIR,FldName set Menu(0)="Pick Option" for i=1:1:FldCount do . set Menu(MenuCount)="Adjust ["_$piece(Options("FIELDS",i),"^",2)_"]"_$char(9)_i . set MenuCount=MenuCount+1 set Menu(MenuCount)="Enter ^ to abort"_$char(9)_"^" GWLoop set %=2 ;"default to 'NO' the first time into loop. write "Adjust column widths" do YN^DICN write ! if %=2 goto GWDone set UsrSlct=$$Menu^TMGUSRIF(.Menu,MenuDflt,.MenuDflt) if (UsrSlct="^")!(UsrSlct="") goto GWDone set Num=+UsrSlct set TMGW=$piece($get(Options("FIELDS",Num)),"^",3) set FldName=$piece($get(Options("FIELDS",Num)),"^",2) ;"Determine which column will have compensatory changes as Column is changed set SufferCol=FldCount if Num1 set SufferCol=Num-1 set SufferW=$piece($get(Options("FIELDS",SufferCol)),"^",3) set TMGMAXW=ScrnWidth-((FldCount-1)*TMGMINW) ;"min colum width is 3 if TMGMAXWTMGMAXW) X" set DIR("A")="Enter amount to adjust "_FldName_" width by" set DIR("B")="" write $$GetDispStr(.Options) do ^DIR write ! if (Y="")!(Y["^") goto GWDone set delta=+Y if delta'=0 do . do AdjCol(.Options,Num,delta) . do AdjCol(.Options,SufferCol,-delta) ;"write # write $$GetDispStr(.Options),! goto GWLoop GWDone quit result AdjCol(Options,Num,Delta) ;"Purpose: To adust one column width ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER) ;" Note: prior entries are NOT KILLED ;" Options("FIELDS",DisplaySequence)=FldNum^FldName ;"Output:Width for one column is changed. No check for total width made ;"Results: none new W set W=$piece($get(Options("FIELDS",Num)),"^",3) set W=W+Delta set $piece(Options("FIELDS",Num),"^",3)=W quit GetDispStr(Options) ;"Purpose: get a display representation of widths ;"Input: Options -- PASS BY REFERENCE ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;"Results: returns a display string new outS set $piece(outS," ",LMargin)="" ;"Display current widths for i=1:1:FldCount do . new W set W=$piece(Options("FIELDS",i),"^",3) . new name set name=$piece($get(Options("FIELDS",i)),"^",2) . set name=$extract(name,1,W-2) . set name=$$LJ^XLFSTR(name,W-2,".") if name="" set name="!" . set outS=outS_"["_name_"]" quit outS GetIENs(Options) ;"Purpose: Interact with user to choose IENs to be edited ;" User will be able to pick IENs from a SORT TEMPLATE, or ;" a custom search. ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER) ;" Note: prior entries are NOT KILLED ;" Options("FILE")=Filenumber^FileName ;"Output: Options is filled as follows: ;" Options("FILE")=Filenumber^FileName <-- left from input ;" Options("IEN LIST",IEN in FILE)="" ;" Options("IEN LIST",IEN in FILE)="" ;"Results: 1=OK To continue, 0=abort new Menu,UsrSlct new FileNum set FileNum=$piece($get(Options("FILE")),"^",1) new FileName set FileName=$piece($get(Options("FILE")),"^",2) new result set result=1 set Menu(0)="Pick Records from "_FileName_" to Browse" set Menu(1)="Choose a TEMPLATE from a former FILEMAN SEARCH"_$char(9)_"TEMPLATE" set Menu(2)="Browse ALL records"_$char(9)_"ALL" set Menu(3)="Browse records with a given Field VALUE"_$char(9)_"SCREEN" set Menu(4)="Enter ^ to abort"_$char(9)_"^" ;"write # set UsrSlct=$$Menu^TMGUSRIF(.Menu,1) if UsrSlct="^" set result=0 goto GIDone if UsrSlct=0 set UsrSlct="" new abort set abort=0 if UsrSlct="TEMPLATE" do . new DIC,Y . set DIC=.401 . set DIC(0)="MAEQ" TPLOOP . write "Select a TEMPLATE Containing Records for Browsing.",! . set DIC("A")="Enter Template (^ to abort): " . do ^DIC write ! . if +Y'>0 set abort=1 quit . new node set node=$get(^DIBT(+Y,0)) . if $piece(node,"^",4)'=FileNum do goto TPLOOP . . set Y=0 ;"signal to try again . . new PriorErrorFound . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: That template doesn't contain records from "_FileName_". Please select another.") . . do PressToCont^TMGUSRIF . if (+Y>0)&($data(^DIBT(+Y,1))>1) do . . merge Options("IEN LIST")=^DIBT(+Y,1) else if UsrSlct="ALL" do . do GetFldValue(FileNum,.01,"ALL",$name(Options("IEN LIST"))) else if UsrSlct="SCREEN" do . new DIC,X,Y,DIR,FldNum,Value . set DIC="^DD("_FileNum_"," . set DIC(0)="MAEQ" . set DIC("A")="Enter FIELD to use for SCREEN: " . do ^DIC write ! . if Y=-1 quit . set FldNum=+Y . set DIR(0)=FileNum_","_FldNum . set DIR("?",1)="Enter value to search for. Records will be included" . set DIR("?",2)="if the field chosed contains the value entered here." . set DIR("?",3)="A @ may be entered to represent a NULL value for a field." . set DIR("?",4)="For more complex searches, use Fileman search function," . set DIR("?",5)="store results in a template, and then chose that template" . set DIR("?",6)="as the input source instead of choosing a screening value." . do ^DIR write ! . if X="@" set Y="@" . if Y="" quit . set Value=$piece(Y,"^",1) . do GetFldValue(FileNum,FldNum,Value,$name(Options("IEN LIST"))) if abort=1 set result=0 GIDone quit result GetFldVScreen(File,FieldNum,ScrnCode,pResults,Flags) ;"Purpose: get List of IENs in File with matching Field ;"Input: File -- the File to scan ;" FieldNum -- the Field number to get from file ;" ScrnCode -- Screening code to be executed.... ;" Format: '$$MyFn^MyModule()', or ;" '(some test)' such that the following is valid code: ;" set @("flagToSkip="_ScrnCode) ;" ---> If flagToSkip=1, then record is NOT selected ;" The following variables will be available for use: ;" File -- the File name or number ;" FieldNum -- the field number ;" IEN -- the IEN of the current record. ;" RecValue -- the current value of the field ;" pResults -- PASS BY NAME, an OUT PARAMETER. ;" Flags -- OPTIONAL. Possible Flags ;" "E" search for external forms (default is internal forms) ;"Output: @pResults is filled as following. Note: prior results are not killed ;" @pResults@(IEN)="" ;" @pResults@(IEN)="" ;"Results: none new Itr,IEN,RecValue,FMFlag new abort set abort=0 set FMFlag="I" if $get(Flags)["E" set FMFlag="" set RecValue=$$ItrFInit^TMGITR(File,.Itr,.IEN,FieldNum,,FMFlag) do PrepProgress^TMGITR(.Itr,20,0,"IEN") for do quit:(($$ItrFNext^TMGITR(.Itr,.IEN,.RecValue)="@@@@@@@@")!(+IEN=0))!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . new flagToSkip set @("flagToSkip="_ScrnCode) . if flagToSkip quit . set @pResults@(IEN)="" do ProgressDone^TMGITR(.Itr) quit GetFldValue(File,FieldNum,Value,pResults,Flags) ;"Purpose: get List of IENs in File with matching Field ;"Input: File -- the File to scan ;" FieldNum -- the Field number to get from file ;" Value -- the value to compare against. Poss Values ;" VALUE: if field=VALUE, then record selected ;" "@": if field=null (empty), then record selected ;" "ALL": all records are selected ;" pResults -- PASS BY NAME, an OUT PARAMETER. ;" Flags -- OPTIONAL. Possible Flags ;" "E" search for external forms (default is internal forms) ;"Output: @pResults is filled as following. Note: prior results are not killed ;" @pResults@(IEN)="" ;" @pResults@(IEN)="" ;"Results: none new Itr,IEN,RecValue,FMFlag if $get(Value)="ALL" goto GFV3 GFV1 set FMFlag="I" if $get(Flags)["E" set FMFlag="" set RecValue=$$ItrFInit^TMGITR(File,.Itr,.IEN,FieldNum,,FMFlag) do PrepProgress^TMGITR(.Itr,20,0,"IEN") for do quit:(($$ItrFNext^TMGITR(.Itr,.IEN,.RecValue)="@@@@@@@@")!(+IEN=0)) . if (RecValue=Value)!((Value="@")&(RecValue="")) do . . set @pResults@(IEN)="" write ! goto GFVDone GFV3 write "Gathering ALL records...",! set IEN=$$ItrInit^TMGITR(File,.Itr,.IEN) do PrepProgress^TMGITR(.Itr,100,0,"IEN") for do quit:($$ItrNext^TMGITR(.Itr,.IEN)="") . if +IEN'=IEN quit . set @pResults@(IEN)="" do ProgressDone^TMGITR(.Itr) GFVDone quit SELED(Options) ;"Scope: PUBLIC ;"Purpose: the entry point for group selecting and editing of recrods ;" Note: this can be used as an API entry point ;"Input: Options -- PASS BY REFERENCE ;" Format: ;" Options("FILE")=Filenumber^FileName ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width ;" Options("FIELDS",DisplaySequence,"LOOKUP FN") -- OPTIONAL ;" A function for looking up new values. ;" Must be in format like this: ;" Options("FIELDS",DisplaySequence,"LOOKUP FN")="$$MyFn^MyModule(File,FldNum)" ;" i.e. must be a function name. Function may take passed ;" parameters 'File' and 'FldNum' ;" Default value="$$ValueLookup(File,FldNum)" ;" Options("IEN LIST",IEN in FILE)="" ;" Options("IEN LIST",IEN in FILE)="" ;" Options("IEN LIST",IEN in FILE,"SEL")="" ;"<-- optional. Makes preselected ;" Note: alternative Format ;" Options("FIELDS",DisplaySequence)=FldNum:FldNum2:FldNum3^Width ;" FldNum:FldNum2:FldNum3 means FldNum is ptr to file2, and ;" FldNum2 is in file2. This value is a pointer to file3, and ;" FldNum3 is a value in file3 ;"Output: Data in database may be edited. ;"Results: 1=Normal exit, 2=Needs rescan and recall new result set result=1 new SelList,pList,pIENList set pList=$name(SelList) set pIENList=$name(Options("IEN LIST")) new Fields,Widths set Fields="",Widths="" new File set File=+$get(Options("FILE")) if File="" goto SEDone new i for i=1:1:$get(Options("FIELDS","MAX NUM")) do . set Fields=Fields_$piece($get(Options("FIELDS",i)),"^",1)_";" . set Widths=Widths_$piece($get(Options("FIELDS",i)),"^",3)_";" new tempResult new pSaveArray ;"will store ref of stored display array --> faster SLoop kill @pList ;"Later change this to allow custom order of sort fields. do IENSelector^TMGUSRIF(pIENList,pList,File,Fields,Widths,"Pick Records to Edit. [ESC],[ESC] when done",Fields,.pSaveArray) new count set count=$$ListCt^TMGMISC(pList) write count," items selected.",! if count>0 set tempResult=$$EditRecs(pList,.Options) write !,"Fix more" new % set %=1 if count=0 set %=2 do YN^DICN write ! if %'=1 goto SEDone if $data(@pList)=0 goto SLoop new needsRepack set needsRepack=0 write "Removing fixed items from list. Here are the old entries...",! if $get(pSaveArray)="" do . do ListNot^TMGMISC(pIENList,pList) ;"<-- probably a bug in this function else do . new Itr,IEN,DispLineNum . ;"zwr @pList . set IEN=$$ItrAInit^TMGITR(pList,.Itr) . if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="") . . set DispLineNum=+$get(@pList@(IEN)) . . if DispLineNum=0 quit . . new tempS . . set tempS=$get(@pSaveArray@(DispLineNum)) . . set tempS=$piece(tempS,$char(9),2) . . write " --",tempS,! . . kill @pSaveArray@(DispLineNum) . . set needsRepack=1 . write ! write ! ;"IMPORTANT NOTE: It seems that that after deleting items in pSaveArray, the ordering ;" gets out of sync, such that the display number is NOT the same as the index ;" and the wrong references can be used!!! Must renumber somehow... set %=2 write "Rescan file (slow)" do YN^DICN write ! if %=1 set result=2 goto SEDone if %=-1 goto SEDone write "Packing display list..." do ListPack^TMGMISC(pSaveArray) write ! goto SLoop SEDone quit result EditRecs(pList,Options,LookupFn) ;"Purpose: To get new values for display fields in records ;"Input: pList -- PASS BY NAME. A list of IENs to process ;" @pList@(IEN)=IgnoredValue ;" @pList@(IEN)=IgnoredValue ;" @pList@(IEN)=IgnoredValue ;" Options -- PASS BY REFERENCE. Format: ;" Options("FILE")=Filenumber^FileName ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width <-- Width is ignored ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width <-- Width is ignored ;" Options("FIELDS",DisplaySequence)=FldNum <-- FldName OPTIONAL ;" Options("FIELDS",DisplaySequence,"LOOKUP FN") -- OPTIONAL ;" A function for looking up new values. ;" Must be in format like this: ;" Options("FIELDS",DisplaySequence,"LOOKUP FN")="$$MyFn^MyModule(File,FldNum)" ;" i.e. must be a function name. Function may take passed ;" parameters 'File' and 'FldNum' ;" Default value="$$ValueLookup(File,FldNum)" ;" Options("FIELDS",DisplaySequence,"NO EDIT")=1 <-- indicates this field NOT to be edited. ;" Note: alternative Format ;" Options("FIELDS",DisplaySequence)=FldNum:FldNum2:FldNum3^Width ;" FldNum:FldNum2:FldNum3 means FldNum is ptr to file2, and ;" FldNum2 is in file2. This value is a pointer to file3, and ;" FldNum3 is a value in file3 ;" ;"Results: 1=OK to continue, 0 if error new result set result=0 ;"default to error new Menu,UsrSlct,MenuCount,FldCount,File new TMGFDA,TMGMSG set FldCount=+$get(Options("FIELDS","MAX NUM")) if FldCount=0 goto GNVDone set File=+$get(Options("FILE")) if File=0 goto GNVDone new LookupFn new DIR,FldNum,NewValue GNVL1 kill Menu set Menu(0)="Pick Field to EDIT" set MenuCount=1 for i=1:1:FldCount do . new CommonValue,FieldNum,FieldName . if $get(Options("FIELDS",i,"NO EDIT"))=1 quit ;"don't edit this field . set FieldNum=$piece($get(Options("FIELDS",i)),"^",1) . set FieldName=$piece($get(Options("FIELDS",i)),"^",2) . if FieldName="" set FieldName=$$GetFldName^TMGDBAPI(File,FieldNum) . set CommonValue=$$GetCommonValue(File,FieldNum,pList) . set Menu(MenuCount)=FieldName_": ["_CommonValue_"]"_$char(9)_i . set MenuCount=MenuCount+1 ;"set Menu(MenuCount)="Enter ^ to abort"_$char(9)_"^" GNVL2 set UsrSlct=$$Menu^TMGUSRIF(.Menu) ;"if FldCount>1 do ;". set UsrSlct=$$Menu^TMGUSRIF(.Menu) ;"else set UsrSlct=1 ;"If only 1 option, then auto-select if (UsrSlct="^")!(UsrSlct="") goto GWDone set LookupFn=$get(Options("FIELDS",UsrSlct,"LOOKUP FN"),"$$ValueLookup(File,FldNum)") kill DIR,NewValue set FldNum=+$piece($get(Options("FIELDS",UsrSlct)),"^",1) if FldNum=0 goto GNVDone set @("Y="_LookupFn) ;"write !,"Enter new value for field below." ;"set DIR(0)=File_","_FldNum ;"do ^DIR write ! if Y="" goto GNVL2 if Y="^" goto GNVDone set NewValue=$piece(Y,"^",1) if NewValue=+NewValue do . new array . do GetFieldInfo^TMGDBAPI(File,FldNum,"array") . if $get(array("SPECIFIER"))["S" quit ;"check if field is a SET, if so, don't add ` mark . set NewValue="`"_NewValue ;"indicate that number is a pointer new Itr,IEN,Value,results set result=1 set IEN=$$ItrAInit^TMGITR(pList,.Itr) if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="") . kill TMGFDA,TMGMSG . set TMGFDA(File,IEN_",",FldNum)=NewValue . do FILE^DIE("EK","TMGFDA","TMGMSG") . if $data(TMGMSG("DIERR")) do . . set result=0 . . new PriorErrorFound . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) goto GNVL1 GNVDone quit result ValueLookup(File,FldNum) ;"Purpose: To interact with user and obtain a value for field in file ;"Input: File: A valid file number ;" FldNum: A valid field number in File ;"Result: Returns value of user input. new DIR write !,"Enter new value for field below." set DIR(0)=File_","_FldNum do ^DIR write ! quit Y GetCommonValue(File,Field,pList,Flags) ;"Purpose: Return a value held by all records in pList, or "" if mixed values ;"Input: File -- file number ;" Field -- field number or 'num:num2:num3" etc ;" Flags -- value to pass to GET1^DIQ during lookup ;"Output: returns a common value, or "" if not common value new Itr,IEN,Value,abort,result set abort=0,result="" new Itr,IEN,Value,abort set abort=0 set IEN=$$ItrAInit^TMGITR(pList,.Itr) if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!(abort=1) . set Value=$$GET1^DIQ(File,IEN_",",Field) . if result="" set result=Value . if Value'=result set result="",abort=1 quit result