This program creates a simple organization chart using a text file as input.

---

 *****************************************************************
 ** PROGRAM: ORGCHART.Q **
 ** PURPOSE: CONVERTS EMPLOYEE INFO INTO AN ORGANIZATION CHART. **
 ** INPUT..: EMPLOYEE TEXT FILE. **
 ** OUTPUT.: ORGANIZATION CHART. **
 ** NOTES..: THERE ARE BETTER WAYS TO CREATE AN ORG CHART FROM **
 ** A TEXT FILE THAN THE METHOD USED. **
 ** THIS PROGRAM IS CAPABLE OF HANDLING UP TO 350 **
  ** ENTRIES. **
 *****************************************************************
  OPTION STMTMAX = 1000
 OPTION STRMAX = 150
 
 EQUATE HP-PRINT-ESC-SEQ TO 'Y' * HEWLETT PACKARD ESC SEQ?
 EQUATE HP-PRINT-FONT TO 'S' * (S)MALL OR (L)ARGE FONT
 EQUATE HP-ORIENTATION TO 'L' * (P)ORTRAIT OR (L)ANDSCAPE
 EQUATE LEFT-MARGIN TO 9 * LEFT MARGIN SIZE
 EQUATE BOXES-PER-PAGE TO 14 * VERTICAL BOXES PER PAGE
 
 EQUATE IFA-FILE TO PRMA1-40 * ????????.TXT
 EQUATE OFA-FILE TO 'ORGCHART.OUT'
 EQUATE IFA-MAX-REC-LEN TO 200
 EQUATE OFA-MAX-REC-LEN TO 400
 
 OPTION IFASIZE = IFA-MAX-REC-LEN
 OPTION OFASIZE = OFA-MAX-REC-LEN
 OPTION WSTSIZE = 3000 * WORK AREA
 OPTION OFCSIZE = 32000 * WORK AREA FOR ET-TABLE. NO FILE I/O.
 OPTION OFDSIZE = 7000 * WORK AREA FOR ES-TABLE. NO FILE I/O.
 
 DISPLAY ' '
 
 EQUATE IFA-NAME TO IFA1-15
 EQUATE IFA-NAME-1 TO IFA1
 EQUATE IFA-TITLE TO IFA1-15
 EQUATE IFA-TITLE-1 TO IFA1
 *
 EQUATE WST-EMPLOYEE-NAME TO WST4-18
 EQUATE WST-EMPLOYEE-NAME-1 TO WST4
 EQUATE WST-EMPLOYEE-TITLE TO WST19-33
 EQUATE WST-EMPLOYEE-TITLE-1 TO WST19
 EQUATE WST-MANAGER-NAME TO WST34-48
 EQUATE WST-MANAGER-NAME-1 TO WST34
 EQUATE WST-FILLER1 TO WST49-64
 EQUATE WST-IFA-END-SW TO WST64-64
 EQUATE WST-1ST-EMPLOYEE TO WST65-67
 EQUATE WST-SEQ-NO TO WST68-70-N
 EQUATE WST-HIGH-GROUP TO WST71-73-N
 EQUATE WST-SAVE-GROUP TO WST74-76-N
 EQUATE WST-GROUP TO WST77-79-N
 EQUATE WST-GROUP-BEG TO WST80-80
 EQUATE WST-GROUP-END TO WST81-81
 EQUATE WST-HIGH-LEVEL TO WST82-84-N
 EQUATE WST-LEVEL TO WST85-87-N
 EQUATE WST-HIGH-COL TO WST88-90-N
 EQUATE WST-COL TO WST91-93-N
 EQUATE WST-GROUP-MOVED-SW TO WST94-94
 EQUATE WST-EMPLOYEE-MOVED-SW TO WST95-95
 EQUATE WST-FILLER2 TO WST96-99
 EQUATE WORKING-WHEEL-SPOKES TO WST100-103
 EQUATE WORKING-WHEEL-SPOKE TO WST100
 
 EQUATE CP-LINEA TO WST200-699 * CHT PRINT - LINE A
 EQUATE CP-LINEA1-79 TO WST200-278 * CHT PRINT - LINE A 1-79
 EQUATE CP-LINEA-1 TO WST200 * CHT PRINT - 1 BYTE
 EQUATE CP-CONNECT TO WST209-209 * CHT PRINT - CONNECTION BYTE
 EQUATE CP-LINEB TO WST700-1199 * CHT PRINT - LINE B
 EQUATE CP-LINEB1-79 TO WST700-778 * CHT PRINT - LINE B 1-79
 EQUATE CP-BOX-TOP TO WST701-717 * CHT PRINT - BOX TOP
 EQUATE CP-LINEC TO WST1200-1699 * CHT PRINT - LINE C
 EQUATE CP-LINEC1-79 TO WST1200-1278 * CHT PRINT - LINE C 1-79
 EQUATE CP-C-BOX-LEFT TO WST1201-1201 * CHT PRINT - BOX LEFT
 EQUATE CP-EMPLOYEE-NAME TO WST1202-1216 * CHT PRINT - EMPLOYEE NAME
 EQUATE CP-C-BOX-RIGHT TO WST1217-1217 * CHT PRINT - BOX RIGHT
 EQUATE CP-LINED TO WST1700-2199 * CHT PRINT - LINE D
 EQUATE CP-LINED1-79 TO WST1700-1778 * CHT PRINT - LINE D 1-79
 EQUATE CP-D-BOX-LEFT TO WST1701-1701 * CHT PRINT - BOX LEFT
 EQUATE CP-EMPLOYEE-TITLE TO WST1702-1716 * CHT PRINT - EMPLOYEE NAME
 EQUATE CP-D-BOX-RIGHT TO WST1717-1717 * CHT PRINT - BOX RIGHT
 EQUATE CP-LINEE TO WST2200-2699 * CHT PRINT - LINE E
 EQUATE CP-LINEE1-79 TO WST2200-2278 * CHT PRINT - LINE E 1-79
 EQUATE CP-BOX-BOT TO WST2201-2217 * CHT PRINT - BOX BOTTOM
 EQUATE CP-LENGTH TO 18 * CHT PRINT - BOX LENGTH
 EQUATE CP-SUB-MAX-MAX TO OFA-MAX-REC-LEN * CHT PRINT - MAX LINE LENGTH
 
 EQUATE WST-ERROR-MSG TO WST2700-2778 * ERROR MESSAGE AREA
 EQUATE WST-ERROR-NAME TO WST2700-2714 * ERROR MESSAGE EMPLOYEE
 
 * SUBSCRIPTS
 EQUATE WORKING-WHEEL-SUB TO WST2800-I
  EQUATE PARM-SUB TO WST2802-I
 EQUATE IFA-SUB TO WST2804-I
 EQUATE OFA-SUB TO WST2806-I
 EQUATE WST-SUB TO WST2808-I
 EQUATE ES-MAX TO WST2810-I
 EQUATE ES-SUB  TO WST2812-I
 EQUATE ET-MAX TO WST2814-I
 EQUATE ET-SUB TO WST2816-I
 EQUATE ET-SUB2 TO WST2818-I
 EQUATE ET-SUB3 TO WST2820-I
 EQUATE ET-SUB4 TO WST2822-I
 EQUATE WST-ES-CNT TO WST2824-I
 EQUATE WST-ET-COL TO WST2826-I
 EQUATE CP-SUB TO WST2828-I
 EQUATE CP-SUB-MAX TO WST2830-I
 
 * INTEGERS
 EQUATE WORKING-WHEEL-TIMER TO WST2836-I
 EQUATE ES-CNT TO WST2838-I
 EQUATE ET-CNT TO WST2840-I
 EQUATE ET-CNT2 TO WST2842-I
 EQUATE ET-CNT3 TO WST2844-I
 EQUATE ET-CNT4 TO WST2846-I
 EQUATE BOX-PAGE-CNT TO WST2850-I
 
 EQUATE EMPLOYEE-TABLE TO OFC01-24000 * EMP TABLE - START OF TABLE
 EQUATE ET-ENTRY TO OFC01-67 * EMP TABLE - ENTRY
 EQUATE ET-EMPLOYEE TO OFC01-15 * EMP TABLE - EMPLOYEE NAME
 EQUATE ET-EMPLOYEE-NAME TO OFC01-15 * EMP TABLE - EMPLOYEE NAME
 EQUATE ET-TITLE TO OFC16-30 * EMP TABLE - EMPLOYEE TITLE
 EQUATE ET-EMPLOYEE-TITLE TO OFC16-30 * EMP TABLE - EMPLOYEE-TITLE
 EQUATE ET-MANAGER TO OFC31-45 * EMP TABLE - MANAGER NAME
 EQUATE ET-MANAGER-NAME TO OFC31-45 * EMP TABLE - NAMAGER NAME
 EQUATE ET-SEQ-NO TO OFC46-48-N * EMP TABLE - NEXT ENTRY
 EQUATE ET-LINK-SUB TO OFC49-53-N * EMP TABLE - SUBSCRIPT TO NEXT ENTRY
 EQUATE ET-GROUP TO OFC54-56-N * EMP TABLE - GROUP IDENTIFIER
 EQUATE ET-GROUP-BEG TO OFC57-57 * EMP TABLE - GROUP BRANCH BEGIN
 EQUATE ET-GROUP-END  TO OFC58-58 * EMP TABLE - GROUP BRANCH END
 EQUATE ET-LEVEL TO OFC59-61-N * EMP TABLE - EMPLOYEE LEVEL
 EQUATE ET-COL TO OFC62-64-N * EMP TABLE - COLUMN
 EQUATE ET-COL-START TO OFC65-67-N  * EMP TABLE - STARTING COLUMN
 EQUATE ET-LENGTH TO 67 * EMP TABLE - ENTRY LENGTH
 EQUATE ET-MAX-MAX TO 350 * EMP TABLE - MAXIMUM ENTRIES
 
 EQUATE ENTRY-STACK TO OFD001 * ENTRY STACK - START OF STACK
 EQUATE ES-ENTRY TO OFD001-019 * ENTRY STACK - ENTRY
 EQUATE ES-COUNTER TO OFD001-003-N * ENTRY STACK - CNT
 EQUATE ES-SUBSCRIPT TO OFD004-008-N * ENTRY STACK - SUBSCRIPT
  EQUATE ES-GROUP TO OFD009-011-N * ENTRY STACK - GROUP IDENTIFIER
 EQUATE ES-GROUP-BEG TO OFD012-012 * ENTRY STACK - GROUP BRANCH BEGIN
 EQUATE ES-GROUP-END TO OFD013-013 * ENTRY STACK - GROUP BRANCH END
  EQUATE ES-LEVEL TO OFD014-016-N * ENTRY STACK - EMPLOYEE LEVEL
 EQUATE ES-COL TO OFD017-019-N * ENTRY STACK - EMPLOYEE COLUMN
 EQUATE ES-LENGTH TO 19 * ENTRY STACK - ENTRY LENGTH
  EQUATE ES-MAX-MAX TO 350 * ENTRY STACK - MAXIMUM ENTRIES
 
 PERFORM 10000 * OPEN FILES / GET PARMS / INIT MEMORY
 PERFORM 20000 * LOAD EMPLOYEE INFO INTO EMP TABLE
 PERFORM 30000 * PERFORM EMPLOYEE INFO ERROR CHECKING
 PERFORM 40000 * TRAVERSE EMP TABLE
 PERFORM 50000 * PROCESS OVERLAPPING ENTRIES BY GROUP
 PERFORM 60000 * PRINT FLOWCHART
 PERFORM 70000 * TERMINATION
  END
 
 *** OPEN FILES / GET PARMS / INIT MEMORY
