TMGXMLUI ;TMG/kst/XML Exporter -- User Interface ;03/25/06 ;;1.0;TMG-LIB;**1**;07/12/05 ;"TMG XML EXPORT -- USER INTERFACE FUNCTIONS ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"7-12-2005 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"UI ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= ;"Welcome() ;"ProcessFile(pArray,indent) ;"GetRecs(File,pRecs,indent) ;"GetTemplateRecs(File,pRecs,s) ;"GetManualRecs(File,pRecs,s) ;"GetFields(File,pArray,indent) ;"GetManFields(File,pArray,s) ;"AskCustomTag(File,field,pArray,indent) ;"AskCustTransform(File,field,pArray,indent) ;"$$FMGetField(FileNumber) ;"$$AskGetField(FileNumber,indent) ;"$$PickUnselField(FileNumber,pArray,indent) ;"CfgOrderFields(File,pArray) ;"ShowArray(indent) ;"Pause ;"WriteHeader(pHeader) ;"HdrAddLine(pHeader,Line) ;"HdrDelLine(pHeader,index) ;"Spaces(Num) ;"======================================================================= ;"Dependencies ;"XLFSTR ;"TMGDBAPI, TMGDEBUG, TMGMISC ;"======================================================================= ;"======================================================================= UI(pArray) ;"Purpose: To create a User Interface (UI) for creating array needed to ;" export XML data from Fileman. ;"Input: pArray -- pointer to (i.e. name of) array to put data into ;"Output: values will be put into pArray. See TMGXMLEX for format ;"Result: 1 if OK to continue, 0 if error or abort new result set result=1 if $data(IOF)=0 do goto UIDone . write "This function requires the VistA environment to be setup first.",! . write "Terminating. This may be achieved via DO ^XUP, then dropping",! . write "back to the command line and trying to run this again.",! . set result=0 new done set done=0 new HeaderArray new pHeader set pHeader="HeaderArray" set pArray=$get(pArray,"TMGArray") new TMGxmlArray set TMGxmlArray=pArray new indent set indent=0 new TabInc set TabInc=5 do HdrAddLine(pHeader," XML Export Assistant.") do HdrAddLine(pHeader,"=========================") set result=$$Welcome if result=0 goto UIDone set result=$$ProcessFile(pArray,indent+TabInc) if result=0 goto UIDone UIDone quit result Welcome() ;"Purpose: Decribe the wizard ;"Input: none ;"Result: 1 if OK to continue. 0 if user abort requested. ;"Note: uses global pHeader new result set result=1 do WriteHeader(pHeader) write "Welcome. I'll walk you through the process",! write "of choosing the data you wish to export to an ",! write "XML file.",!! write "Overview of planned steps:",! write "Step 1. Pick 1st Fileman file to export.",! write "Step 2. Pick records in file to export.",! write "Step 3. Pick fields in records to export.",! write "Step 4. Pick 2nd Fileman file to export.",! write " ... repeat cycle until done.",!! write "To back out, enter '^' at any prompt.",!! WcLoop write "Are you ready to begin? (Y/N/^) YES//" new input read input:$get(DTIME,3600),! if $TEST=0 set input="N" if input="" set input="Y" set input=$$UP^XLFSTR(input) if (input'["Y")!(input["^") do goto WcmDone . ;"write "Goodbye.",! . set result=0 if (input["?") do goto WcLoop . write " Enter Y or YES to continue.",! . write " Enter N or No or ^ to exit.",!! . do Pause() WcmDone quit result ProcessFile(pArray,indent) ;"Purpose: To add export options for one file, or edit previous choices ;"Input: pArray -- pointer to (i.e. name of) array to fill with info. ;" indent -- amount to indent from left margin ;"Output: Array will be filled with data in appropriate format (See docs in TMGXMLEX.m) ;"Result: 1 if OK to continue, 0 if aborted ;"note: uses global variable pHeader,TabInc new DIC,File new Y set Y=0 new ref new result set result=1 new Records if $get(pArray)="" set result=0 goto SUFDone do HdrAddLine(pHeader,$$Spaces(indent)_"Step 1. Pick a FILE for export to XML.") new Another set Another=0 for do quit:(+Y'>0)!(result=0) . do WriteHeader(pHeader,1) . if Another do quit:(result=0)!(Y'>0) . . write !,?indent,"Add another file for export? (Y/N/^) NO//" . . new input read input:$get(DTIME,3600),! . . if input="^" set Y=0,result=0 quit . . if input="" set input="N" . . set input=$$UP^XLFSTR(input) . . if input'["Y" set Y=0 quit ;"signal to quit . . set Y=1 . set DIC=1 . set DIC(0)="AEQ" . set DIC("A")=$$Spaces(indent)_"Enter Fileman file for XML export (^ to quit): ^// " . do ^DIC . write ! . set File=+Y . if File'>0 set result=0 quit . set ref=$name(@pArray@(File)) . if $$GetRecs(File,ref,indent)=0 set Y=0,result=0 quit . set Another=1 do HdrDelLine(pHeader) if result=0 goto SUFDone write !,?indent,"Also export pointed-to records (Y/N/^) YES// " new input read input:$get(DTIME,3600),! if input="^" set result=0 goto SUFDone if input="" set input="Y" set input=$$UP^XLFSTR(input) if input["Y" do . do ExpandPtrs(pArray) set result=$$AskFlags(pArray,indent) SUFDone quit result AskFlags(pArray,indent) ;"Purpose: To ask user if various flags are desired ;"Input: pArray -- pointer to (i.e. name of) array to put data into ;" indent -- amount to indent from left margin ;"Note: uses global variable pHeader ;"Result: 1 if OK to continue, 0 if aborted new input set indent=$get(indent,0) new result set result=1 if $get(pArray)="" set result=0 goto AFlgDone new defLabel set defLabel="TMG_VISTA_XML_EXPORT" new SysName,Y set SysName=$get(^TMG("XML EXPORTER","EXPORT_SYSTEM_NAME")) if SysName="" do . do GETENV^%ZOSV . set SysName=$piece(Y,"^",4) set @pArray@("EXPORT_SYSTEM_NAME")=SysName do WriteHeader(pHeader) write ?indent,"Formatting Options:",! write ?indent,"----------------------",!! write ?indent,"Use Default export settings? (Y/N,^) YES// " read input:$get(DTIME,3600),!! if input="^" set result=0 goto AFlgDone if input="" set input="Y" if "YesyesYES"[input do goto AFlgDone . set @pArray@("FLAGS","i")="" ;"<-- default value of indenting . set @pArray@("!DOCTYPE")=defLabel . new SysName,Y . set SysName=$get(^TMG("XML EXPORTER","EXPORT_SYSTEM_NAME")) write ?indent,"During export to XML file, do you want empty fields to be",! write ?indent,"reported (vs. no data --> tag not written)? (Y/N,^) NO// " read input:$get(DTIME,3600),!! if input="^" set result=0 goto AFlgDone if input="" set input="N" if "YesyesYES"[input do . set @pArray@("FLAGS","b")="" write ?indent,"Do you want the XML file to have entries indented for visual",! write ?indent,"organization? This will have no meaning to another program",! write ?indent,"importing the XML file, but is easier for humans to read it ",! write ?indent,"this way. Indent entries? (Y/N,^) YES// " read input:$get(DTIME,3600),!! if input="^" set result=0 goto AFlgDone if input="" set input="Y" if "YesyesYES"[input do . set @pArray@("FLAGS","i")="" write ?indent,"Do you want the exported entries to be INTERNAL Fileman values?",! write ?indent,"Export INTERNAL entries? (Y/N,^) NO// " read input:$get(DTIME,3600),!! if input="^" set result=0 goto AFlgDone if input="" set input="N" if "YesyesYES"[input do . set @pArray@("FLAGS","I")="" write ?indent,"Do you want the export the Fileman data dictionary? (Y/N,^) NO// " read input:$get(DTIME,3600),!! if input="^" set result=0 goto AFlgDone if input="" set input="N" if "YesyesYES"[input do . set @pArray@("FLAGS","D")="" write ?indent,"Output export settings? (Y/N,^) YES// " read input:$get(DTIME,3600),!! if input="^" set result=0 goto AFlgDone if input="" set input="Y" if "YesyesYES"[input do . set @pArray@("FLAGS","S")="" new defLabel set defLabel="TMG_VISTA_XML_EXPORT" write ?indent,"Use default XML !DOCTYPE '"_defLabel_"' label? (Y/N,^) YES// " read input:$get(DTIME,3600),!! if input="^" set result=0 goto AFlgDone if input="" set input="Y" if "YesyesYES"[input do . set @pArray@("!DOCTYPE")=defLabel else do goto:(result=0) AFlgDone . write ?indent,"Specify a *custom* XML !DOCTYPE label? (Y/N,^) NO// " . read input:$get(DTIME,3600),!! . if input="^" set result=0 quit . if input="" set input="Y" . if "YesyesYES"[input do . . write "Enter label for ",! . . write "Enter Label: //" . . read input:$get(DTIME,3600),!! . . if input="^" set result=0 quit . . if input'="" set @pArray@("!DOCTYPE")=input write ?indent,"Enter a name for this VistA installation. ",SysName,"// " read input:$get(DTIME,3600),!! if input="^" set result=0 goto AFlgDone if input="" set input=SysName set SysName=input set ^TMG("XML EXPORTER","EXPORT_SYSTEM_NAME")=SysName set @pArray@("EXPORT_SYSTEM_NAME")=SysName AFlgDone quit result ;"NOTE: I need to notice if File has already been set (i.e. user choosing file a second time ;" If so give option to erase old choices and choose again GetRecs(File,pRecs,indent) ;"Purpose: For a given file, allow selection of records to export. ;"Input: File -- the File (name or number) to select from. ;" pRec -- Pointer to (i.e. name of) array to fill with records nums ;" indent -- a value to indent from left margin ;"Result: 1 if OK to continue, 0 if user aborted. ;"Note: uses global variable pHeader,TabInc new result set result=1 new input set input="" new FileNumber,FileName if ($get(File)="")!($get(pRecs)="") set result=0 goto GRDone new defValue set defValue="X" if +File=File do . set FileNumber=File . set FileName=$$GetFName^TMGDBAPI(File) else do . set FileName=File . set FileNumber=$$GetFileNum^TMGDBAPI(File) do HdrAddLine(pHeader,$$Spaces(indent)_"Step 2. Which RECORDS to export from file "_FileName_"?") for do quit:(input="^")!(result=0) . do WriteHeader(pHeader) . write ?indent,"1. Export ALL records (exclusions allowed).",! . write ?indent,"2. Select a Search/Sort TEMPLATE to specify records.",! . write ?indent,"3. Select SPECIFIC records",! . write ?indent,"4. Select records to EXCLUDE",! . write ?indent,"5. View selections so far.",! . write ?indent,"X. Done here.",!! . write ?indent,"Select option (1-5 or X or ? or ^): "_defValue_"// " . read input:$get(DTIME,3600),!! . if $TEST=0 set input="^" . if input="" set input=defValue . if ("Xx"[input) do quit . . if $data(@pRecs)'>1 do quit:(input="") . . . write ?indent,"NOTE: No records were chosen for export in file: ",FileName,! . . . write ?indent,"This means that nothing will be exported to the XML file.",!! . . . write ?indent,"Do you still want to stop selecting records? (Y,N,^) NO// " . . . new Done read Done:$get(DTIME,3600),! . . . if $TEST=0 set Done="^" . . . if (Done="")!("NOnoNo"[Done) set input="" . . set input="^" . if input="^" set result=0 quit . if (input>0)&(input<6) set defValue=input . if input="?" do quit . . write ! . . write ?indent," Enter '1' if you wish to export ALL records in this file.",! . . write ?indent," You can still specify records to exclude after this option.",! . . write ?indent," Enter '2' if you wish to use a pre-existing Search/Sort TEMPLATE",! . . write ?indent," to select files. A Search/Sort TEMPLATE can be generated",! . . write ?indent," through the Fileman Search function.",! . . write ?indent," Enter '3' if you know the record nubmers (IEN values) for the",! . . write ?indent," records you wish to export, and want to enter them",! . . write ?indent," manually.",! . . write ?indent," Enter '4' if you have records to EXCLUDE. If a record is excluded,",! . . write ?indent," then it will NOT be output, even if it was specified ",! . . write ?indent," manually or was included from a Search/Sort TEMPLATE.",! . . write ?indent," Enter '5' to view array containing settings so far.",! . . write ?indent," Enter 'X' to exit..",! . . write ?indent," Enter '^' to abort entire process.",! . . do Pause(indent) . if input=1 do . . set @pRecs@("*")="" . . write ?indent,"OK. Will export all records in file: ",FileName,".",! . . set defValue="X" . . do Pause(indent) . if input=2 set result=$$GetTemplateRecs(File,pRecs,"for INCLUSION ",indent+TabInc) set defValue="X" . if input=3 set result=$$GetManualRecs(File,pRecs,"for INCLUSION ",indent+TabInc) set defValue="X" . if input=4 set result=$$GetExclRecs(File,pRecs,indent+TabInc) set defValue="X" . if input=5 do ShowArray(indent) GRDone if $data(@pRecs)'>1 do . write ?indent,"NOTE: No records were chosen. Aborting.",! . set result=0 else do . write ?indent,"Done chosing records...",! write ?indent,"Now on to picking FIELDS to export.",! do Pause(indent) if $$GetFields(File,ref,indent)=0 set Y=0,result=0 write ! do HdrDelLine(pHeader) quit result GetExclRecs(File,pRecs,indent) ;"Purpose: to allow user to enter records to exclude ;"Input: File -- the File (name or number) to select from. ;" pRec -- Pointer to (i.e. name of) array to fill with records nums ;" indent -- a value to indent from left margin ;"Result: 1 if OK to continue, 0 if user aborted. ;"Note: uses global variable pHeader,TabInc new result set result=1 new FileNumber,FileName new input set input="" if ($get(File)="")!($get(pRecs)="") set result=0 goto GRDone new defValue set defValue="X" if +File=File do . set FileNumber=File . set FileName=$$GetFName^TMGDBAPI(File) else do . set FileName=File . set FileNumber=$$GetFileNum^TMGDBAPI(File) set indent=+$get(indent,0) do HdrAddLine(pHeader,$$Spaces(indent)_"To EXCLUDE records in file "_FileName_", choose:") for do quit:(input="")!(result=0) . new ExRecs,i . do WriteHeader(pHeader) . write ?indent,"1. Select a Search/Sort TEMPLATE to specify records to EXCLUDE.",! . write ?indent,"2. Select SPECIFIC record numbers to EXCLUDE.",! . write ?indent,"3. View all the records excluded so far.",! . write ?indent,"X. Done here.",!! . write ?indent,"Select option (1-3 or X or ? or ^) "_defValue_"// " . read input:$get(DTIME,3600),! . if $TEST=0 set input="^" . if input="" set input=defValue . if ("Xx"[input) set input="" . if input="^" set result=0 quit . if (input>0)&(input<4) set defValue=input . if input="?" do . . write !,?indent," By excluding just certain records, you can export every record",! . . write ?indent," EXCEPT those you specify.",! . . do Pause(indent) . if input=1 do . . new pArray set pArray=$name(@pRecs@("Rec Exclude")) . . set result=$$GetTemplateRecs(File,pArray,"for EXCLUSION ",indent+TabInc) . if input=2 do . . new pArray set pArray=$name(@pRecs@("Rec Exclude")) . . set result=$$GetManualRecs(File,pArray,"for EXCLUSION ",indent+TabInc) . if input=3 do ShowArray(indent) do HdrDelLine(pHeader) GERDone quit result GetTemplateRecs(File,pRecs,s,indent) ;"Purpose: to ask user for a search/sort template to inport records from ;"Input -- File -- the file name or number to work with ;" pRecs -- pointer to (i.e. name of) array to fill ;" will probably be passed with "Array(12345)" ;" s -- OPTIONAL -- e.g. "for INCLUSION " or "for EXCLUSION " -- part of title. ;" indent -- OPTIONAL -- a value to indent from left margin ;"Output: Data is put into pRecs like this: ;" @pRecs@(IEN1)="" ;" @pRecs@(IEN2)="" ;" @pRecs@(IEN3)="" ;"Result: 1 if OK to continue, 0 if user aborted. ;"Note: uses global variable pHeader (if available) new FileNumber,FileName,Y if ($get(File)="")!($get(pRecs)="") goto GTRDone new tempH set pHeader=$get(pHeader,"tempH") new result set result=1 if +File=File do . set FileNumber=File . set FileName=$$GetFName^TMGDBAPI(File) else do . set FileName=File . set FileNumber=$$GetFileNum^TMGDBAPI(File) if FileNumber'>0 do goto GTRDone . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") . set result=0 set indent=+$get(indent,0) do HdrAddLine(pHeader,$$Spaces(indent)_"Select records for export from a Template") for do quit:((+Y>0)!(+Y=-1)) . do WriteHeader(pHeader) . new DIC . set DIC=.401 . set DIC(0)="AEQ" . write $$Spaces(indent)_"Select a Template containing records for import. ",! . write $$Spaces(indent)_"(? for list, ^ to quit) " . set DIC("A")=$$Spaces(indent)_"Enter Template: " . set DIC("S")="IF $P($G(^DIBT(+Y,0)),""^"",4)="_FileNumber ;"screen for Templates by file . do ^DIC . write ! . if +Y'>0 quit ;"set result=0 . new node set node=$get(^DIBT(+Y,0)) . if $piece(node,"^",4)'=FileNumber do quit . . set Y=0 ;"signal to try again . . new PriorErrorFound . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: That template doesn't contain records from "_File_". Please select another.") . . do Pause(indent) if result=0 goto GTRL1 new count set count=0 if (+Y>0)&($data(^DIBT(+Y,1))>1) do . new index set index=$order(^DIBT(+Y,1,0)) . if index'="" for do quit:(index="") . . set @pRecs@(index)="" . . set count=count+1 . . set index=$order(^DIBT(+Y,1,index)) write ?indent,count," Records imported.",! do Pause(indent) GTRL1 do HdrDelLine(pHeader) GTRDone quit result GetManualRecs(File,pRecs,s,indent) ;"Purpose: to ask user for a series of IEN values ;"Input: File -- name or number, file to get IENS's for ;" pRecs -- a pointer to (i.e. Name of) array to put IEN's into ;" s -- OPTIONAL -- e.g. "for INCLUSION " or "for EXCLUSION " -- part of title. ;"Output: Data is put into pRecs like this: ;" @pRecs@(IEN1)="" ;" @pRecs@(IEN2)="" ;" @pRecs@(IEN3)="" ;"Result: 1 if OK to continue, 0 if user aborted. ;"Note: uses global variable pHeader new PriorErrorFound new FileNumber,FileName new result set result=1 if ($get(File)="")!($get(pRecs)="") set result=0 goto GRDone if +File=File do . set FileNumber=File . set FileName=$$GetFName^TMGDBAPI(File) else do . set FileName=File . set FileNumber=$$GetFileNum^TMGDBAPI(File) if FileNumber'>0 do goto GMRDone . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") . do Pause(indent) . set result=0 new ORef set ORef=$get(^DIC(FileNumber,0,"GL")) if ORef="" do goto GRDone . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Can't find global reference for file: "_FileNumber_".") . do Pause(indent) . set result=0 new defValue set defValue="X" do HdrAddLine(pHeader,$$Spaces(indent)_"Select specific record "_$get(s)_"in file "_FileName) new input for do quit:(input="")!(result=0) . do WriteHeader(pHeader) . write ?indent,"1. Use Fileman to find record.",! . write ?indent,"2. Enter record number by hand.",! . write ?indent,"3. View all the records selected so far.",! . write ?indent,"X. Done here.",! . write !,?indent,"Select Option (1-3 or X or ^) "_defValue_"//" . read input:$get(DTIME,3600),!! . if $TEST=0 set input="^" . if input="" set input=defValue . if "Xx"[input set input="" quit . if input="^" set result=0 quit . if (input>0)&(input<4) set defValue=input . if input=1 do . . new DIC . . set DIC=File . . set DIC(0)="AEQ" . . set DIC("A")=$$Spaces(indent)_"Select record in "_FileName_" (? for list, ^ to quit): " . . do ^DIC . . write ! . . if +Y>0 do . . . write !,?indent,"O.K. You selected record number (IEN): ",+Y,! . . . set @pRecs@(+Y)="" . . . do Pause(indent) . . ;" else set result=0 quit . if input=2 do . . new IEN . . read ?indent,"Enter record number (a.k.a. IEN) (^ to abort): ",IEN:$get(DTIME,3600),! . . if $TEST=0 set EIN="^" . . if IEN="^" set result=0 quit . . if +IEN>0 do . . . new ref set ref=ORef_IEN_")" . . . if $data(@ref)'>0 do quit . . . . write ?indent,"Sorry. That record number (IEN) doesn't exist.",! . . . . do Pause(indent) . . . set @pRecs@(IEN)="" . . . write ?indent,"O.K. You selected record number (IEN): ",IEN,! . . . do Pause(indent) . if input=3 do ShowArray(indent) do HdrDelLine(pHeader) GMRDone quit result GetFields(File,pArray,indent) ;"Purpose: To query the user as to which fields to export for records ;"Input: File -- the File number or name to work with. ;" pArray -- point to (i.e. name of) Array to work with. Format discussed in TMGXMLEX.m ;" will likely be equal to "Array(FileNumber)" ;" indent -- a value to indent from left margin ;"Result: 1 if OK to continue. 0 if user aborted. ;"Note: uses global variable pHeader,TabInc new result set result=1 new FileNumber,FileName if ($get(File)="")!($get(pArray)="") set result=0 goto GRDone if +File=File do . set FileNumber=File . set FileName=$$GetFName^TMGDBAPI(File) else do . set FileName=File . set FileNumber=$$GetFileNum^TMGDBAPI(File) if FileNumber'>0 do . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") do HdrAddLine(pHeader,$$Spaces(indent)_"Step 3. Which FIELDS to export from file "_FileName_"?") new defValue set defValue=1 new input for do quit:(input="")!(result=0) . do WriteHeader(pHeader) . write ?indent,"1. Export ALL fields (exclusions allowed).",! . write ?indent,"2. Select SPECIFIC field numbers.",! . write ?indent,"3. Select fields to EXCLUDE",! . write ?indent,"4. View selections so far.",! . write ?indent,"X. Done here.",!! . write ?indent,"Select option (1-4 or X or ? or ^): "_defValue_"// " . read input:$get(DTIME,3600),!! . if $TEST=0 set input="^" . if input="" set input=defValue . if ("Xx"[input) set input="" . if input="^" set result=0 quit . if (input>0)&(input<5) set defValue=input . if input="?" do quit . . write ! . . write ?indent," Enter '1' if you wish to export ALL fields for this file.",! . . write ?indent," You can still specify fields to exclude after this option.",! . . write ?indent," Enter '2' if you know the field numbers you wish to export,",! . . write ?indent," and want to enter them manually.",! . . write ?indent," Enter '3' if you have fields to EXCLUDE. If a field is excluded,",! . . write ?indent," then it will NOT be output, even if it was specified manually.",! . . write ?indent," Enter '4' to view array containing settings so far.",! . . write ?indent," Enter 'X' to exit..",! . . write ?indent," Enter '^' to abort entire process.",! . . do Pause(indent) . if input=1 do quit . . set @pArray@("TEMPLATE","*")="" . . write ?indent,"OK. Will export all fields (and any sub-fields) in file ",FileName,".",! . . do Pause(indent) . . set defValue="X" . if input=2 do quit . . new temp set temp=$name(@pArray@("TEMPLATE")) . . set result=$$GetManFields(File,temp,"for INCLUSION ",indent+TabInc) . if input=3 do quit . . new temp set temp=$name(@pArray@("TEMPLATE","Field Exclude")) . . set result=$$GetManFields(File,temp,"for EXCLUSION ",indent+TabInc) . if input=4 do ShowArray(indent) write ?indent,"Done choosing FIELDS.",! new ref ;"set ref=$name(@pArray@(File,"TEMPLATE")) set ref=$name(@pArray@("TEMPLATE")) set result=$$CfgOrderFields(File,ref,indent) if result=0 set Y=0 quit do HdrDelLine(pHeader) quit result GetManFields(File,pArray,s,indent) ;"Purpose: to ask user for a series of field values ;"Input: File -- name or number, file to get field numbers for ;" pArray -- a pointer to (i.e. Name of) array to put field numbers into ;" will probably be something one of the following: ;" "Array(FileNumber,"TEMPLATE")" ;" "Array(FileNumber,"TEMPLATE","Field Exclude")" ;" "Array(FileNumber,RecNumber)" ;" s -- OPTIONAL -- e.g. "for INCLUSION " or "for EXCLUSION " -- part of title. ;" indend -- optional -- a value to indent from left margin ;"Output: Data is put into pArray ;"Result: 1 if OK to continue. 0 if user aborted. ;"Note: uses global variable pHeader,TabInc new PriorErrorFound new FileNumber,FileName new result set result=1 if ($get(File)="")!($get(pArray)="") set result=0 goto GRDone set indent=$get(indent,0) new defValue set defValue="X" if +File=File do . set FileNumber=File . set FileName=$$GetFName^TMGDBAPI(File) else do . set FileName=File . set FileNumber=$$GetFileNum^TMGDBAPI(File) if FileNumber'>0 do goto GRDone . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") . set result=0 do HdrAddLine(pHeader,$$Spaces(indent)_"Which SPECIFIC FIELDS "_$get(s)_"to export?") new input for do quit:(input="")!(result=0) . new field set field=0 . do WriteHeader(pHeader) . write ?indent,"1. Select ALL fields.",! . write ?indent,"2. Use Fileman to find FIELD number.",! . write ?indent,"3. Enter FIELD by hand.",! . write ?indent,"4. Pick an UNSELECTED field.",! . write ?indent,"5. View all the FIELDS selected so far.",! . write ?indent,"X. Done here.",! . write !,?indent,"Select Option (1-5 or X or ^) ",defValue,"//" . read input:$get(DTIME,3600),!! . if $TEST=0 set input="^" . if input="" set input=defValue . if "Xx"[input set input="" quit . if input="^" set result=0 quit . if (input>0)&(input<6) set defValue=input . if input="5" do quit . . do ShowArray(indent) . if input="1" do . . write "OK All fields selected.",! . . set @pArray@("*")="" . if input="2" set field=$$FMGetField(FileNumber,indent) . if input="3" set field=$$AskGetField(FileNumber,indent) . if input="4" set field=$$PickUnselField(FileNumber,pArray,indent) . if field=-1 set result=0 quit . if field>0 do . . set @pArray@(field)="" . . if $get(s)'="for EXCLUSION " do quit:(result=0) . . . set result=$$AskCustomTag(FileNumber,field,pArray,indent) . . . if result=0 quit . . . set result=$$AskCustTransform(FileNumber,field,pArray,indent) . . . if result=0 quit . . ;"Now, determine if we need to do sub-fields . . new fieldInfo . . do GetFieldInfo^TMGDBAPI(FileNumber,field,"fieldInfo","LABEL") . . if $get(fieldInfo("MULTIPLE-VALUED"))>0 do . . . if $get(fieldInfo("TYPE"))="WORD PROCESSING" quit . . . new subFile set subFile=+$get(fieldInfo("SPECIFIER")) . . . if subFile=0 quit . . . new fieldLst if $$GetFldList^TMGDBAPI(subFile,"fieldLst")=0 quit . . . new subArray set subArray=$name(@pArray@(field,"TEMPLATE")) . . . if $$ListCt^TMGMISC("fieldLst")=1 do quit . . . . new subField set subField=$order(fieldLst("")) . . . . new subFName set subFName=$$GetFldName^TMGDBAPI(subFile,subField) . . . . write ?indent,"Field ",$get(fieldInfo("LABEL"))," (#",field,") has exactly 1 sub-field (",subFName,")",! . . . . write ?indent,"It has been automatically selected for you.",! . . . . set @subArray@(subField)="" . . . . if $get(s)'="for EXCLUSION " do quit:(result=0) . . . . . set result=$$AskCustomTag(subFile,subField,subArray,indent) . . . . . if result=0 quit . . . . . set result=$$AskCustTransform(subFile,subField,subArray,indent) . . . . . if result=0 quit . . . write ?indent,"Field ",$get(fieldInfo("LABEL"))," (#",field,") has sub-fields. We'll select those next.",! . . . do Pause(indent) . . . set result=$$GetManFields(subFile,subArray,s,indent+TabInc) . do Pause(indent) do HdrDelLine(pHeader) GMFDone quit result AskCustomTag(File,field,pArray,indent) ;"Purpose: Ask user if they want a custom output tag for a field ;"Input: FileNumber -- the name or number of the file to work with ;" field -- the number of the field to work with ;" pArray -- the array to put answer in. ;" value passed will probably be like this: ;" e.g. array(22704,"TEMPLATE") or ;" e.g. array(22704,"TEMPLATE",2,"TEMPLATE") ;" indent -- the indent value from left margin ;"Output: value is put in, if user wants, like this ;" e.g. array(22704,"TEMPLATE","TAG NAME",.01)="Custom name" ;" e.g. array(22704,"TEMPLATE",2,"TEMPLATE","TRANSFORM",.01)="Custom name" ;"Result: 1 if OK to continue. 0 if user aborted. new result set result=1 if (+$get(File)=0)!($get(field)="")!($get(pArray)="") set result=0 goto ACTDone set indent=$get(indent,0) new defTag set defTag=$get(@pArray@("TAG NAME",field)) if defTag="" set defTag=$$GetFldName^TMGDBAPI(File,field) write ?indent,"Tag name to use in XML file? ",defTag,"// " new tagName read tagName:$get(DTIME,3600),! if tagName="^" set result=0 if (tagName'="")&(tagName'="^") set @pArray@("TAG NAME",field)=tagName ACTDone quit result AskCustTransform(File,field,pArray,indent) ;"Purpose: Ask user if they want a custom output transform ;"Input: FileNumber -- the name or number of the file to work with ;" field -- the number of the field to work with ;" pArray -- the array to put answer in. ;" value passed will probably be like this: ;" e.g. array(22704,"TEMPLATE") or ;" e.g. array(22704,"TEMPLATE",2,"TEMPLATE") ;" indent -- the indent value from left margin ;"Output: value is put in, if user wants, like this ;" e.g. array(22704,"TEMPLATE","TRANSFORM",.01)="Custom name" ;" e.g. array(22704,"TEMPLATE",2,"TRANSFORM","TAG NAME",.01)="Custom name" ;"Result: 1 if OK to continue. 0 if user aborted. new result set result=1 if (+$get(File)=0)!($get(field)="")!($get(pArray)="") set result=0 goto ACXDone set indent=$get(indent,0) new defXForm new XForm set XForm="" set defXForm=$get(@pArray@("TRANSFORM",field)) for do quit:(XForm'="")!(result=0) . if defXForm'="" write ?indent,defXForm,! . write ?indent,"Custom output transform for field? (?,^) ^//" . read XForm:$get(DTIME,3600),! . if XForm="" set XForm="^" . if XForm="^" set result=0 quit . if XForm="?" do quit . . write ! . . write ?indent,"OPTION FOR ADVANCED USERS ONLY",! . . write ?indent,"An output transform is custom Mumps code that converts",! . . write ?indent,"internally stored database values into information readable",! . . write ?indent,"by end users. If you don't understand this, just leave this",! . . write ?indent,"option blank (i.e., just hit [ENTER])",! . . write ?indent,"The following variables will be set up:",! . . write ?indent," X -- the value stored in the database",! . . write ?indent," IENS -- a standard Fileman IENS",! . . write ?indent," FILENUM -- the number of the current file or subfile",! . . write ?indent," FIELD -- the number of the current file",! . . write ?indent,"The resulting value (that should be written to the XML",! . . write ?indent,"file) should be put into Y",!! . . do Pause(indent) . . set XForm="" . ;"Note I should run some check here for valid code. . set @pArray@("TRANSFORM",field)=XForm ACXDone quit result FMGetField(FileNumber,indent) ;"Purpose: To use Fileman to pick a field ;"Input: File -- Number of file to get field numbers for ;"Result -- The file number selected, or 0 if none or abort new result set result=0 if +$get(FileNumber)'>0 goto FMGFDone new DIC set DIC="^DD("_FileNumber_"," set DIC(0)="AEQ" set DIC("A")=$$Spaces(.indent)_"Select field (? for list, ^ to abort): " do ^DIC write ! if +Y>0 set result=+Y FMGFDone quit result AskGetField(FileNumber,indent) ;"Purpose: To ask user for a field number, then verify it exists. ;"Input: File -- Number of file to get field numbers for ;" indent -- OPTIONAL -- a number of spaces to indent. ;"Result -- The file number selected, or 0 if none, or -1 if abort new result set result=0 new fieldName,field set indent=$get(indent,0) if +$get(FileNumber)'>0 goto AGFDone write ?indent read "Enter field number or name: ",field:$get(DTIME,3600) if field="^" set result=-1 goto AGFDone if +field=0 do quit:(+field=0) . set fieldName=field . set field=$$GetNumField^TMGDBAPI(FileNumber,field) ;"Convert Field Name to Field Number . write " (# ",field,")",! else do . set fieldName=$$GetFldName^TMGDBAPI(FileNumber,field) ;"Convert Field Number to Field Name . write " (",fieldName,")",! if +field>0 do . new ref set ref="^DD("_FileNumber_","_field_",0)" . if $data(@ref)'>0 do . . write ?indent,"Sorry. That field number doesn't exist.",! . . set field=0 . else do . . set result=field AGFDone quit result PickUnselField(FileNumber,pArray,indent) ;"Purpose: To allow the user to pick those fields not already selected. ;"Input: FileNumber -- the file number to work from ;" pArray -- a pointer to (i.e. name of) array to work from. Format same as other functions in this module ;" indent -- OPTIONAL -- a number of spaces to indent. ;"Result -- The file number selected, or 0 if none, or -1 if abort new result set result=0 new fieldName,field,index set indent=$get(indent,0) if (+$get(FileNumber)'>0)!($get(pArray)="") goto AGFDone ;"Get list of available fields. new allFields new pickArray new pickCt set pickCt=0 if $$GetFldList^TMGDBAPI(FileNumber,"allFields")=0 goto PUFDone set field=0 for do quit:(+field'>0) . new fieldName . set field=$order(allFields(field)) . if (+field>0)&($data(@pArray@(field))=0) do . . set pickCt=pickCt+1 . . set pickArray(pickCt)=field . . set fieldName=$$GetFldName^TMGDBAPI(FileNumber,field) ;"Convert Field Number to Field Name . . write ?indent,pickCt,". ",fieldName," (",field,")",! . if (pickCt>0)&(((pickCt\10)=(pickCt/10))!(+field'>0)) do . . new input . . write !,?indent,"Select entry (NOT field number) (1-",pickCt,",^), ",! . . write ?indent,"or ENTER to continue: // " . . read input:$get(DTIME,3600),! . . if $TEST=0 set input="^" . . if input="^" set field=-1 quit . . if (+input>0)&(+input<(pickCt+1)) do . . . set result=pickArray(+input) . . . set field=0 ;"signal Done if pickCt=0 write ?indent,"(All fields have already been selected.)",! PUFDone quit result CfgOrderFields(File,pArray,indent) ;"Purpose: To allow customization of fields ORDER ;"Input: File -- name or number, file to get field numbers for ;" pArray -- a pointer to (i.e. Name of) array to put field numbers into ;" will probably be something one of the following: ;" "Array(FileNumber,"TEMPLATE")" ;" "Array(FileNumber,RecNumber)" ;" indent -- a value to indent from the left margin ;"Output: Data is put into pArray ;"Result: 1 if OK to continue. 0 if user aborted. new PriorErrorFound new FileNumber,FileName new field,count,index new input new DoneArray set DoneArray="" new result set result=1 if ($get(File)="")!($get(pArray)="") set result=0 goto COFDone if +File=File do . set FileNumber=File . set FileName=$$GetFName^TMGDBAPI(File) else do . set FileName=File . set FileNumber=$$GetFileNum^TMGDBAPI(File) if FileNumber'>0 do goto COFDone . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") set indent=+$get(indent,0) if $data(@pArray)'>1 set @pArray@("*")="" ;"if $data(@pArray@("*"))>0 do goto COFDone ;"ORDER not allowed if all records requested. ;". write ?indent,"Note: skipping option for field ordering because ALL fields",! ;". write ?indent,"were selected for export.",! ;". write ?indent,"(This is a technical limitation of this routine.)",!! COFLoop write ?indent,"Do you wish to customize the ORDER that ",! write ?indent,"fields will appear in the XML file? (Y/N,^) NO// " new input read input:$get(DTIME,3600),! if $TEST=0 set input="^" if input="^" set result=0 goto COFDone if input="" set input="N" set input=$$UP^XLFSTR(input) if input'["Y" goto COFDone if input="?" do goto COFLoop . write ?indent,"If you want to specify the order that the fields will be exported, enter YES.",! COFL1 new maxNum set maxNum=0 set index=$order(@pArray@("ORDER","")) if index'="" for do quit:(index="") . new n set n=@pArray@("ORDER",index) . if index>maxNum set maxNum=index . set index=$order(@pArray@("ORDER",index)) set field=$order(@pArray@("")) set count=0 new CountArray if field'="" do . write ?indent,"Choose one of the following fields:",! if field'="" for do quit:(+field'>0) . if $data(DoneArray(field))=0 do . . set count=count+1 . . set CountArray(count)=field . . write ?indent,count,". Field: ",field . . if +field=field do . . . write " (",$$GetFldName^TMGDBAPI(File,field),")",! . . else write ! . set field=$order(@pArray@(field)) if count=0 do goto COFDone . write ?indent,"All done specifying field order.",!! . do Pause() COFL2 if count>1 do . write ?indent,"Note: Don't enter actual field number.",! . write ?indent,"Which field should come " . if maxNum=0 write "first." . else write "next." . write "? (1-"_count_",^ to abort) " . read input,!! . if $TEST=0 set input="^" else do . write ?indent,"Only one option left, so I'll enter it for you...",! . set input=1 if ((input<1)!(input>count))&(input'="^") goto COFL2 if input="^" do set result=0 goto COFDone . kill @pArray@("ORDER") . write ?indent,"Because the process of specifying an order",! . write ?indent,"for the fields wasn't completed, the partial ",! . write ?indent,"order information was deleted.",! . do Pause(indent) set maxNum=maxNum+1 new tempField set tempField=$get(CountArray(input)) set @pArray@("ORDER",maxNum)=tempField set DoneArray(tempField)="" goto COFL1 COFDone quit result ShowArray(indent) ;"Purpose: To show the array that composes the XML export request if ($data(TMGxmlArray)>0)&($data(@TMGxmlArray)) do . write ! . new i for i=1:1:indent set indent(i)=0 . do ArrayDump^TMGDEBUG(TMGxmlArray,,.indent) . ;"zwr @TMGxmlArray . write ! do Pause(.indent) quit Pause(indent) ;"Purpose: To prompt user to hit enter to continue ;"Input: indent -- OPTIONAL -- number of spaces to indent from left margin. ;" Note: to call with no value for indent, use "do Pause()" new temp set indent=$get(indent,0) write ?indent read "Press [Enter] to continue...",temp:$get(DTIME,3600),! quit WriteHeader(pHeader,SuppressLF) ;"Purpose: to put a header at the top of the screen ;" The screen will be cleared ;"Note: because global variable IOF is used, the VistA environement must be setup first. ;"Input: pHeader -- expected format: ;" pHeader(1)="First Line" ;" pHeader(2)="Second Line" ;" pHeader("MAX LINE")=2 ;" SuppressLF -- OPTIONAL if =1, then extra LF suppressed ;"Result: none write @IOF if $get(pHeader)="" goto WHDone new max set max=+$get(@pHeader@("MAX LINE")) if max=0 goto WHDone for index=1:1:max do . if $data(@pHeader@(index))=0 quit . new line set line=$get(@pHeader@(index)) . if (line[" Step") do . . if (index0) do . new fldInfo set fldInfo=$piece($get(^DD(FileNumber,field,0)),"^",2) . if fldInfo'["P" quit . new otherFile set otherFile=+$piece(fldInfo,"P",2) . if $$GetFName^TMGDBAPI(otherFile)="" do quit . set Array(FileNumber,"POINTERS OUT",field,otherFile)="" . set found=1 quit found CustPtrOuts(Array,RecsArray) ;"Purpose: Given an array of pointers out (as created by GetPtrsOut), look at the ;" specific group of records (provided in RecsArray) and trim out theoretical ;" pointers, and only leave actual pointers in the list. ;"Input: Array PASS BY REFERENCE. Format: ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" ;" RecsArray ;" RecsArray(FileNumber,IENinFile)="" ;" RecsArray(FileNumber,IENinFile)="" ;" RecsArray(FileNumber,IENinFile)="" ;" Note: Array may well have other information in it. ;"Output: Array pointer will be trimmed such that every pointer listed exists ;" in at least of the records in RecsArray new fileNum,fieldNum,IEN set fileNum="" for set fileNum=$order(Array(fileNum)) quit:(+fileNum'>0) do . set fieldNum="" . for set fieldNum=$order(Array(fileNum,"POINTERS OUT",fieldNum)) quit:(+fieldNum'>0) do . . ;"Now, for given file:field, do any records in RecsArray contain a value? . . new ref set ref=$get(^DIC(fileNum,0,"GL")) ;"record global ref string (open ended) . . new node set node=$get(^DD(fileNum,fieldNum,0)) ;"node=entire 0 node . . new np set np=$piece(node,"^",4) ;"get node;piece . . new n set n=$piece(np,";",1) ;"n=node . . new p set p=$piece(np,";",2) ;"p=piece . . set IEN="" . . new found set found=0 . . for set IEN=$order(RecsArray(fileNum,IEN)) quit:(+IEN'>0)!(found=1) do . . . new tempRef set tempRef=ref_IEN_","""_n_""")" . . . new line set line=$get(@tempRef) . . . new ptr set ptr=+$piece(line,"^",p) ;"get data from database . . . if ptr>0 set found=1 quit ;"found at least one record in group has an actual pointer . . if found=1 quit ;"don't cut out the theoritical pointers (but no actual data) . . kill Array(fileNum,"POINTERS OUT",fieldNum) quit TrimPtrOut(Array) ;"Purpose: Given array of pointers out (as created by GetPtrsOut, or CustPtrsOut), ask which ;" other files should be ignored. ;"Input: Array. PASS BY REFERENCE. Format: ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" ;"Output: for those pointers out that can be ignored, entries will be changed: ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="-" <-- Ignore flag ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="+" <-- Confirmed flag ;"first, make a temp array that groups pointers out. new Array2 new fileNum set fileNum=0 for set fileNum=$order(Array(fileNum)) quit:(+fileNum'>0) do . new fieldNum set fieldNum=0 . new ref . for set fieldNum=$order(Array(fileNum,"POINTERS OUT",fieldNum)) quit:(+fieldNum'>0) do . . new otherFileNum set otherFileNum=$order(Array(fileNum,"POINTERS OUT",fieldNum,"")) . . if +otherFileNum'>0 quit . . new ref set ref=$name(Array(fileNum,"POINTERS OUT",fieldNum,otherFileNum)) . . new IEN set IEN=$order(^TMG(22708,"B",otherFileNum,"")) . . if (IEN'=""),$piece($get(^TMG(22708,IEN,0)),"^",2)=0 do quit . . . set Array(fileNum,"POINTERS OUT",fieldNum,otherFileNum)="-" . . if (IEN'=""),$piece($get(^TMG(22708,IEN,0)),"^",2)=1 do quit . . . set Array(fileNum,"POINTERS OUT",fieldNum,otherFileNum)="+" . . set Array2(otherFileNum,ref)="" new menu,count new UsrInput,IEN new TMGFDA,TMGMSG,TMGIEN new ref,%,otherFileNum new otherFileNum if $data(Array2)=0 goto TPODone set menu(0)="Pick Which Pointers are NOT to User Data" set count=1 set otherFileNum=0 for set otherFileNum=$order(Array2(otherFileNum)) quit:(otherFileNum="") do . set menu(count)=$$GetFName^TMGDBAPI(otherFileNum)_$char(9)_otherFileNum_"^"_count . set count=count+1 TPO set UsrInput=$$Menu^TMGUSRIF(.menu) if "x^"[UsrInput goto TPODone if UsrInput["?" do goto TPO . write "Explore which entry above? //" . new temp read temp:$get(DTIME,3600),! . set temp=$piece($get(menu(temp)),$char(9),2) . set temp=$piece(temp,"^",1) . if temp="" quit . new DIC,X,Y . set DIC(0)="MAEQ" . set DIC=+temp . write "Here you can use Fileman to look at entries in file #",temp . do ^DIC write ! set ref="" set count=$piece(UsrInput,"^",2) set UsrInput=$piece(UsrInput,"^",1) for set ref=$order(Array2(UsrInput,ref)) quit:(ref="") do . set @ref="-" . kill menu(count) . set otherFileNum=+$piece(ref,",",4) set %=1 set IEN=$order(^TMG(22708,"B",otherFileNum,"")) if (IEN'=""),$piece($get(^TMG(22708,IEN,0)),"^",2)=0 goto TPO write "Remember that ",$$GetFName^TMGDBAPI(otherFileNum)," DOESN'T contain ",! WRITE " site-specific data (stored in File #22708)" do YN^DICN write ! if %'=1 goto TPO kill TMGMSG,TMGFDA,TMGIEN if +IEN>0 do . set TMGFDA(22708,IEN_",",1)=0 . do FILE^DIE("","TMGFDA","TMGMSG") else do . set TMGFDA(22708,"+1,",.01)=otherFileNum . set TMGFDA(22708,"+1,",1)=0 . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") do ShowIfDIERR^TMGDEBUG(.TMGMSG) goto TPO TPODone if $data(menu)=0 goto TPOQ if $order(menu(0))="" goto TPOQ new Entry set Entry=0 for set Entry=$order(menu(Entry)) quit:(Entry="") do . write " -- ",$piece(menu(Entry),$char(9),1),! write "Perminantly mark these files as CONTAINING site specific data" set %=1 do YN^DICN write ! if %=1 do . set Entry=0 . for set Entry=$order(menu(Entry)) quit:(Entry="") do . . set UsrInput=$piece(menu(Entry),$char(9),2) . . set otherFileNum=$piece(UsrInput,"^",1) . . set ref="" . . for set ref=$order(Array2(otherFileNum,ref)) quit:(ref="") do . . . set @ref="+" . . set IEN=$order(^TMG(22708,"B",otherFileNum,"")) . . if (IEN'=""),$piece($get(^TMG(22708,IEN,0)),"^",2)=1 quit . . if +IEN>0 do . . . set TMGFDA(22708,IEN_",",1)=1 . . . do FILE^DIE("","TMGFDA","TMGMSG") . . else do . . . kill TMGIEN . . . set TMGFDA(22708,"+1,",.01)=otherFileNum . . . set TMGFDA(22708,"+1,",1)=1 . . . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) TPOQ quit GetRecsOut(RecsArray,PtrsArray,Array) ;"Purpose: For a given set of records in a file, determine the linked-to record #'s ;" in other files through pointers out. This will return the actual IEN's ;" in other files that are being pointed to. ;"Input -- PtrsArray. PASS BY REFERENCE. Format: ;" RecsArray(FileNumber,IENinFile)="" ;" RecsArray(FileNumber,IENinFile)="" ;" RecsArray(FileNumber,IENinFile)="" ;" Note: Array may well have other information in it. ;" RecsArray. PASS BY REFERENCE. Format: ;" PtrsArray(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" ;" PtrsArray(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="-" <-- flag to ignore ;" PtrsArray(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" ;" Array. PASS BY REFERENCE. An OUT PARAMETER. Format: ;" Array(FileNumber,IEN,FieldNum,"LINKED TO",OtherFileNum,OtherIEN)="" ;" Array(FileNumber,IEN,FieldNum,"LINKED TO",OtherFileNum,OtherIEN)="" ;" Array(FileNumber,IEN,FieldNum,"LINKED TO",OtherFileNum,OtherIEN)="" ;" Array("X1",OtherFileNum,OtherIEN)="" ;" Array("X1",OtherFileNum,OtherIEN)="" ;"Output: Array is filled as above. ;"Results: None new fileNum set fileNum=0 for set fileNum=$order(PtrsArray(fileNum)) quit:(+fileNum'>0) do . new IEN set IEN=0 . for set IEN=$order(RecsArray(fileNum,IEN)) quit:(+IEN'>0) do . . new fieldNum set fieldNum=0 . . for set fieldNum=$order(PtrsArray(fileNum,"POINTERS OUT",fieldNum)) quit:(+fieldNum'>0) do . . . new otherFileNum set otherFileNum=$order(PtrsArray(fileNum,"POINTERS OUT",fieldNum,"")) . . . if +otherFileNum'>0 quit . . . new flag set flag=$get(PtrsArray(fileNum,"POINTERS OUT",fieldNum,otherFileNum)) . . . if flag="-" quit . . . new otherIEN set otherIEN=$$GET1^DIQ(fileNum,IEN_",",fieldNum,"I") . . . if +otherIEN'>0 quit . . . set Array(fileNum,IEN,fieldNum,"LINKED TO",otherFileNum,otherIEN)="" . . . if $data(RecsArray(otherFileNum,otherIEN))=0 do . . . . set Array("X1",otherFileNum,otherIEN)="tag=POINTED_TO_RECORD" quit ExpandPtrs(pRecsArray) ;"Purpose: To take selected record set and include records from other files that ;" the selected records point to. Only records in files that marked as holding ;" site-specific data will be added ;" new changed new RecsArray new PtrsArray,Array merge RecsArray=@pRecsArray T1 set changed=0 set fileNum=0 for set fileNum=$order(RecsArray(fileNum)) quit:(fileNum="") do . if $$GetPtrsOut(fileNum,.PtrsArray)=0 goto TQuit . do CustPtrOuts(.PtrsArray,.RecsArray) . do TrimPtrOut(.PtrsArray) . do GetRecsOut(.RecsArray,.PtrsArray,.Array) . if $data(Array("X1")) do . . merge RecsArray=Array("X1") . . set changed=1 . . kill Array("X1") if changed=1 goto T1 TQuit merge @pRecsArray=RecsArray quit Test new Recs,fileNum if $data(^TMG("TMP","KILLTHIS"))=0 do . if $$UI^TMGXMLUI("RecsArray")=0 quit . merge ^TMG("TMP","KILLTHIS")=Recs else do . merge Recs=^TMG("TMP","KILLTHIS") do ExpandPtrs("Recs") quit