Home | The Company | Publications | Products | Links | Tips | Jobs |
---|
Example of Routine USR1057NRead a NATURAL Source Into an ArrayBy Dieter W. StorrLast update: 24 November 2006 Question:How can I read NATURAL source code?Answer:NATURAL subprogram USR1057N can be used to read source code to do the following:
DEFINE DATA LOCAL 1 V (I01) CONST <20> LOCAL 1 USR1057L 2 OBJECT-KEY 3 LIBRARY (A08) 3 OBJECT-NAME (A32) 3 OBJECT-TYPE (A02) /* 2 INPUTS 3 OPT-ACCESS (A01) 3 OPT-UNUSED-1 (L) 3 OPT-UNUSED-2 (A01) 3 OPT-LINE-NUM (A01) 3 OPT-UNUSED-3 (L) 3 OPT-REDEF-DIR (L) 3 OPT-UNUSED-4 (A01) 3 OPT-AMOUNT (I02) 3 OPT-LINESIZE (I02) /* 2 INPUT-OUTPUTS 3 INT-HANDLE (I04) 3 NEXT-SEQ (I04) 3 NEXT-NUM (I02) /* 2 OUTPUTS 3 RETURNED (I02) 3 SRC-NUM (I02/1:V) 3 SRC-TEXT (A01/1:V,1:72) 3 REDEFINE SRC-TEXT 4 SRC-GROUP (1:V) 5 SRC-LINE (A72) 3 REDEFINE SRC-TEXT 4 DIR-OBJNAME (A32) /* Object Name 4 DIR-LIBRARY (A08) /* Library ID 4 DIR-OBJTYPE (A02) /* Object Type 4 DIR-OBJKIND (A01) /* Source or Module 4 DIR-DBID (A05) /* DBID of System File 4 DIR-FNR (A05) /* FNR of System File 4 DIR-DATN (A08) /* Date in Format (YYYYMMDD) 4 DIR-TIMN (A07) /* Time in Format (HHIISST) 4 DIR-USERID (A08) /* User ID 4 DIR-PROGMODE (A01) /* Programming Mode 4 DIR-SRCSIZE (A10) /* Source Area Size 4 DIR-GPSIZE (A10) /* Size of Module 4 DIR-UNIQUE-ID (A32) /* Unique ID 4 DIR-DDM-DBID (A05) /* DBID the DDM is cataloged with 4 DIR-DDM-FNR (A05) /* FNR the DDM is cataloged with 4 DIR-NATVERS (A04) /* NATURAL Version 4 DIR-NATSM (A02) /* NATURAL SM Level 4 DIR-INIT-USER (A08) /* Init User ID 4 DIR-TID (A08) /* Terminal ID 4 DIR-TRANS-NAME (A08) /* TP Transcation Name 4 DIR-OPSYS (A08) /* Operating System 4 DIR-TPSYS (A08) /* TP System 4 DIR-USED-GDA (A08) /* Used GDA 4 FILLER 80X 4 DIR-SAVE-CAT-TIME (T) /* Save date in internal format /* End of directory attributes 3 SRC-SEQ (I04/1:V) 3 SRC-LONG (A01/1:V) /* 1 USR1057N 2 VERSION (I01) INIT <2> 2 V1-NSC-CKECK (A01) 2 V2-DBID (N05) 2 V2-FNR (N04) 2 V2-PSW (A08) 2 V2-CIP (N08) 2 V2-SYSFILE (A01) 1 REDEFINE USR1057N 2 EXTENDED-PARMS 3 EXTENDED-DATA (A01/1:28) /* LOCAL USING USR-MSG /* Data for message exchange LOCAL USING USR-FLD /* Description of the field in error /* LOCAL 1 LOCAL-MSG (A79) 1 IX (I02) 1 INPUT-OK (L) END-DEFINE /* SET KEY ALL /* LIBRARY := *LIBRARY-ID OBJECT-NAME := *PROGRAM OPT-LINE-NUM := 'Y' OPT-REDEF-DIR := TRUE OPT-AMOUNT := 20 OPT-LINESIZE := 72 /* OPT-ACCESS := 'O' /* REPEAT IF NAD-FLD.FIELD-POSITION = 0 THEN NAD-FLD.FIELD-POSITION := 2 END-IF INPUT (AD=MITL'_' IP=OFF) TEXT NAD-MSG.MSG, MSG-DATA (1), MSG-DATA (2), MSG-DATA (3) MARK NAD-FLD.FIELD-POSITION / 18T 'Read a NATURAL source into an array:' (I) / 18T '-' (36) (I) / / 18T 'System file (U/N) ....' V2-SYSFILE / 18T 'Library ..............' LIBRARY / 18T 'Source ...............' OBJECT-NAME (AL=8) / 18T 'Object type ..........' OBJECT-TYPE (AL=1) / 18T 'DBID of Source .......' V2-DBID / 18T 'FNR of Source ........' V2-FNR / 18T 'PSW of Source ........' V2-PSW (AD=N) / 18T 'CIPERCODE of Source ..' V2-CIP / 18T 'Amount of lines ......' OPT-AMOUNT / 18T 'Line size ............' OPT-LINESIZE / 18T 'Return line numbers ..' OPT-LINE-NUM / 18T 'Redefine directory ...' OPT-REDEF-DIR (EM=F/T) // 18T 'PRESS ANY PF-KEY TO STOP.' RESET NAD-FLD.FIELD-POSITION /* IF *PF-KEY NE 'ENTR' ESCAPE ROUTINE END-IF /* IF OPT-AMOUNT > V COMPRESS 'The maximum for the amount is' V 'in this example program.' INTO LOCAL-MSG NAD-MSG.MSG := LOCAL-MSG NAD-FLD.FIELD-POSITION := 4 ESCAPE TOP END-IF /* IF OPT-LINESIZE > 72 COMPRESS 'The maximum for the line size is' 72 'in this example program.' INTO LOCAL-MSG NAD-MSG.MSG := LOCAL-MSG NAD-FLD.FIELD-POSITION := 4 ESCAPE TOP END-IF /* REPEAT /* CALLNAT 'USR1057N' USR1057L USR1057N.EXTENDED-PARMS NAD-MSG NAD-FLD /* IF OPT-ACCESS = 'O' AND OPT-REDEF-DIR AND MSG-NR = 0 WRITE (AD=OIL) 'Back with message number:' MSG-NR / / '=' DIR-OBJNAME / '=' DIR-LIBRARY / '=' DIR-OBJKIND / '=' DIR-OBJTYPE / '=' DIR-DATN / '=' DIR-TIMN / '=' DIR-USERID / '=' DIR-PROGMODE / '=' DIR-SRCSIZE / '=' DIR-GPSIZE /* Mainframe specific: // '=' DIR-NATVERS / '=' DIR-NATSM / '=' DIR-INIT-USER / '=' DIR-TID / '=' DIR-TRANS-NAME / '=' DIR-OPSYS / '=' DIR-TPSYS / '=' DIR-USED-GDA / '=' DIR-SAVE-CAT-TIME (EM=YYYY-MM-DD) DIR-SAVE-CAT-TIME (EM=HH:II:SS.T) END-IF /* OPT-ACCESS := 'R' /* FOR IX = 1 TO RETURNED WRITE (ZP=ON) SRC-NUM (IX) (NL=4) SRC-LONG (IX) SRC-LINE (IX) (AL=71) END-FOR /* IF *PF-KEY NE 'ENTR' OPT-ACCESS := 'C' CALLNAT 'USR1057N' USR1057L USR1057N.EXTENDED-PARMS NAD-MSG NAD-FLD ESCAPE ROUTINE END-IF /* IF MSG-NR NE 0 IF NOT INPUT-OK AND RETURNED = 0 * NAD-MSG.MSG, MSG-DATA (1), MSG-DATA (2), MSG-DATA (3) and * NAD-FLD.FIELD-POSITION is set ESCAPE BOTTOM ELSE WRITE (AD=LI) / 'Message number ....' NAD-MSG.MSG-NR / 'Message ...........' NAD-MSG.MSG (AL=59) / 'Message type ......' NAD-MSG.MSG-TYPE / 'Message data ......' NAD-MSG.MSG-DATA (1:3) // 'Field structure ...' NAD-FLD.FIELD-STRUCTURE / 'Field name ........' NAD-FLD.FIELD-NAME / 'Field position ....' NAD-FLD.FIELD-POSITION / 'Field index .......' NAD-FLD.FIELD-INDEX1 NAD-FLD.FIELD-INDEX2 NAD-FLD.FIELD-INDEX3 ESCAPE ROUTINE END-IF END-IF /* INPUT-OK := TRUE /* All parameter checks are done END-REPEAT END-REPEAT /* END And the display: Read a NATURAL source into an array: ------------------------------------ System file (U/N) .... _ Library .............. SYSEXT__ Source ............... USR1057P Object type .......... _ DBID of Source ....... 0_____ FNR of Source ........ 0____ PSW of Source ........ CIPERCODE of Source .. 0________ Amount of lines ...... 20____ Line size ............ 72____ Return line numbers .. Y Redefine directory ... T PRESS ANY PF-KEY TO STOP. Page 1 06-11-24 12:15:19 Back with message number: 0 DIR-OBJNAME: USR1057P DIR-LIBRARY: SYSEX31M DIR-OBJKIND: DIR-OBJTYPE: P DIR-DATN: 20010312 DIR-TIMN: 1031000 DIR-USERID: SSZ DIR-PROGMODE: S DIR-SRCSIZE: 0000006706 DIR-GPSIZE: DIR-NATVERS: 4.1 DIR-NATSM: 02 DIR-INIT-USER: SSZ DIR-TID: DIR-TRANS-NAME: DIR-OPSYS: WNT-X86 DIR-TPSYS: DIR-USED-GDA: DIR-SAVE-CAT-TIME: 2001-03-12 10:31:00.0 And the member: Page 2 06-11-24 12:15:19 0 USR1057P SYSEX31MP 200103121031000SSZ 0 S0000006706 4.1 0 2SSZ WNT-X86 0000000000000000000000 0 000000000 0000000000000000000010779525760000000000??éêì-? 0 1 /* This program serves as example how to design a user-defined 2 /* program to call 'USR1057N'. 3 /********************************************************************** 4 DEFINE DATA 5 LOCAL 6 1 V (I01) CONST <20> 7 LOCAL 8 1 USR1057L 9 2 OBJECT-KEY 10 3 LIBRARY (A08) 11 3 OBJECT-NAME (A32) 12 3 OBJECT-TYPE (A02) 13 /* 14 2 INPUTS 15 3 OPT-ACCESS (A01) 16 3 OPT-UNUSED-1 (L) (snip) 206 END-IF 207 END-IF 208 /* 209 INPUT-OK := TRUE /* All parameter checks are done 210 END-REPEAT 211 END-REPEAT 212 /* 213 END Message number .... 100 Message ........... End of data reached Message type ...... 1 Message data ...... Field structure ... Field name ........ Field position .... 0 Field index ....... 0 0 0
Back to NATURAL Tips, Tricks, Techniques -- Overview |