10000 CLS
 IF PRMA-RECSIZE IS ZEROS
 MOVE 'NO PROGRAM PARAMETERS!' TO WST-ERROR-MSG
 PERFORM 90000. * ERROR ROUTINE
 DISPLAY PROG NOSKIP
 DISPLAY ' WORKING...'
  OPEN IFA PRMA1-40 IFA-MAX-REC-LEN
 OPEN OFA OFA-FILE OFA-MAX-REC-LEN
 MOVE SPACES TO WST
 MOVE SPACES TO OFC
 MOVE SPACES TO OFD
 MOVE 120 TO OFA-RECSIZE
 MOVE ZEROS TO WORKING-WHEEL-TIMER
 MOVE '|/-\' TO WORKING-WHEEL-SPOKES
10099 EXIT
 
 *** LOAD EMPLOYEE INFO INTO EMP TABLE
20000 MOVE 1 TO ET-SUB
 MOVE 1 TO ET-MAX
20020 IF ET-MAX > ET-MAX-MAX
 MOVE 'MAXIMUM NUMBER OF ALLOWABLE EMPLOYEES EXCEEDED!' TO WST-ERROR-MSG
 PERFORM 90000. * ERROR ROUTINE
 PERFORM 20100 * GET NEXT EMPLOYEE NAME AND TITLE
 PERFORM 20200 * GET MANAGER NAME
 MOVE WST-EMPLOYEE-NAME TO ET-EMPLOYEE-NAME (ET-SUB)
 MOVE WST-EMPLOYEE-TITLE TO ET-EMPLOYEE-TITLE (ET-SUB)
 MOVE WST-MANAGER-NAME TO ET-MANAGER-NAME (ET-SUB)
 IF WST-IFA-END-SW = 'Y'
 SUBTRACT 1 FROM ET-MAX
 EXIT.
 ADD 1 TO ET-MAX
 ADD ET-LENGTH TO ET-SUB
 GO TO 20020
