Re: How to find damaged objects

I agree that a save is a good way to find damaged objects but I do have a
program that runs daily to identify damaged objects. First, this command
is executed, which generates an outfile of all object descriptions. One
of the fields that is output is a damaged flag.

DSPOBJD OBJ(*ALL/*ALL) OBJTYPE(*ALL) DETAIL(*FULL) OUTPUT(*OUTFILE)
OUTFILE(QGPL/DSPOBJD)

Next, this program is run which generates a report of the objects flagged
as damaged and e-mails it to me:

H
**************************************************************************
H* DAMRPT -- Report of Damaged Objects
H
**************************************************************************
H*
H* Program ID -- DAMRPT
H* Author -- Dave Parnin
H* Date -- 07-14-10
H*
H
**************************************************************************
H*
H* Program Narrative
H*
H* This program will generate a change request status report.
H*
H*
H* Mod Date Desc
H* ----- -------- ----
H*
H
**************************************************************************
H* Function Of Subroutines
H*
H
**************************************************************************
H
H
**************************************************************************
H* Environment Stuff
H
**************************************************************************
H Option(*SrcStmt:*NoDebugIO)
H
F
**************************************************************************
F* File Specifications
F
**************************************************************************
FDSPOBJDL1 IF E K DISK
FDAMRPTO O E PRINTER
F
D
**************************************************************************
D* Definition Specifications
D
**************************************************************************
D* *ENTRY PLIST
DDAMRPT PR ExtPgm('NSCRDESW')
D XXJOBNAME 10A
D
DDAMRPT PI
D XJOBNAME 10A
D
DFAC S 2A
DXUSER S 10A
DPRINTED S 1A
DREPORTIT S 1A
DCOMMAND S 200A
DXLEN S 15 5
DQUOTE S 1A INZ('''')
DWKDATE S D DATFMT(*ISO)
DOUTDT S 8 0
D
D SDS SDS
D JOBNAME 244 253 * Job name
D USER 254 263
D JOBNUM 264 269S 0 * Job number
D
DJOBDS DS
D NUMJOBNUM 6S 0
D CHARJOBNUM 6A Overlay(NUMJOBNUM)
D
D
**************************************************************************
D* Prototypes
D
**************************************************************************
DCMD PR ExtPgm('QCMDEXC')
D Command 200A Const
D LENGTH 15P 5
D
DNSCREMAIL PR ExtPgm('NSCREMAIL')
D JobName 10A
D JobUser 10A
D JobNum 6A
D ToAdd 80A
D
D
I
**************************************************************************
I* Input Specifications
I
**************************************************************************
I
C
**************************************************************************
C* Parameter List
C
**************************************************************************
C
C
C
**************************************************************************
C* Key List
C
**************************************************************************
C
C
**************************************************************************
C* Mainline Routine
C
**************************************************************************
C/Free
// Main flow of the program

ExSr INIT;

// Generate report
ExSr GENREPORT;


// That's All Folks!

Eval *INLR = '1';



//**************************************************************************
// Subroutines


//**************************************************************************



//**************************************************************************
// GENREPORT--Generate Report


//**************************************************************************
BegSR GENREPORT;

// Get first record
Read QLIDOBJD;

// Loop through the file of system objects
DoW Not %Eof(DSPOBJDL1);

// If object damaged then report it (1=Full, 2=Partial)
If ODOBDM = '1' or ODOBDM = '2';
ExSr PRINTLN;
EndIf;

Read QLIDOBJD;
EndDo;

EndSr;



//**************************************************************************
// PRINTLN--Print Report Line


//**************************************************************************
BegSR PRINTLN;

If *INOF = *on;
WRITE HEADER;
*inof = *off;
EndIf;

Write DETAIL;
PRINTED = 'Y';

EndSr;



//**************************************************************************
// EMAIL--E-Mail Report


//**************************************************************************
BegSR EMAIL;

// NUMJOBNUM = JOBNUM;
// NSCREMAIL(JOBNAME:XUSER:CHARJOBNUM:NAEMAIL);


EndSr;



//**************************************************************************
// INIT--Initialize Stuff


//**************************************************************************
BegSR INIT;

XUSER = USER;
PRINTED = 'N';
*inof = *on;

EndSr;
/End-Free


DAMRPTO Printer file:

A R HEADER
A SKIPB(1)
A 1DATE
A EDTCDE(Y)
A 57'AS30 Damaged Objects'
A 11TIME
A 123'PAGE'
A 128PAGNBR
A SPACEA(2)
A EDTCDE(Z)
A 2'Library'
A UNDERLINE
A 23'Object'
A UNDERLINE
A 40'Object Type'
A HIGHLIGHT
A UNDERLINE
A R HEADER
A SKIPB(1)
A 1DATE
A EDTCDE(Y)
A 57'AS30 Damaged Objects'
A 11TIME
A 123'PAGE'
A 128PAGNBR
A SPACEA(2)
A EDTCDE(Z)
A 2'Library'
A UNDERLINE
A 23'Object'
A UNDERLINE
A 40'Object Type'
A HIGHLIGHT
A UNDERLINE
A 65'Description'
A HIGHLIGHT
A UNDERLINE
A 119'Creation Date'
A SPACEA(1)
A HIGHLIGHT
A UNDERLINE
A ODCDAT 6 O 122TEXT('Creation Date')
A
A R DETAIL
A ODOBNM 10 O 23TEXT('Object')
A ODOBTP 8 O +7TEXT('Object Type')
A ODOBTX 50 O 65TEXT('Description')
A ODLBNM 10 O 2TEXT('Library')
A SPACEA(1)



Dave Parnin
--
Nishikawa Cooper, LLC
(formerly Nishikawa Standard Company)
324 Morrow Street
Topeka, IN 46571
daparnin@xxxxxxxxxxxxxx
--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.