home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / mdfjobd.lzh / MDFLIBL.RPG < prev    next >
Text File  |  1990-04-08  |  17KB  |  249 lines
  1. 000100900405     FMDFLIBLDCF  E                    WORKSTN
  2. 000200860116     E                    LIBL      275  1               Parameter
  3. 000300900404     E                    LIBA       10  1               Parameter
  4. 000400900406     E                    SAV        13  1               Parameter
  5. 000500851111     E                    ARR        25 13  A            Seqnbr/lib
  6. 000600851111     C           *ENTRY    PLIST                           Parm list
  7. 000700851111     C                     PARM           LIBL             Lib list
  8. 000800851111     C                     PARM           PGMTYP  4        Prog type
  9. 000900860116     C                     PARM           JOBDNM           JOBD name
  10. 001000860107     C                     PARM           RTNCDE  8        Return code
  11. 001100860107     C* Initialize
  12. 001200860107     C                     MOVE 'NOCHG   'RTNCDE           Assm no chg
  13. 001300851231     C           PGMTYP    COMP 'JOBD'                   80 If JOBD typ
  14. 001400851111     C                     MOVE *BLANKS   BLANK3  3        Blank 3 byts
  15. 001500851111     C           REPEAT    TAG                             REPEAT
  16. 001600851111     C                     MOVE '010'     SEQ1             Prime seq 1
  17. 001700851111     C                     MOVE '020'     SEQ2
  18. 001800851111     C                     MOVE '030'     SEQ3
  19. 001900851111     C                     MOVE '040'     SEQ4
  20. 002000851111     C                     MOVE '050'     SEQ5
  21. 002100851111     C                     MOVE '060'     SEQ6
  22. 002200851111     C                     MOVE '070'     SEQ7
  23. 002300851111     C                     MOVE '080'     SEQ8
  24. 002400851111     C                     MOVE '090'     SEQ9
  25. 002500851111     C                     MOVE '100'     SEQ10
  26. 002600851111     C                     MOVE '110'     SEQ11
  27. 002700851111     C                     MOVE '120'     SEQ12
  28. 002800851111     C                     MOVE '130'     SEQ13
  29. 002900851111     C                     MOVE '140'     SEQ14
  30. 003000851111     C                     MOVE '150'     SEQ15
  31. 003100851111     C                     MOVE '160'     SEQ16
  32. 003200851111     C                     MOVE '170'     SEQ17
  33. 003300851111     C                     MOVE '180'     SEQ18
  34. 003400851111     C                     MOVE '190'     SEQ19
  35. 003500851111     C                     MOVE '200'     SEQ20
  36. 003600851111     C                     MOVE '210'     SEQ21
  37. 003700851111     C                     MOVE '220'     SEQ22
  38. 003800851111     C                     MOVE '230'     SEQ23
  39. 003900851111     C                     MOVE '240'     SEQ24
  40. 004000851111     C                     MOVE '250'     SEQ25
  41. 004100900405     C                     Z-ADD0         X       30       Lib count
  42. 004200900405     C                     Z-ADD1         Y       30       Lib count
  43. 004300851111     C           LOOP      TAG                             LOOP
  44. 004400900405     C                     EXSR CLEAR
  45. 004500900405     C                     Z-ADD1         Z       30       Bump inx
  46. 004600860929     C           Y         CABGE276       DISPLY           If at end
  47. 004700900404     C           LIBL,Y    DOUEQ' '
  48. 004800900404     C                     MOVE LIBL,Y    LIBA,Z           Extract lib
  49. 004900900406     C                     ADD  1         Y
  50. 005000900406     C                     ADD  1         Z
  51. 005100900404     C                     END
  52. 005200900404     C                     MOVEALIBA      LIB    10
  53. 005300851111     C           LIB       CABEQ*BLANK    DISPLY           If blank
  54. 005400900405     C                     ADD  1         X                Lib count
  55. 005500851111     C                     EXSR MV2DSP                     Exsr MV2DSP
  56. 005600900406     C                     ADD  1         Y
  57. 005700851111     C                     GOTO LOOP                       Goto LOOP
  58. 005800851111     C* Display the libraries
  59. 005900851111     C           DISPLY    TAG                             DISPLY
  60. 006000851111     C                     EXFMTPROMPT                     Prompt
  61. 006100851111     C* Check for CF1
  62. 006200900408     C   91                MOVE 'CF3     'RTNCDE           If CF1
  63. 006300851111     C   91                GOTO END                        If CF1
  64. 006400851111     C* Move libraries and sequence numbers to the array
  65. 006500851111     C                     MOVE LIB1      ARR,1            Move to ARR
  66. 006600000000     C                     MOVE LIB2      ARR,2
  67. 006700000000     C                     MOVE LIB3      ARR,3
  68. 006800000000     C                     MOVE LIB4      ARR,4
  69. 006900000000     C                     MOVE LIB5      ARR,5
  70. 007000000000     C                     MOVE LIB6      ARR,6
  71. 007100000000     C                     MOVE LIB7      ARR,7
  72. 007200000000     C                     MOVE LIB8      ARR,8
  73. 007300000000     C                     MOVE LIB9      ARR,9
  74. 007400000000     C                     MOVE LIB10     ARR,10
  75. 007500000000     C                     MOVE LIB11     ARR,11
  76. 007600000000     C                     MOVE LIB12     ARR,12
  77. 007700000000     C                     MOVE LIB13     ARR,13
  78. 007800000000     C                     MOVE LIB14     ARR,14
  79. 007900000000     C                     MOVE LIB15     ARR,15
  80. 008000000000     C                     MOVE LIB16     ARR,16
  81. 008100900408     C                     MOVE LIB17     ARR,17
  82. 008200000000     C                     MOVE LIB18     ARR,18
  83. 008300000000     C                     MOVE LIB19     ARR,19
  84. 008400000000     C                     MOVE LIB20     ARR,20
  85. 008500000000     C                     MOVE LIB21     ARR,21
  86. 008600000000     C                     MOVE LIB22     ARR,22
  87. 008700000000     C                     MOVE LIB23     ARR,23
  88. 008800000000     C                     MOVE LIB24     ARR,24
  89. 008900000000     C                     MOVE LIB25     ARR,25
  90. 009000851111     C                     MOVELSEQ1      ARR,1            Movel to ARR
  91. 009100000000     C                     MOVELSEQ2      ARR,2
  92. 009200000000     C                     MOVELSEQ3      ARR,3
  93. 009300000000     C                     MOVELSEQ4      ARR,4
  94. 009400000000     C                     MOVELSEQ5      ARR,5
  95. 009500000000     C                     MOVELSEQ6      ARR,6
  96. 009600000000     C                     MOVELSEQ7      ARR,7
  97. 009700000000     C                     MOVELSEQ8      ARR,8
  98. 009800000000     C                     MOVELSEQ9      ARR,9
  99. 009900000000     C                     MOVELSEQ10     ARR,10
  100. 010000000000     C                     MOVELSEQ11     ARR,11
  101. 010100000000     C                     MOVELSEQ12     ARR,12
  102. 010200000000     C                     MOVELSEQ13     ARR,13
  103. 010300000000     C                     MOVELSEQ14     ARR,14
  104. 010400000000     C                     MOVELSEQ15     ARR,15
  105. 010500000000     C                     MOVELSEQ16     ARR,16
  106. 010600000000     C                     MOVELSEQ17     ARR,17
  107. 010700000000     C                     MOVELSEQ18     ARR,18
  108. 010800851111     C                     MOVELSEQ19     ARR,19
  109. 010900851111     C                     MOVELSEQ20     ARR,20
  110. 011000851111     C                     MOVELSEQ21     ARR,21
  111. 011100851111     C                     MOVELSEQ22     ARR,22
  112. 011200851111     C                     MOVELSEQ23     ARR,23
  113. 011300851111     C                     MOVELSEQ24     ARR,24
  114. 011400851111     C                     MOVELSEQ25     ARR,25
  115. 011500900408     C                     MOVELSEQ1      ARR,1            Movel to ARR
  116. 011600900408     C                     MOVELSEQ2      ARR,2
  117. 011700900408     C                     MOVELSEQ3      ARR,3
  118. 011800900408     C                     MOVELSEQ4      ARR,4
  119. 011900900408     C                     MOVELSEQ5      ARR,5
  120. 012000900408     C                     MOVELSEQ6      ARR,6
  121. 012100900408     C                     MOVELSEQ7      ARR,7
  122. 012200900408     C                     MOVELSEQ8      ARR,8
  123. 012300900408     C                     MOVELSEQ9      ARR,9
  124. 012400900408     C                     MOVELSEQ10     ARR,10
  125. 012500900408     C                     MOVELSEQ11     ARR,11
  126. 012600900408     C                     MOVELSEQ12     ARR,12
  127. 012700900408     C                     MOVELSEQ13     ARR,13
  128. 012800900408     C                     MOVELSEQ14     ARR,14
  129. 012900900408     C                     MOVELSEQ15     ARR,15
  130. 013000900408     C                     MOVELSEQ16     ARR,16
  131. 013100900408     C                     MOVELSEQ17     ARR,17
  132. 013200900408     C                     MOVELSEQ18     ARR,18
  133. 013300900408     C                     MOVELSEQ19     ARR,19
  134. 013400900408     C                     MOVELSEQ20     ARR,20
  135. 013500900408     C                     MOVELSEQ21     ARR,21
  136. 013600900408     C                     MOVELSEQ22     ARR,22
  137. 013700900408     C                     MOVELSEQ23     ARR,23
  138. 013800900408     C                     MOVELSEQ24     ARR,24
  139. 013900900408     C                     MOVELSEQ25     ARR,25
  140. 014000851111     C* Place blanks in SEQ field if lib is blank
  141. 014100851111     C                     DO   25        X                Do 25 times
  142. 014200851111     C                     MOVE ARR,X     SAV10  10        Move to save
  143. 014300851111     C           SAV10     IFEQ *BLANK                     If blank lib
  144. 014400851111     C                     MOVELBLANK3    ARR,X            Blank seqnbr
  145. 014500851111     C                     END                             If blank lib
  146. 014600851111     C                     END                             Do 25 times
  147. 014700851111     C* Sort the array of libraries
  148. 014800900408     C                     SORTAARR                        Sort ARR
  149. 014900851111     C* Initialize
  150. 015000900408     C                     Z-ADD1         Y
  151. 015100851111     C                     MOVE *BLANK    LIBL             Blank array
  152. 015200851111     C* If SEQ is not blank, place the lib into the LIBL array
  153. 015300851111     C                     DO   25        X                Do 25 times
  154. 015400851111     C                     MOVELARR,X     SAV3    3        Movel seqnbr
  155. 015500900406     C           *BLANKS   IFNE SAV3                       If not blank
  156. 015600900406     C                     MOVEAARR,X     SAV              Move lib
  157. 015700900406     C                     Z-ADD4         C
  158. 015800900408     C           SAV,C     DOUEQ' '
  159. 015900900406     C                     MOVE SAV,C     LIBL,Y
  160. 016000900406     C                     ADD  1         Y
  161. 016100900406     C                     ADD  1         C       30
  162. 016200900406     C                     END
  163. 016300900408     C                     ADD  1         Y
  164. 016400851111     C                     END                             If not blank
  165. 016500900408     C                     EXSR CLEARS
  166. 016600851111     C                     END                             Do 25 times
  167. 016700851231     C* If chg occurred, then move blanks to display and start over
  168. 016800851231     C   95                DO                              Chg occurd
  169. 016900860107     C                     MOVE 'GOOD    'RTNCDE           Some change
  170. 017000851231     C                     EXSR BLKDSP                     Exsr BLKDSP
  171. 017100851231     C                     GOTO REPEAT                     Goto REPEAT
  172. 017200851231     C                     END                             Chg occurd
  173. 017300851111     C* End of program
  174. 017400851111     C           END       TAG                             END
  175. 017500851111     C                     SETON                     LR    Set LR
  176. 017600851111     C                     RETRN                           Return
  177. 017700900408      *
  178. 017800900405     C           CLEAR     BEGSR
  179. 017900900406     C                     DO   10        A       30
  180. 018000900405     C                     MOVEA' '       LIBA,A
  181. 018100900405     C                     END
  182. 018200900405     C                     ENDSR
  183. 018300900408      *
  184. 018400900408     C           CLEARS    BEGSR
  185. 018500900408     C                     DO   10        A       30
  186. 018600900408     C                     MOVEA' '       SAV,A
  187. 018700900408     C                     END
  188. 018800900408     C                     ENDSR
  189. 018900900405     C* Blank out display of library fields for change indicator
  190. 019000851111     C           BLKDSP    BEGSR                           BLKDSP subr
  191. 019100851111     C                     MOVE *BLANK    LIB              Blank lib
  192. 019200851111     C                     DO   25        X                Do 25 times
  193. 019300851111     C                     EXSR MV2DSP                     Exsr MV2DSP
  194. 019400851111     C                     END                             Do 25 times
  195. 019500851111     C                     ENDSR                           BLKDSP subr
  196. 019600851111     C* Move lib values to display fields depending on the count field
  197. 019700851111     C           MV2DSP    BEGSR                           MV2DSP subr
  198. 019800851111     C           X         COMP 1                        20 If X=1
  199. 019900851111     C   20                MOVE LIB       LIB1             Mv to Lib 1
  200. 020000851111     C           X         COMP 2                        20
  201. 020100851111     C   20                MOVE LIB       LIB2
  202. 020200851111     C           X         COMP 3                        20
  203. 020300851111     C   20                MOVE LIB       LIB3
  204. 020400851111     C           X         COMP 4                        20
  205. 020500851111     C   20                MOVE LIB       LIB4
  206. 020600851111     C           X         COMP 5                        20
  207. 020700851111     C   20                MOVE LIB       LIB5
  208. 020800851111     C           X         COMP 6                        20
  209. 020900851111     C   20                MOVE LIB       LIB6
  210. 021000851111     C           X         COMP 7                        20
  211. 021100851111     C   20                MOVE LIB       LIB7
  212. 021200851111     C           X         COMP 8                        20
  213. 021300851111     C   20                MOVE LIB       LIB8
  214. 021400851111     C           X         COMP 9                        20
  215. 021500851111     C   20                MOVE LIB       LIB9
  216. 021600851111     C           X         COMP 10                       20
  217. 021700851111     C   20                MOVE LIB       LIB10
  218. 021800851111     C           X         COMP 11                       20
  219. 021900851111     C   20                MOVE LIB       LIB11
  220. 022000851111     C           X         COMP 12                       20
  221. 022100851111     C   20                MOVE LIB       LIB12
  222. 022200851111     C           X         COMP 13                       20
  223. 022300851111     C   20                MOVE LIB       LIB13
  224. 022400851111     C           X         COMP 14                       20
  225. 022500851111     C   20                MOVE LIB       LIB14
  226. 022600851111     C           X         COMP 15                       20
  227. 022700851111     C   20                MOVE LIB       LIB15
  228. 022800851111     C           X         COMP 16                       20
  229. 022900851111     C   20                MOVE LIB       LIB16
  230. 023000851111     C           X         COMP 17                       20
  231. 023100851111     C   20                MOVE LIB       LIB17
  232. 023200851111     C           X         COMP 18                       20
  233. 023300851111     C   20                MOVE LIB       LIB18
  234. 023400851111     C           X         COMP 19                       20
  235. 023500851111     C   20                MOVE LIB       LIB19
  236. 023600851111     C           X         COMP 20                       20
  237. 023700851111     C   20                MOVE LIB       LIB20
  238. 023800851111     C           X         COMP 21                       20
  239. 023900851111     C   20                MOVE LIB       LIB21
  240. 024000851111     C           X         COMP 22                       20
  241. 024100851111     C   20                MOVE LIB       LIB22
  242. 024200851111     C           X         COMP 23                       20
  243. 024300851111     C   20                MOVE LIB       LIB23
  244. 024400851111     C           X         COMP 24                       20
  245. 024500851111     C   20                MOVE LIB       LIB24
  246. 024600851111     C           X         COMP 25                       20
  247. 024700851111     C   20                MOVE LIB       LIB25
  248. 024800851111     C                     ENDSR                           MV2DSP
  249.