20099 EXIT
 
 *** GET NEXT EMPLOYEE AND TITLE FROM FILE ***
20100 MOVE SPACES TO WST-EMPLOYEE-NAME
 MOVE SPACES TO WST-EMPLOYEE-TITLE
20110 READ IFA
 IF IFA IS EOF
 MOVE 'Y'  TO WST-IFA-END-SW
 EXIT.
 IF IFA IS SPACES
 GO TO 20110.
 MOVE 1 TO IFA-SUB
20120 IF IFA-NAME-1 (IFA-SUB) IS SPACE
 ADD 1 TO IFA-SUB
 GO TO 20120.
 IF IFA-NAME-1 (IFA-SUB) = '*' * BYPASS COMMENT LINES
 GO TO 20110.
 MOVE 1 TO WST-SUB
20130 IF IFA-SUB > IFA-RECSIZE
 OR IFA-NAME-1 (IFA-SUB) IS SPACE
 EXIT.
 IF IFA-NAME-1 (IFA-SUB) = ','
 ADD 1 TO IFA-SUB
 MOVE 1 TO WST-SUB
 GO TO 20140.
 IF IFA-NAME-1 (IFA-SUB) = '~'
 MOVE SPACE TO WST-EMPLOYEE-NAME-1 (WST-SUB)
 ELSE
 MOVE IFA-NAME-1 (IFA-SUB) TO WST-EMPLOYEE-NAME-1 (WST-SUB).
 ADD 1 TO IFA-SUB
 ADD 1 TO WST-SUB
 GO TO 20130
20140 IF IFA-SUB > IFA-RECSIZE
 EXIT.
20150 IF IFA-TITLE-1 (IFA-SUB) IS SPACE
 ADD 1 TO IFA-SUB
 GO TO 20140.
20160 IF IFA-SUB > IFA-RECSIZE
 OR IFA-TITLE-1 (IFA-SUB) IS SPACE
 EXIT.
 IF IFA-TITLE-1 (IFA-SUB) = '~'
 MOVE SPACE TO WST-EMPLOYEE-TITLE-1 (WST-SUB)
 ELSE
 MOVE IFA-TITLE-1 (IFA-SUB) TO WST-EMPLOYEE-TITLE-1 (WST-SUB).
 ADD 1 TO IFA-SUB
 ADD 1 TO WST-SUB
 GO TO 20160
20199 EXIT
 
 *** GET NEXT MANAGER FROM FILE ***
20200 MOVE SPACES TO WST-MANAGER-NAME
 IF IFA IS EOF
 EXIT.
20210 IF IFA-SUB > IFA-RECSIZE
 OR IFA-NAME-1 (IFA-SUB) = '*' * BYPASS COMMENT LINES
 EXIT.
20220 IF IFA-NAME-1 (IFA-SUB) IS SPACE
 ADD 1 TO IFA-SUB
 GO TO 20210.
 MOVE 1 TO WST-SUB
20230 IF IFA-SUB > IFA-RECSIZE
 OR IFA-NAME-1 (IFA-SUB) IS SPACE
 OR IFA-NAME-1 (IFA-SUB) = ',' * BYPASS MANAGER TITLES IF PRESENT
  EXIT.
 IF IFA-NAME-1 (IFA-SUB) = '~'
 MOVE SPACE TO WST-MANAGER-NAME-1 (WST-SUB)
 ELSE
 MOVE IFA-NAME-1 (IFA-SUB) TO WST-MANAGER-NAME-1 (WST-SUB).
 ADD 1 TO IFA-SUB
 ADD 1 TO WST-SUB
 GO TO 20230
20299 EXIT
 
 *** PERFORM EMPLOYEE ERROR CHECKING ***
30000 MOVE 1 TO ET-CNT
 MOVE 1 TO ET-SUB
 MOVE 0 TO WST-1ST-EMPLOYEE * INIT 1ST EMPLOYEE POINTER
30010 IF ET-CNT > ET-MAX
 EXIT.
 PERFORM 30100  * CHECK EMPLOYEES FOR ERRORS
 PERFORM 30200 * CHECK MANAGERS FOR ERRORS
 ADD 1 TO ET-CNT
 ADD ET-LENGTH TO ET-SUB
 GO TO 30010
30099 EXIT
 
 *** CHECK EMPLOYEES FOR ERRORS ***
30100 MOVE 1 TO ET-CNT2
 MOVE 1 TO ET-SUB2
30110 IF ET-CNT2 > ET-MAX
 EXIT.
 IF ET-EMPLOYEE (ET-SUB2) = ET-EMPLOYEE (ET-SUB)
 IF ET-CNT <> ET-CNT2
 MOVE 'EMPLOYEE XXXXXXXXXXXXXXX OCCURS MORE THAN ONCE!' TO WST-ERROR-MSG
 MOVE ET-EMPLOYEE-NAME (ET-SUB)  TO WST-ERROR-NAME (10)
 PERFORM 90000. * ERROR ROUTINE
 ADD 1 TO ET-CNT2
 ADD ET-LENGTH TO ET-SUB2
 GO TO 30110
30199 EXIT
 
* *** CHECK MANAGERS FOR ERRORS ***
30200 MOVE 1 TO ET-CNT2
 MOVE 1 TO ET-SUB2
  IF ET-MANAGER-NAME (ET-SUB) IS SPACES
 IF WST-1ST-EMPLOYEE = 0 * MORE THAN 1 EMPLOYEE WITHOUT A MANAGER?
 MOVE ET-CNT TO WST-1ST-EMPLOYEE
 EXIT
 ELSE
 MOVE 'UNABLE TO DETERMINE 1ST EMPLOYEE!' TO WST-ERROR-MSG
 PERFORM 90000. * ERROR ROUTINE
 IF ET-EMPLOYEE (ET-SUB) = ET-MANAGER (ET-SUB)
 MOVE 'MANAGER XXXXXXXXXXXXXXX IS INVALID!' TO WST-ERROR-MSG
 MOVE ET-MANAGER-NAME (ET-SUB) TO WST-ERROR-NAME (9)
 PERFORM 90000.  * ERROR ROUTINE
30210 IF ET-CNT2 > ET-MAX
 MOVE 'MANAGER XXXXXXXXXXXXXXX NOT DEFINED!' TO WST-ERROR-MSG
 MOVE ET-MANAGER-NAME (ET-SUB) TO WST-ERROR-NAME (9)
 PERFORM 90000. * ERROR ROUTINE
 IF ET-EMPLOYEE (ET-SUB2) = ET-MANAGER (ET-SUB)
 EXIT.
 ADD 1 TO ET-CNT2
 ADD ET-LENGTH TO ET-SUB2
 GO TO 30210
30299 EXIT
 
 *** TRAVERSE EMP TABLE ***
40000 MOVE WST-1ST-EMPLOYEE TO ET-CNT * START AT TOP OF TREE
 MOVE WST-1ST-EMPLOYEE TO ET-SUB
 SUBTRACT 1 FROM ET-SUB
 MULTIPLY ET-SUB BY ET-LENGTH
 ADD 1 TO ET-SUB
 MOVE 1 TO WST-GROUP
 MOVE 1 TO WST-LEVEL
 MOVE 1 TO WST-COL
 MOVE 1 TO ET-SEQ-NO (ET-SUB)
 MOVE 1 TO ET-GROUP (ET-SUB)
 MOVE 1 TO ET-LEVEL (ET-SUB)
 MOVE 1 TO ET-COL (ET-SUB)
 MOVE 1 TO ET-COL-START (ET-SUB)
 MOVE 'Y' TO ET-GROUP-BEG (ET-SUB)
 MOVE ' ' TO ET-GROUP-END (ET-SUB)
 MOVE 1 TO WST-SEQ-NO
 MOVE 0 TO ES-CNT
 MOVE 0  TO ES-SUB
40010 PERFORM 40100 * FIND ALL EMPLOYEES UNDER MANAGER
 IF ES-CNT = 0 * ANY BRANCHES LEFT TO TRAVERSE?
 EXIT. * NO, EXIT.
 MOVE ES-COUNTER (ES-SUB) TO ET-CNT * POP EMPLOYEE OFF STACK
 MOVE ES-SUBSCRIPT (ES-SUB) TO ET-LINK-SUB (ET-SUB)
 MOVE ES-SUBSCRIPT (ES-SUB) TO ET-SUB
 ADD 1 TO WST-SEQ-NO
 MOVE WST-SEQ-NO TO ET-SEQ-NO (ET-SUB)
 MOVE ES-GROUP (ES-SUB) TO ET-GROUP (ET-SUB)
 MOVE ES-GROUP-BEG (ES-SUB) TO ET-GROUP-BEG (ET-SUB)
 MOVE ES-GROUP-END (ES-SUB) TO ET-GROUP-END (ET-SUB)
 MOVE ES-LEVEL (ES-SUB) TO ET-LEVEL (ET-SUB)
 MOVE ES-LEVEL (ES-SUB) TO WST-LEVEL
 MOVE ES-COL (ES-SUB) TO ET-COL (ET-SUB)
  MOVE ES-COL (ES-SUB) TO ET-COL-START (ET-SUB)
 SUBTRACT 1 FROM ES-CNT
 SUBTRACT ES-LENGTH FROM ES-SUB
 GO TO 40010
40099 EXIT
 
 *** FIND ALL EMPLOYEES UNDER MANAGER ***
40100 MOVE ES-CNT TO WST-ES-CNT
  MOVE 1 TO ET-CNT2
 MOVE 1 TO ET-SUB2
40110 IF ET-CNT2 > ET-MAX
 IF WST-ES-CNT = ES-CNT * END OF BRANCH FOUND?
 MOVE 'Y' TO ET-GROUP-END (ET-SUB) * GROUP BRANCH END = YES
 EXIT
 ELSE
 MOVE ' ' TO ET-GROUP-END (ET-SUB) * GROUP BRANCH END = NO
 EXIT.
 IF ET-MANAGER (ET-SUB2) <> ET-EMPLOYEE (ET-SUB)
 ADD 1 TO ET-CNT2
 ADD ET-LENGTH TO ET-SUB2
 GO TO 40110.
 
 IF WST-ES-CNT = ES-CNT * NEW BRANCH FOUND?
 MOVE ' ' TO WST-GROUP-BEG * NO...
 MOVE ET-GROUP (ET-SUB) TO WST-SAVE-GROUP
 MOVE ET-COL (ET-SUB) TO WST-COL
 ADD 1 TO WST-LEVEL
 ELSE
 MOVE 'Y' TO WST-GROUP-BEG  * YES... SET START OF BRANCH
 ADD 1 TO WST-GROUP
 MOVE WST-GROUP TO WST-SAVE-GROUP
 ADD 1 TO WST-COL.
 IF WST-GROUP > WST-HIGH-GROUP
 MOVE WST-GROUP TO WST-HIGH-GROUP.
 IF WST-LEVEL > WST-HIGH-LEVEL
  MOVE WST-LEVEL TO WST-HIGH-LEVEL.
 IF WST-COL > WST-HIGH-COL
 MOVE WST-COL TO WST-HIGH-COL.
 ADD 1 TO ES-CNT
 ADD ES-LENGTH TO ES-SUB
 IF ES-CNT > ES-MAX-MAX
 MOVE 'EMPLOYEE STACK OVERFLOW!' TO WST-ERROR-MSG
 PERFORM 90000. * ERROR ROUTINE
 MOVE ET-CNT2 TO ES-COUNTER (ES-SUB)
 MOVE ET-SUB2 TO ES-SUBSCRIPT (ES-SUB)
 MOVE WST-SAVE-GROUP TO ES-GROUP (ES-SUB)
 MOVE WST-GROUP-BEG TO ES-GROUP-BEG (ES-SUB)
 MOVE WST-LEVEL TO ES-LEVEL (ES-SUB)
 MOVE WST-COL TO ES-COL (ES-SUB)
 ADD 1 TO ET-CNT2
 ADD ET-LENGTH TO ET-SUB2
 GO TO 40110
40199 EXIT
 
 *** PROCESS OVERLAPPING ENTRIES BY GROUP
50000 MOVE 2 TO WST-GROUP
 MOVE 'N' TO WST-GROUP-MOVED-SW
 MOVE 'N' TO WST-EMPLOYEE-MOVED-SW
50010 IF WST-GROUP > WST-HIGH-GROUP
 IF WST-GROUP-MOVED-SW = 'Y'
  GO TO 50000
 ELSE
 EXIT.
50020 PERFORM 50100 * FIND FIRST EMPLOYEE IN GROUP
 MOVE ET-CNT4 TO ET-CNT
 MOVE ET-SUB4 TO ET-SUB
 PERFORM 50200 * CHECK EMPLOYEES IN GROUP FOR OVERLAPS
 IF WST-EMPLOYEE-MOVED-SW = 'Y'
 GO TO 50000.
 ADD 1 TO WST-GROUP
 GO TO 50010
50099 EXIT
 
 *** FIND FIRST EMPLOYEE IN GROUP
50100 MOVE 1 TO ET-CNT4
 MOVE 1 TO ET-SUB4
50110 IF ET-CNT4 > ET-MAX
 MOVE 'FIRST EMPLOYEE IN GROUP NOT FOUND!' TO WST-ERROR-MSG
 PERFORM 90000. * ERROR ROUTINE
 IF ET-GROUP-BEG (ET-SUB4) = 'Y' * BEGINNING EMPLOYEE IN GROUP FOUND
 IF ET-GROUP (ET-SUB4) = WST-GROUP
 EXIT.
 ADD 1 TO ET-CNT4
 ADD ET-LENGTH TO ET-SUB4
 GO TO 50110
50199 EXIT
 
 *** CHECK ENTRIES IN GROUP FOR OVERLAPS
50200 PERFORM 50300 * CHECK EMPLOYEE IN GROUP FOR OVERLAPS
 IF WST-EMPLOYEE-MOVED-SW = 'Y' * AN EMPLOYEE WAS SHIFTED?
 EXIT.
 IF ET-GROUP-END (ET-SUB) = 'Y' * END OF GROUP?
 IF ET-GROUP (ET-SUB) = WST-GROUP * ENDING ON SAVE GROUP?
 EXIT.
50250 MOVE ET-LINK-SUB (ET-SUB) TO ET-SUB * GET NEXT LINKED EMPLOYEE
 IF ET-GROUP (ET-SUB) = WST-GROUP * NEXT EMPLOYEE IN GROUP?
 GO TO 50200. * YES, GO CHECK THIS EMPLOYEE
 GO TO 50250 * NO, GET NEXT EMPLOYEE
50299 EXIT
 
 *** CHECK ENTRY IN GROUP FOR OVERLAPS
50300 MOVE 1 TO ET-CNT2
  MOVE 1 TO ET-SUB2
50310 IF ET-CNT2 > ET-MAX
 EXIT.
 PERFORM 80000 * DISPLAY WORKING WHEEL
 IF ET-SEQ-NO (ET-SUB) >= ET-SEQ-NO (ET-SUB2)
 OR ET-LEVEL (ET-SUB) <> ET-LEVEL (ET-SUB2)
 OR ET-COL (ET-SUB) <> ET-COL (ET-SUB2)
 ADD 1 TO ET-CNT2
 ADD ET-LENGTH TO ET-SUB2
 GO TO 50310.
 PERFORM 50400 * SHIFT EMPLOYEE CLUSTER RIGHT 1 COLUMN
50399 EXIT
 
 *** SHIFT EMPLOYEE CLUSTER RIGHT 1 COLUMN
50400 MOVE ET-CNT4 TO ET-CNT  * POINT TO FIRST EMPLOYEE IN GROUP
 MOVE ET-SUB4 TO ET-SUB * POINT TO FIRST EMPLOYEE IN GROUP
 MOVE 'Y' TO WST-EMPLOYEE-MOVED-SW
 MOVE 'Y' TO WST-GROUP-MOVED-SW
50410 IF ET-LINK-SUB (ET-SUB) = 0 * NO MORE EMPLOYEES?
 OR ET-GROUP (ET-SUB) < WST-GROUP * OR NEXT CLUSTER FOUND?
 EXIT. * TRUE, EXIT
 ADD 1 TO ET-COL (ET-SUB) * ADD 1 TO COLUMN
 MOVE ET-LINK-SUB (ET-SUB) TO ET-SUB * GET NEXT EMPLOYEE
 GO TO 50410
50499 EXIT
 
 *** PRINT FLOWCHART
60000 PERFORM 60700 * PRINT FLOWCHART PAGE HEADER
 MOVE 1 TO WST-LEVEL
60010 IF WST-LEVEL > WST-HIGH-LEVEL
 EXIT.
 PERFORM 60100 * GET ALL ENTRIES ON CURRENT LEVEL
 PERFORM 60200 * CONNECT EMTRIES HORIZONTALLY
 PERFORM 60400 * WRITE ORG CHART FILE
**** PERFORM 60500 * DISPLAY ORG CHART LINE
 ADD 1 TO WST-LEVEL
 GO TO 60010
60099 EXIT
 
 *** GET ALL ENTRIES ON CURRENT LEVEL
60100 MOVE 1 TO ET-CNT
 MOVE 1 TO ET-SUB
 MOVE 1 TO CP-SUB-MAX
 MOVE SPACES TO CP-LINEA
 MOVE SPACES TO CP-LINEB
 MOVE SPACES TO CP-LINEC
 MOVE SPACES TO CP-LINED
  MOVE SPACES TO CP-LINEE
60110 IF ET-CNT > ET-MAX
 ADD CP-LENGTH TO CP-SUB-MAX * SET FINAL PRINT LINE LENGTH
 EXIT.
 IF ET-LEVEL (ET-SUB) <> WST-LEVEL
 ADD 1 TO ET-CNT
 ADD ET-LENGTH TO ET-SUB
 GO TO 60110.
 MOVE ET-COL (ET-SUB) TO CP-SUB
 SUBTRACT 1 FROM CP-SUB
 MULTIPLY CP-SUB BY CP-LENGTH
 ADD LEFT-MARGIN TO CP-SUB * SET PRINT LINE MARGIN
 
 IF CP-SUB > CP-SUB-MAX-MAX
 MOVE 'EXCEEDED OUTPUT FILE RECORD SIZE!' TO WST-ERROR-MSG
 PERFORM 90000. * ERROR ROUTINE
 
 *********************************
 *** SET NEW PRINT LINE LENGTH ***
 IF CP-SUB > CP-SUB-MAX
 MOVE CP-SUB TO CP-SUB-MAX.
 *********************************
 
  MOVE ET-EMPLOYEE-NAME (ET-SUB) TO CP-EMPLOYEE-NAME (CP-SUB)
 MOVE ET-EMPLOYEE-TITLE (ET-SUB) TO CP-EMPLOYEE-TITLE (CP-SUB)
 
60150 MOVE '³' TO CP-C-BOX-LEFT (CP-SUB)
 MOVE 'Û' TO CP-C-BOX-RIGHT (CP-SUB)
  MOVE '³' TO CP-D-BOX-LEFT (CP-SUB)
 MOVE 'Û' TO CP-D-BOX-RIGHT (CP-SUB)
 MOVE 'ÀÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ' TO CP-BOX-BOT (CP-SUB)
 IF ET-MANAGER-NAME (ET-SUB) IS SPACES
 MOVE 'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' TO CP-BOX-TOP (CP-SUB)
 ADD 1 TO ET-CNT
 ADD ET-LENGTH TO ET-SUB
 GO TO 60110
 ELSE
 MOVE 'ÚÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄ ' TO CP-BOX-TOP (CP-SUB).
 
 
60160 IF ET-GROUP-BEG (ET-SUB) = 'Y' * START OF BRANCH?
 MOVE '¿'  TO CP-CONNECT (CP-SUB)
 ELSE
 MOVE '³' TO CP-CONNECT (CP-SUB).
 ADD 1 TO ET-CNT
 ADD ET-LENGTH TO ET-SUB
 GO TO 60110
60199 EXIT
 
 *** CONNECT ENTRIES HORIZONTALLY
60200 MOVE CP-SUB-MAX  TO CP-SUB
60210 IF CP-SUB < 1
 EXIT.
 IF CP-LINEA-1 (CP-SUB) = '¿'
 OR CP-LINEA-1 (CP-SUB) = 'Â'
 PERFORM 60300 * FILL HORZONTAL GAPS WITH 'Ä'
 GO TO 60210.
 SUBTRACT 1 FROM CP-SUB
 GO TO 60210
60299 EXIT
 
 *** FILL HORIZONTAL GAPS WITH 'Ä'
60300 SUBTRACT 1 FROM CP-SUB
60310 IF CP-SUB < 1
 EXIT.
 IF CP-LINEA-1 (CP-SUB) IS SPACE
 MOVE 'Ä' TO CP-LINEA-1 (CP-SUB)
 SUBTRACT 1 FROM CP-SUB
 GO TO 60310.
  IF CP-LINEA-1 (CP-SUB) = '³'
 MOVE 'Ã'