****************************************************************** IDENTIFICATION DIVISION. ****************************************************************** PROGRAM-ID. DBRIP08. AUTHOR. XXXX XXXXXX XXXX XXXXX. DATE-WRITTEN. DEC-1991. ****************************************************************** PROCEDURE DIVISION. ****************************************************************** ****************************************************************** * STEUER PROCEDURE ****************************************************************** STEUER SECTION. ST-000. PERFORM VORVERARB PERFORM ST-100 PERFORM ST-990. ST-999. GOBACK. EJECT ****************************************************************** * VORVERARBEITUNG ****************************************************************** VORVERARB SECTION. VV-000. MOVE DFHCOMMAREA TO COMMAREA MOVE +6000 TO CA-LENGTH MOVE LOW-VALUE TO DBRIM8DI PERFORM VV-100. VV-999. EXIT. EJECT ****************************************************************** * HAUPTVERARBEITUNG ****************************************************************** HAUPTVERARB SECTION. HV-000. IF CA-SCHRITT = ZERO PERFORM HV-500 GO HV-999 END-IF. HV-050. **** HANDLING PF-FUNKTIONEN EVALUATE SWPF WHEN 1 GO HV-81 WHEN 2 GO HV-82 WHEN 3 PERFORM HV-83 GO HV-84 WHEN 4 GO HV-84 WHEN 5 GO HV-85 WHEN 6 GO HV-86 WHEN 7 GO HV-87 WHEN 8 GO HV-88 WHEN 9 GO HV-89 WHEN 10 PERFORM HV-90 GO HV-91 WHEN 11 GO HV-91 WHEN 12 GO HV-92 WHEN 13 GO HV-93 WHEN 14 GO HV-94 WHEN 15 PERFORM HV-95 GO HV-999 WHEN 16 PERFORM HV-96 GO HV-999 END-EVALUATE. HV-81. **** PF1-TASTE (HELP-PROGRAMM) PERFORM HV-95 GO HV-999. HV-82. **** PF2-TASTE / PRINTER-AUFRUF MOVE 2 TO CA-SWPF MOVE 0 TO CA-SCHRITT EXEC CICS LINK PROGRAM ( 'D154' ) END-EXEC GO HV-999. HV-84. **** PF4-TASTE PERFORM HV-95 GO HV-999. HV-85. **** PF5-TASTE PERFORM HV-95 GO HV-999. HV-86. **** PF6-TASTE PERFORM HV-95 GO HV-999. HV-87. * PF7-TASTE **** RUECKWAERTS BLAETTERN (INDIV.) PERFORM HV-95 GO HV-999. HV-88. * PF8-TASTE **** VORWAERTS BLAETTERN (INDIV.) PERFORM HV-95 GO HV-999. HV-89. **** PF9-TASTE PERFORM HV-95 GO HV-999. HV-91. **** PF11-TASTE **** AUSDRUCKEN: ZUERST NORMALE VER- **** ARBEITUNG (PLAUSI ETC.) PERFORM HV-200 GO HV-999. HV-92. **** PF12 - ENDE DER TRANSAKTION **** BILDSCHIRM AUF GROSS UMSCHALTEN MOVE 'G' TO P1-XM269 MOVE K-XM269 TO P200-1 CALL 'XM200' USING P-P008 P200-1 P1-XM269 PERFORM MODULE MOVE 99 TO SWPF GO HV-999. HV-93. **** ENTER (EMPFANGEN SCREEN) PERFORM HV-200 GO HV-999. HV-94. **** CLEAR (SENDEN LEERE MASKE) PERFORM HV-83 GO HV-84. HV-999. EXIT. EJECT ****************************************************************** ****************************************************************** * PROGRAMM - SUBROUTINEN ---> PLAUSI UND VERARB <--- ****************************************************************** ****************************************************************** ****************************************************************** * PLAUSIBILITAET ****************************************************************** PLAUSI SECTION. PL-000. MOVE ZERO TO SWFEHL CA-SWFEHL IF CA-SCHRITT > ZERO PERFORM PL-500 PERFORM PL-510 PERFORM PL-520 PERFORM PL-530 PERFORM PL-540 PERFORM PL-560 PERFORM PL-590 PERFORM PL-620 PERFORM PL-690 ELSE PERFORM PL-100 END-IF. PL-999. EXIT. EJECT ****************************************************************** * VERARBEITUNG ****************************************************************** VERARB SECTION. VA-000. IF CA-SCHRITT > ZERO CONTINUE PERFORM VA-500 ELSE MOVE 1 TO CA-SCHRITT DIVIDE CA-LB-SALDO BY CA-LB-RATE GIVING CA-LB-ANZRA REMAINDER R-REST IF R-REST NOT = ZERO MOVE 'Q' TO M8ANZRAA MOVE DFHBMBRY TO M8RATEA MOVE -1 TO M8ANZRAL MOVE 349 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF. VA-999. EXIT. EJECT ****************************************************************** ****************************************************************** * DIVERSE - SUBROUTINEN ****************************************************************** ****************************************************************** ****************************************************************** * FUELLEN COMMON-AREA ****************************************************************** CAFILL SECTION. CA-000. IF M8PRIDL > ZERO MOVE M8PRIDI TO CA-PRINTER END-IF IF M8PRIDF = X80 MOVE SPACE TO CA-PRINTER END-IF IF M8CANL > ZERO MOVE M8CANI TO CA-SCHACHTX END-IF IF M8CANF = X80 MOVE ZERO TO CA-SCHACHT END-IF IF M8ABS1L > ZERO MOVE M8ABS1I TO CA-ABS1 END-IF IF M8ABS1F = X80 MOVE SPACE TO CA-ABS1 END-IF IF M8ABS2L > ZERO MOVE M8ABS2I TO CA-ABS2 END-IF IF M8ABS2F = X80 MOVE SPACE TO CA-ABS2 END-IF IF M8ABS3L > ZERO MOVE M8ABS3I TO CA-ABS3 END-IF IF M8ABS3F = X80 MOVE SPACE TO CA-ABS3 END-IF IF M8ABS4L > ZERO MOVE M8ABS4I TO CA-ABS4 END-IF IF M8ABS4F = X80 MOVE SPACE TO CA-ABS4 END-IF IF M8ADRZ1L > ZERO MOVE M8ADRZ1I TO CA-ADRZ1 END-IF IF M8ADRZ1F = X80 MOVE SPACE TO CA-ADRZ1 END-IF IF M8ADRZ2L > ZERO MOVE M8ADRZ2I TO CA-ADRZ2 END-IF IF M8ADRZ2F = X80 MOVE SPACE TO CA-ADRZ2 END-IF IF M8ADRZ3L > ZERO MOVE M8ADRZ3I TO CA-ADRZ3 END-IF IF M8ADRZ3F = X80 MOVE SPACE TO CA-ADRZ3 END-IF IF M8ADRZ4L > ZERO MOVE M8ADRZ4I TO CA-ADRZ4 END-IF IF M8ADRZ4F = X80 MOVE SPACE TO CA-ADRZ4 END-IF IF M8ADRZ5L > ZERO MOVE M8ADRZ5I TO CA-ADRZ5 END-IF IF M8ADRZ5F = X80 MOVE SPACE TO CA-ADRZ5 END-IF IF M8ADSW1L > ZERO MOVE M8ADSW1I TO CA-ADRSW1 END-IF IF M8ADSW1F = X80 MOVE SPACE TO CA-ADRSW1 END-IF IF M8ADSW2L > ZERO MOVE M8ADSW2I TO CA-ADRSW2 END-IF IF M8ADSW2F = X80 MOVE SPACE TO CA-ADRSW2 END-IF IF M8ADSW3L > ZERO MOVE M8ADSW3I TO CA-ADRSW3 END-IF IF M8ADSW3F = X80 MOVE SPACE TO CA-ADRSW3 END-IF IF M8ADSW4L > ZERO MOVE M8ADSW4I TO CA-ADRSW4 END-IF IF M8ADSW4F = X80 MOVE SPACE TO CA-ADRSW4 END-IF IF M8SACHTL > ZERO MOVE M8SACHTI TO CA-SACHBT END-IF IF M8SACHTF = X80 MOVE SPACE TO CA-SACHBT END-IF IF M8SACH1L > ZERO MOVE M8SACH1I TO CA-SACHB1 END-IF IF M8SACH1F = X80 MOVE SPACE TO CA-SACHB1 END-IF IF M8SACH2L > ZERO MOVE M8SACH2I TO CA-SACHB2 END-IF IF M8SACH2F = X80 MOVE SPACE TO CA-SACHB2 END-IF IF M8ANREDL > ZERO MOVE M8ANREDI TO CA-ANRED END-IF IF M8ANREDF = X80 MOVE SPACE TO CA-ANRED END-IF IF M8ERDATL > ZERO MOVE M8ERDATI TO CA-LB-ERDAT END-IF IF M8ERDATF = X80 MOVE SPACE TO CA-LB-ERDAT END-IF IF M8MENDZL > ZERO MOVE M8MENDZI TO CA-LB-MENDZ END-IF IF M8MENDZF = X80 MOVE SPACE TO CA-LB-MENDZ END-IF IF M8MENDVL > ZERO MOVE M8MENDVI TO CA-LB-MENDV END-IF IF M8MENDVF = X80 MOVE SPACE TO CA-LB-MENDV END-IF IF M8OBJL > ZERO MOVE M8OBJI TO CA-LB-OBJ END-IF IF M8OBJF = X80 MOVE SPACE TO CA-LB-OBJ END-IF IF M8UEBETL > ZERO MOVE K-XM246 TO P200-1 CALL 'XM200' USING P-P008 P200-1 XM246-P1 M8UEBETI CA-LB-UEBET Z-UEBET PERFORM MODULE END-IF IF M8UEBETF = X80 MOVE ZERO TO CA-LB-UEBET MOVE SPACE TO Z-UEBET END-IF IF M8KAUTIL > ZERO MOVE K-XM246 TO P200-1 CALL 'XM200' USING P-P008 P200-1 XM246-P1 M8KAUTII CA-LB-KAUTI Z-KAUTI PERFORM MODULE END-IF IF M8KAUTIF = X80 MOVE ZERO TO CA-LB-KAUTI MOVE SPACE TO Z-KAUTI END-IF IF M8ZGUTL > ZERO MOVE K-XM246 TO P200-1 CALL 'XM200' USING P-P008 P200-1 XM246-P1 M8ZGUTI CA-LB-ZGUT Z-ZGUT PERFORM MODULE END-IF IF M8ZGUTF = X80 MOVE ZERO TO CA-LB-ZGUT MOVE SPACE TO Z-ZGUT END-IF IF M8ANZRAL > ZERO MOVE M8ANZRAI TO CA-LB-ANZRA END-IF IF M8ANZRAF = X80 MOVE ZERO TO CA-LB-ANZRA END-IF IF M8RATEL > ZERO MOVE K-XM246 TO P200-1 CALL 'XM200' USING P-P008 P200-1 XM246-P1 M8RATEI R-RATE Z-RATE PERFORM MODULE MOVE R-RATE TO CA-LB-RATE END-IF IF M8RATEF = X80 MOVE ZERO TO CA-LB-RATE MOVE SPACE TO Z-RATE END-IF IF M8FZ1L > ZERO MOVE M8FZ1I TO CA-FZ-1 END-IF IF M8FZ1F = X80 MOVE SPACE TO CA-FZ-1 END-IF IF M8FZ2L > ZERO MOVE M8FZ2I TO CA-FZ-2 END-IF IF M8FZ2F = X80 MOVE SPACE TO CA-FZ-2 END-IF IF M8FZ3L > ZERO MOVE M8FZ3I TO CA-FZ-3 END-IF IF M8FZ3F = X80 MOVE SPACE TO CA-FZ-3 END-IF IF M8XJUMPL > ZERO PERFORM XJUMP END-IF. CA-999. EXIT. EJECT ****************************************************************** * FEHLERMELDUNG HOLEN (XM181) ****************************************************************** FEHLMELD SECTION. FM-000. MOVE CA-SPR TO FEHL-SPR EXEC CICS LINK PROGRAM ( 'XM181' ) COMMAREA ( XM181-P ) LENGTH ( XM181L ) END-EXEC MOVE FEHL-MELD TO M8MSGO MOVE SPACE TO FEHL-VAR1 FEHL-VAR2 FEHL-VAR3 FEHL-VAR4 FEHL-VAR5 FEHL-VAR6. FM-999. EXIT. EJECT ****************************************************************** * MODULE-AUFRUF-INTERFACE (P008) ****************************************************************** MODULE SECTION. MO-000. EXEC CICS LINK PROGRAM ( 'P008' ) COMMAREA ( P-P008 ) LENGTH ( P-P008L ) END-EXEC. MO-999. EXIT. EJECT ****************************************************************** * LINK-PROGRAMME AUFRUFEN ****************************************************************** PRGLINK SECTION. PRG-000. EXEC CICS LINK PROGRAM ( 'DBRIP58' ) COMMAREA ( COMMAREA ) LENGTH ( CA-LENGTH ) END-EXEC. PRG-999. EXIT. EJECT ****************************************************************** * UEBERTRAGEN CA --> SCREEN ****************************************************************** **** (INDIVIDUELLE VERARBEITUNG) SCREENFILL SECTION. SC-000. MOVE CA-RKDN1X TO M8REF1O MOVE CA-RKDN2X TO M8REF2O MOVE CA-VNRX TO M8VNRO MOVE CA-PRINTER TO M8PRIDO MOVE CA-SCHACHT TO M8CANO MOVE CA-BRIEF TO M8BRIEFO MOVE CA-ABS1 TO M8ABS1O MOVE CA-ABS2 TO M8ABS2O MOVE CA-ABS3 TO M8ABS3O MOVE CA-ABS4 TO M8ABS4O MOVE CA-ADRZ1 TO M8ADRZ1O MOVE CA-ADRZ2 TO M8ADRZ2O MOVE CA-ADRZ3 TO M8ADRZ3O MOVE CA-ADRZ4 TO M8ADRZ4O MOVE CA-ADRZ5 TO M8ADRZ5O MOVE CA-ADRSW1 TO M8ADSW1O MOVE CA-ADRSW2 TO M8ADSW2O MOVE CA-ADRSW3 TO M8ADSW3O MOVE CA-ADRSW4 TO M8ADSW4O MOVE CA-SACHBT TO M8SACHTO MOVE CA-SACHB1 TO M8SACH1O MOVE CA-SACHB2 TO M8SACH2O MOVE CA-ANRED TO M8ANREDO MOVE CA-LB-ERDAT TO M8ERDATO MOVE CA-LB-MENDZ TO M8MENDZO MOVE CA-LB-MENDV TO M8MENDVO MOVE CA-LB-OBJ TO M8OBJO IF Z-UEBET = SPACE IF CA-LB-UEBET = ZERO MOVE SPACE TO M8UEBETO ELSE MOVE CA-LB-UEBET TO MO-BETRA MOVE MO-BETRAX TO M8UEBETO END-IF ELSE MOVE Z-UEBET TO M8UEBETO END-IF IF Z-KAUTI = SPACE IF CA-LB-KAUTI = ZERO MOVE SPACE TO M8KAUTIO ELSE MOVE CA-LB-KAUTI TO MO-BETRA MOVE MO-BETRAX TO M8KAUTIO END-IF ELSE MOVE Z-KAUTI TO M8KAUTIO END-IF IF Z-ZGUT = SPACE IF CA-LB-ZGUT = ZERO MOVE SPACE TO M8ZGUTO ELSE MOVE CA-LB-ZGUT TO MO-BETRA MOVE MO-BETRAX TO M8ZGUTO END-IF ELSE MOVE Z-ZGUT TO M8ZGUTO END-IF MOVE CA-LB-ANZRA TO M8ANZRAO IF Z-RATE = SPACE IF CA-LB-RATE = ZERO MOVE SPACE TO M8RATEO ELSE MOVE CA-LB-RATE TO MO-BETRA MOVE MO-BETRAX TO M8RATEO END-IF ELSE MOVE Z-RATE TO M8RATEO END-IF MOVE CA-FZ-1 TO M8FZ1O MOVE CA-FZ-2 TO M8FZ2O MOVE CA-FZ-3 TO M8FZ3O. SC-999. EXIT. EJECT ****************************************************************** * IDENT-FELDER IN SCREEN FUELLEN ****************************************************************** SCRIDENT SECTION. SI-000. MOVE EIBTRMID TO TID MOVE EIBTIME TO Z-TIME MOVE K-XM278 TO P200-1 CALL 'XM200' USING P-P008 P200-1 Z-DATE PERFORM MODULE MOVE TIMR1 TO HH MOVE TIMR2 TO MI MOVE TIMR3 TO SS MOVE DATR0 TO TT Z-DAT0 MOVE DATR1 TO MM Z-DAT1 MOVE DATR2 TO YY Z-DAT2 MOVE CA-KKZ TO OPID MOVE CA-BURO TO GS MOVE K-XM014A TO P200-1 CALL 'XM200' USING P-P008 P200-1 CA-FIRMA FA PERFORM MODULE MOVE CA-TRANS TO TRANS MOVE W-IDE TO M8IDEO MOVE W-IDA TO M8IDAO. SI-999. EXIT. EJECT ****************************************************************** * GEWUENSCHTE LEERZEILEN IN ADRESSE INSERTEN ****************************************************************** ADRINSERT SECTION. AI-000. IF CA-ADRSW4 NOT = SPACE MOVE CA-ADRZ4 TO CA-ADRZ5 MOVE SPACE TO CA-ADRZ4 MOVE SPACE TO CA-ADRSW4 MOVE -1 TO M8ADRZ4L END-IF IF CA-ADRSW3 NOT = SPACE MOVE CA-ADRZ4 TO CA-ADRZ5 MOVE CA-ADRZ3 TO CA-ADRZ4 MOVE SPACE TO CA-ADRZ3 MOVE SPACE TO CA-ADRSW3 MOVE -1 TO M8ADRZ3L END-IF IF CA-ADRSW2 NOT = SPACE MOVE CA-ADRZ4 TO CA-ADRZ5 MOVE CA-ADRZ3 TO CA-ADRZ4 MOVE CA-ADRZ2 TO CA-ADRZ3 MOVE SPACE TO CA-ADRZ2 MOVE SPACE TO CA-ADRSW2 MOVE -1 TO M8ADRZ2L END-IF IF CA-ADRSW1 NOT = SPACE MOVE CA-ADRZ4 TO CA-ADRZ5 MOVE CA-ADRZ3 TO CA-ADRZ4 MOVE CA-ADRZ2 TO CA-ADRZ3 MOVE CA-ADRZ1 TO CA-ADRZ2 MOVE SPACE TO CA-ADRZ1 MOVE SPACE TO CA-ADRSW1 MOVE -1 TO M8ADRZ1L END-IF. AI-999. EXIT. EJECT ****************************************************************** * LEERZEILEN AUS ADRESSE ELIMINIEREN UND SWITCHERS MITSCHIEBEN ****************************************************************** ADRKOMPR SECTION. AK-000. MOVE CA-ADRSW1 TO P1-XM314-ADRSW ( 1 ) MOVE CA-ADRZ1 TO P1-XM314-ADRZ ( 1 ) MOVE CA-ADRSW2 TO P1-XM314-ADRSW ( 2 ) MOVE CA-ADRZ2 TO P1-XM314-ADRZ ( 2 ) MOVE CA-ADRSW3 TO P1-XM314-ADRSW ( 3 ) MOVE CA-ADRZ3 TO P1-XM314-ADRZ ( 3 ) MOVE CA-ADRSW4 TO P1-XM314-ADRSW ( 4 ) MOVE CA-ADRZ4 TO P1-XM314-ADRZ ( 4 ) MOVE SPACE TO P1-XM314-ADRSW ( 5 ) MOVE CA-ADRZ5 TO P1-XM314-ADRZ ( 5 ) MOVE K-XM314 TO P200-1 CALL 'XM200' USING P-P008 P200-1 P1-XM314 P2-XM314 PERFORM MODULE MOVE P1-XM314-ADRSW ( 1 ) TO CA-ADRSW1 MOVE P1-XM314-ADRZ ( 1 ) TO CA-ADRZ1 MOVE P1-XM314-ADRSW ( 2 ) TO CA-ADRSW2 MOVE P1-XM314-ADRZ ( 2 ) TO CA-ADRZ2 MOVE P1-XM314-ADRSW ( 3 ) TO CA-ADRSW3 MOVE P1-XM314-ADRZ ( 3 ) TO CA-ADRZ3 MOVE P1-XM314-ADRSW ( 4 ) TO CA-ADRSW4 MOVE P1-XM314-ADRZ ( 4 ) TO CA-ADRZ4 MOVE P1-XM314-ADRZ ( 5 ) TO CA-ADRZ5. AK-999. EXIT. EJECT ****************************************************************** ****************************************************************** * C I C S - SUBROUTINEN ****************************************************************** ****************************************************************** ****************************************************************** * SENDEN SCREEN ****************************************************************** SENDEN SECTION. SE-000. PERFORM SCRIDENT PERFORM SCREENFILL MOVE -1 TO M8SACHTL IF CA-SPR = 2 CONTINUE PERFORM SE-100 ELSE MOVE 'SN' TO X-CICS-FUNCTION MOVE DBRIM8DO TO X-CICS-MAP EXEC CICS LINK PROGRAM ( 'XTPOUT' ) COMMAREA ( X-CICS-PARAM ) LENGTH ( X-CICS-PARAM-LNG ) END-EXEC MOVE X-CICS-RETCODE TO EIBRESP END-IF. SE-999. EXIT. EJECT ****************************************************************** * SENDEN SCREEN MIT FEHLERMELDUNG ****************************************************************** SENDFEHL SECTION. SF-000. PERFORM SCRIDENT PERFORM SCREENFILL IF M8MSGO = LOW-VALUE MOVE 'ABER...ABER...PROGRAMMIERFEHLER' TO M8MSGO END-IF IF CA-SPR = 2 CONTINUE PERFORM SF-100 ELSE MOVE 'SN' TO X-CICS-FUNCTION MOVE DBRIM8DO TO X-CICS-MAP EXEC CICS LINK PROGRAM ( 'XTPOUT' ) COMMAREA ( X-CICS-PARAM ) LENGTH ( X-CICS-PARAM-LNG ) END-EXEC MOVE X-CICS-RETCODE TO EIBRESP END-IF. SF-999. EXIT. EJECT ****************************************************************** * SCREEN EMPFANGEN ****************************************************************** RECEIVEN SECTION. RE-000. MOVE LOW-VALUE TO DBRIM8DI IF CA-SPR = 2 CONTINUE PERFORM RE-100 ELSE MOVE 'RC' TO X-CICS-FUNCTION MOVE DBRIM8DI TO X-CICS-MAP EXEC CICS LINK PROGRAM ( 'XTPINP' ) COMMAREA ( X-CICS-PARAM ) LENGTH ( X-CICS-PARAM-LNG ) END-EXEC MOVE X-CICS-RETCODE TO EIBRESP EVALUATE TRUE WHEN X-MAPFAIL * GO TO VV-860 PERFORM VV-860 WHEN X-PF1 * GO TO VV-710 PERFORM VV-710 WHEN X-PF2 * GO TO VV-720 PERFORM VV-720 WHEN X-PF3 * GO TO VV-730 PERFORM VV-730 WHEN X-PF10 * GO TO VV-800 PERFORM VV-800 WHEN X-PF11 * GO TO VV-810 PERFORM VV-810 WHEN X-PF12 * GO TO VV-820 PERFORM VV-820 WHEN X-CLEAR * GO TO VV-840 PERFORM VV-840 WHEN X-ANYKEY * GO TO VV-850 PERFORM VV-850 END-EVALUATE END-IF. RE-999. EXIT. EJECT ****************************************************************** * PROGRAMM MIT RETURN TRANSID VERLASSEN ****************************************************************** TRANSID SECTION. TR-000. EXEC CICS RETURN TRANSID ( CA-TRANS ) COMMAREA ( COMMAREA ) LENGTH ( CA-LENGTH ) END-EXEC. TR-999. EXIT. EJECT ****************************************************************** * PROGRAMM VERLASSEN ****************************************************************** XCTL SECTION. XC-000. MOVE 5 TO FEHL-NR CA-FEHLNR MOVE CA-TRANS TO FEHL-VAR1 PERFORM FEHLMELD MOVE 'SN' TO X-CICS-FUNCTION MOVE M8MSGO TO X-CICS-MAP EXEC CICS LINK PROGRAM ( 'XTPOUT' ) COMMAREA ( X-CICS-PARAM ) LENGTH ( X-CICS-PARAM-LNG ) END-EXEC MOVE X-CICS-RETCODE TO EIBRESP EXEC CICS RETURN END-EXEC. * EXEC CICS SEND * FROM (M8MSGO) * LENGTH (77) * WAIT * ERASE * END-EXEC. XC-999. EXIT. EJECT ****************************************************************** * CROSS-JUMPER AUFRUFEN ****************************************************************** XJUMP SECTION. XJ-000. MOVE M8XJUMPI TO P1-XM229 MOVE K-XM229 TO P200-1 CALL 'XM200' USING P-P008 P200-1 P1-XM229 P2-XM229 P3-XM229 PERFORM MODULE MOVE P1-XM229 TO CA-CIXJUMP MOVE CA-SPR TO XM179-SPRCD MOVE CA-CIXACT TO XM179-TRANS EXEC CICS LINK PROGRAM ( 'XM179' ) COMMAREA ( XM179-P ) LENGTH ( XM179L ) END-EXEC IF XM179-TEXT = SPACE MOVE 25 TO FEHL-NR CA-FEHLNR MOVE CA-CIXACT TO FEHL-VAR1 MOVE DFHBMBRY TO M8XJUMPA MOVE -1 TO M8XJUMPL MOVE 1 TO SWFEHL CA-SWFEHL ELSE MOVE ZERO TO CA-SCHRITT MOVE 'G' TO P1-XM269 MOVE K-XM269 TO P200-1 CALL 'XM200' USING P-P008 P200-1 P1-XM269 PERFORM MODULE IF CA-SWAC = 'C' EXEC CICS XCTL PROGRAM ( 'D007' ) COMMAREA ( COMMAREA ) LENGTH ( 1650 ) END-EXEC **** *** XXXXXX, XXXXXXX *** ELSE EXEC CICS XCTL PROGRAM ( 'P007' ) COMMAREA ( COMMAREA ) LENGTH ( 1650 ) END-EXEC END-IF END-IF. **** *** CONTISSIIMO *** XJ-999. EXIT. ****************************************************************** **** ENDE SOURCE DBRIP08 ****************************************************************** BAR SECTION. BAR-PARAGRAPH. STOP RUN. STEUER-SUBROUTINES SECTION. ST-100. PERFORM HAUPTVERARB. ST-990. IF SWPF = 99 PERFORM XCTL ELSE MOVE +6000 TO CA-LENGTH PERFORM TRANSID END-IF. VORVERARB-SUBROUTINES SECTION. VV-860. **** M A P F A I L MOVE 16 TO SWPF. VV-850. **** ANYKEY-TASTE MOVE 15 TO SWPF. VV-840. **** CLEAR-TASTE MOVE 14 TO SWPF. VV-820. **** PF12-TASTE MOVE 12 TO SWPF. VV-810. **** PF11-TASTE MOVE 11 TO SWPF. VV-800. **** PF10-TASTE MOVE 10 TO SWPF. VV-730. **** PF3-TASTE MOVE 3 TO SWPF. VV-720. **** PF2-TASTE MOVE 2 TO SWPF. VV-710. **** PF1-TASTE MOVE 1 TO SWPF. VV-700. **** HANDLE AID UND CONDITION * EXEC CICS HANDLE CONDITION MAPFAIL (VV-860) * END-EXEC. **** HANDLE AID 1. TEIL * EXEC CICS HANDLE AID PF1 (VV-710) * PF2 (VV-720) * PF3 (VV-730) * PF10 (VV-800) * PF11 (VV-810) * PF12 (VV-820) * CLEAR (VV-840) * ANYKEY (VV-850) * END-EXEC. **** R E C E I V E PERFORM RECEIVEN MOVE 13 TO SWPF. VV-100. IF CA-SCHRITT = ZERO CONTINUE ELSE PERFORM VV-700 END-IF. HAUPTVERARB-SUBROUTINES SECTION. HV-83. **** PF3-TASTE MOVE 3 TO CA-SWPF MOVE 0 TO CA-SCHRITT EXEC CICS XCTL PROGRAM ( 'DBRIT' ) COMMAREA ( COMMAREA ) LENGTH ( CA-LENGTH ) END-EXEC. HV-90. **** PF10-TASTE **** BILDSCHIRM AUF GROSS UMSCHALTEN MOVE 'G' TO P1-XM269 MOVE K-XM269 TO P200-1 CALL 'XM200' USING P-P008 P200-1 P1-XM269 PERFORM MODULE MOVE ZERO TO CA-LENGTH EXEC CICS XCTL PROGRAM ( 'PF10T' ) COMMAREA ( COMMAREA ) LENGTH ( CA-LENGTH ) END-EXEC. HV-900. **** FEHLER PERFORM FEHLMELD PERFORM SENDFEHL MOVE 90 TO SWPF. HV-800. **** SENDEN SCREEN PERFORM SENDEN IF CA-SCHRITT = 0 MOVE 1 TO CA-SCHRITT END-IF MOVE 80 TO SWPF. HV-500. **** AUFRUF DER VERARBEITUNG * NACH ERFOLGREICHEN PLAUS-TESTS PERFORM VERARB IF SWFEHL > ZERO PERFORM HV-900 ELSE PERFORM HV-800 END-IF. HV-300. **** INPUT PRUEFEN PERFORM PLAUSI IF SWFEHL = ZERO CONTINUE PERFORM HV-500 ELSE IF FEHL-NR = 0 MOVE 3 TO FEHL-NR CA-FEHLNR END-IF PERFORM HV-900 END-IF. HV-200. **** COMMONAREA MIT SCREENDATEN LADEN PERFORM CAFILL IF SWFEHL > ZERO PERFORM HV-900 ELSE PERFORM HV-300 END-IF. HV-100. **** INITIALISIEREN SCREEN MOVE LOW-VALUE TO DBRIM8DO PERFORM HV-800. HV-97. **** AUFRUF AUS CROSS-JUMPER PERFORM HV-200. HV-96. **** MAPFAIL (KEINE EINGABE) PERFORM HV-200. HV-95. **** ANYKEY (FALSCHE FUNKTIONS-TASTE) PERFORM CAFILL IF SWFEHL > ZERO CONTINUE ELSE MOVE LOW-VALUE TO DBRIM8DI MOVE 1 TO FEHL-NR CA-FEHLNR MOVE -1 TO M8SACHTL END-IF PERFORM HV-900. PLAUSI-SUBROUTINES SECTION. PL-500. ******** PRINTER PRUEFEN ******** *************** IF CA-PRINTER = SPACE MOVE DFHBMBRY TO M8PRIDA MOVE -1 TO M8PRIDL MOVE 3 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL ELSE MOVE CA-PRINTER TO P1-XM229 MOVE K-XM229 TO P200-1 CALL 'XM200' USING P-P008 P200-1 P1-XM229 P2-XM229 P3-XM229 PERFORM MODULE MOVE P1-XM229 TO CA-PRINTER MOVE 'G' TO BER-FUNC MOVE CA-PRINTER TO BER-PRTID EXEC CICS LINK PROGRAM ( 'XM177' ) COMMAREA ( P-XM177 ) LENGTH ( P-XM177L ) END-EXEC IF BER-RET1 = '1' MOVE DFHBMBRY TO M8PRIDA IF SWFEHL = ZERO MOVE -1 TO M8PRIDL MOVE 1 TO SWFEHL MOVE 96 TO FEHL-NR CA-FEHLNR END-IF END-IF END-IF. PL-510. ******** SCHACHT PRUEFEN ******** *************** IF CA-SCHACHTX NOT NUMERIC MOVE 'Q' TO M8CANA IF SWFEHL = ZERO MOVE -1 TO M8CANL MOVE 1 TO SWFEHL MOVE 52 TO FEHL-NR CA-FEHLNR END-IF END-IF IF CA-SCHACHTX > '0' AND CA-SCHACHTX < '4' CONTINUE ELSE IF CA-SCHACHTX = '9' CONTINUE ELSE MOVE 'Q' TO M8CANA IF SWFEHL = ZERO MOVE -1 TO M8CANL MOVE 1 TO SWFEHL MOVE 3 TO FEHL-NR CA-FEHLNR END-IF END-IF END-IF. PL-520. ******** MIND. 1 ABSENDERZEILE ******** ********************* IF CA-ABS1 = SPACE AND CA-ABS2 = SPACE AND CA-ABS3 = SPACE AND CA-ABS4 = SPACE MOVE DFHBMBRY TO M8ABS1A M8ABS2A M8ABS3A M8ABS4A IF SWFEHL = ZERO MOVE -1 TO M8ABS1L MOVE 74 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF IF CA-ADRESSE = SPACE MOVE DFHBMBRY TO M8ADRZ1A M8ADRZ2A M8ADRZ3A MOVE DFHBMBRY TO M8ADRZ4A M8ADRZ5A IF SWFEHL = ZERO MOVE -1 TO M8ADRZ1L MOVE 74 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF MOVE ZERO TO R-ADRSW R-LEERZ IF CA-ADRESS-SWITCHES = SPACE CONTINUE ELSE IF CA-ADRSW1 NOT = SPACE ADD 1 TO R-ADRSW END-IF IF CA-ADRSW2 NOT = SPACE ADD 1 TO R-ADRSW END-IF IF CA-ADRSW3 NOT = SPACE ADD 1 TO R-ADRSW END-IF IF CA-ADRSW4 NOT = SPACE ADD 1 TO R-ADRSW END-IF IF CA-ADRZ1 = SPACE ADD 1 TO R-LEERZ END-IF IF CA-ADRZ2 = SPACE ADD 1 TO R-LEERZ END-IF IF CA-ADRZ3 = SPACE ADD 1 TO R-LEERZ END-IF IF CA-ADRZ4 = SPACE ADD 1 TO R-LEERZ END-IF IF CA-ADRZ5 = SPACE ADD 1 TO R-LEERZ END-IF IF R-ADRSW > R-LEERZ MOVE DFHBMBRY TO M8ADSW1A M8ADSW2A M8ADSW3A M8ADSW4A IF SWFEHL = ZERO MOVE -1 TO M8ADSW1L MOVE 03 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF IF (CA-ADRSW1 NOT = SPACE) AND (CA-ADRZ1 = SPACE) MOVE DFHBMBRY TO M8ADSW1A M8ADRZ1A IF SWFEHL = ZERO MOVE -1 TO M8ADSW1L MOVE 03 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF IF (CA-ADRSW2 NOT = SPACE) AND (CA-ADRZ2 = SPACE) MOVE DFHBMBRY TO M8ADSW2A M8ADRZ2A IF SWFEHL = ZERO MOVE -1 TO M8ADSW2L MOVE 03 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF IF (CA-ADRSW3 NOT = SPACE) AND (CA-ADRZ3 = SPACE) MOVE DFHBMBRY TO M8ADSW3A M8ADRZ3A IF SWFEHL = ZERO MOVE -1 TO M8ADSW3L MOVE 03 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF IF (CA-ADRSW4 NOT = SPACE) AND (CA-ADRZ4 = SPACE) MOVE DFHBMBRY TO M8ADSW4A M8ADRZ4A IF SWFEHL = ZERO MOVE -1 TO M8ADSW4L MOVE 03 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF END-IF. PL-530. ******** UNTERSTE ADR-ZEILE MUSS PLZ HABEN ******** ********************************* MOVE CA-ADRESSE TO T-ADRESSE MOVE 5 TO I-1. PL-550. MOVE DFHBMBRY TO M8ADRZ1A M8ADRZ2A M8ADRZ3A M8ADRZ4A M8ADRZ5A IF SWFEHL = ZERO MOVE -1 TO M8ADRZ1L MOVE 1 TO SWFEHL MOVE 319 TO FEHL-NR CA-FEHLNR END-IF. PL-580. MOVE '.' TO Z-P110 Z-P210 MOVE Z-DATE10 TO CA-LB-ERDAT. PL-610. MOVE '.' TO Z-P110 Z-P210 MOVE Z-DATE10 TO CA-LB-MENDZ. PL-640. MOVE '.' TO Z-P110 Z-P210 MOVE Z-DATE10 TO CA-LB-MENDV. PL-650. ******** OBJEKT-TEXT ******** *********** IF CA-LB-OBJ = SPACE MOVE DFHBMBRY TO M8OBJA IF SWFEHL = ZERO MOVE -1 TO M8OBJL MOVE 74 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF IF Z-UEBET = SPACE CONTINUE ELSE MOVE DFHBMBRY TO M8UEBETA IF SWFEHL = ZERO MOVE -1 TO M8UEBETL MOVE 52 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF. PL-660. * ... IST OBLIGATORISCH ******** ********************* IF CA-LB-UEBET = ZERO MOVE DFHBMBRY TO M8UEBETA IF SWFEHL = ZERO MOVE -1 TO M8UEBETL MOVE 74 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF IF Z-KAUTI = SPACE CONTINUE ELSE MOVE DFHBMBRY TO M8KAUTIA IF SWFEHL = ZERO MOVE -1 TO M8KAUTIL MOVE 52 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF. PL-670. ******** ZINSGUTSCHRIFT ******** ************** IF Z-ZGUT = SPACE CONTINUE ELSE MOVE DFHBMBRY TO M8ZGUTA IF SWFEHL = ZERO MOVE -1 TO M8ZGUTL MOVE 52 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF. PL-680. ******** ANZAHL RATEN ******** ************ IF CA-LB-ANZRAX NOT NUMERIC MOVE DFHBMBRY TO M8ANZRAA IF SWFEHL = ZERO MOVE -1 TO M8ANZRAL MOVE 52 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF IF Z-RATE = SPACE CONTINUE ELSE MOVE DFHBMBRY TO M8RATEA IF SWFEHL = ZERO MOVE -1 TO M8RATEL MOVE 52 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF. PL-810. ******** ZUKUNFT: > CURRENT-DATE ******** *********************** IF CA-LB-MENDZ = SPACE CONTINUE ELSE MOVE K-XM005 TO P200-1 CALL 'XM200' USING P-P008 P200-1 Z-DUMMY6 Z-MENDZ-BIN CA-LB-MENDZ PERFORM MODULE IF Z-MENDZ-BIN NOT > Z-CURR-BIN MOVE DFHBMBRY TO M8MENDZA IF SWFEHL = ZERO MOVE -1 TO M8MENDZL MOVE 03 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF END-IF. PL-830. ******** ZINSGUTSCHRIFT UND RATEN ******** SCHLIESSEN SICH AUS ******** ************************ IF (CA-LB-ZGUT NOT = ZERO) AND (CA-LB-RATE NOT = ZERO) MOVE 'Q' TO M8ANZRAA MOVE DFHBMBRY TO M8RATEA M8ZGUTA MOVE -1 TO M8ZGUTL MOVE 30 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL ELSE IF (SWPF = 11) AND (CA-ADRESS-SWITCHES NOT = SPACE) MOVE DFHBMBRY TO M8ADSW1A M8ADSW2A M8ADSW3A M8ADSW4A IF SWFEHL = ZERO MOVE -1 TO M8ADSW1L MOVE 1 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF END-IF. PL-540. PERFORM TEST BEFORE UNTIL (I-1 < 2) OR NOT (T-ADRZ-EL ( I-1 ) = SPACE) SUBTRACT 1 FROM I-1 END-PERFORM IF I-1 < 2 CONTINUE PERFORM PL-550 ELSE IF T-ADRZ-PLZ ( I-1 ) NUMERIC CONTINUE ELSE PERFORM PL-550 END-IF END-IF. PL-560. ******** IHRE SACHBEARBEITER-TEXT ******** ************************ IF CA-SACHBT = SPACE MOVE DFHBMBRY TO M8SACHTA IF SWFEHL = ZERO MOVE -1 TO M8SACHTL MOVE 74 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF IF CA-SACHB1 = SPACE AND CA-SACHB2 = SPACE MOVE DFHBMBRY TO M8SACH1A M8SACH2A IF SWFEHL = ZERO MOVE -1 TO M8SACH1L MOVE 74 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF IF CA-ANRED = SPACE MOVE DFHBMBRY TO M8ANREDA IF SWFEHL = ZERO MOVE -1 TO M8ANREDL MOVE 74 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL END-IF END-IF MOVE ZERO TO XM016-P1 MOVE ZERO TO XM016-P2 MOVE CA-LB-ERDAT TO XM016-P3 MOVE K-XM016 TO P200-1 CALL 'XM200' USING P-P008 P200-1 XM016-P1 XM016-P2 XM016-P3 PERFORM MODULE IF XM016-P2 NOT = ZERO MOVE DFHBMBRY TO M8ERDATA IF SWFEHL = ZERO MOVE 73 TO FEHL-NR CA-FEHLNR MOVE -1 TO M8ERDATL MOVE 1 TO SWFEHL CA-SWFEHL ELSE CONTINUE END-IF ELSE MOVE SPACE TO Z-TESTDATUM Z-DATE10 MOVE CA-LB-ERDAT TO Z-TESTDATUM IF Z-TD-6OPF = SPACE MOVE Z-TD-6OPT TO Z-TT10 MOVE Z-TD-6OPM TO Z-MM10 MOVE Z-TD-6OPJ TO Z-JZ10 IF Z-TD-6OPJ > 80 MOVE 19 TO Z-JH10 ELSE MOVE 20 TO Z-JH10 END-IF ELSE IF Z-TD-8MPJ NUMERIC MOVE Z-TD-8MPX TO Z-DATE10 ELSE IF Z-TD-6MP1 = '.' AND Z-TD-6MP2 = '.' MOVE Z-TD-6MPT TO Z-TT10 MOVE Z-TD-6MPM TO Z-MM10 MOVE Z-TD-6MPJ TO Z-JZ10 IF Z-TD-6MPJ > 80 MOVE 19 TO Z-JH10 ELSE MOVE 20 TO Z-JH10 END-IF ELSE MOVE Z-TD-8OPT TO Z-TT10 MOVE Z-TD-8OPM TO Z-MM10 MOVE Z-TD-8OPJ TO Z-JJ10 END-IF END-IF END-IF PERFORM PL-580 END-IF. PL-590. ******** DATUM LAEUFT AM .... AB ******** *********************** IF CA-LB-MENDZ = SPACE CONTINUE ELSE MOVE ZERO TO XM016-P1 MOVE ZERO TO XM016-P2 MOVE CA-LB-MENDZ TO XM016-P3 MOVE K-XM016 TO P200-1 CALL 'XM200' USING P-P008 P200-1 XM016-P1 XM016-P2 XM016-P3 PERFORM MODULE IF XM016-P2 NOT = ZERO MOVE 73 TO FEHL-NR CA-FEHLNR MOVE -1 TO M8MENDZL MOVE DFHBMBRY TO M8MENDZA MOVE 1 TO SWFEHL CA-SWFEHL ELSE MOVE SPACE TO Z-TESTDATUM Z-DATE10 MOVE CA-LB-MENDZ TO Z-TESTDATUM IF Z-TD-6OPF = SPACE MOVE Z-TD-6OPT TO Z-TT10 MOVE Z-TD-6OPM TO Z-MM10 MOVE Z-TD-6OPJ TO Z-JZ10 IF Z-TD-6OPJ > 80 MOVE 19 TO Z-JH10 ELSE MOVE 20 TO Z-JH10 END-IF ELSE IF Z-TD-8MPJ NUMERIC MOVE Z-TD-8MPX TO Z-DATE10 ELSE IF Z-TD-6MP1 = '.' AND Z-TD-6MP2 = '.' MOVE Z-TD-6MPT TO Z-TT10 MOVE Z-TD-6MPM TO Z-MM10 MOVE Z-TD-6MPJ TO Z-JZ10 IF Z-TD-6MPJ > 80 MOVE 19 TO Z-JH10 ELSE MOVE 20 TO Z-JH10 END-IF ELSE MOVE Z-TD-8OPT TO Z-TT10 MOVE Z-TD-8OPM TO Z-MM10 MOVE Z-TD-8OPJ TO Z-JJ10 END-IF END-IF END-IF PERFORM PL-610 END-IF END-IF. PL-620. ******** DATUM IST AM .... ABGELAUFEN ******** **************************** IF CA-LB-MENDV = SPACE PERFORM PL-650 PERFORM PL-660 PERFORM PL-670 PERFORM PL-680 ELSE MOVE ZERO TO XM016-P1 MOVE ZERO TO XM016-P2 MOVE CA-LB-MENDV TO XM016-P3 MOVE K-XM016 TO P200-1 CALL 'XM200' USING P-P008 P200-1 XM016-P1 XM016-P2 XM016-P3 PERFORM MODULE IF XM016-P2 NOT = ZERO MOVE 73 TO FEHL-NR CA-FEHLNR MOVE -1 TO M8MENDVL MOVE DFHBMBRY TO M8MENDVA MOVE 1 TO SWFEHL CA-SWFEHL PERFORM PL-650 PERFORM PL-660 PERFORM PL-670 PERFORM PL-680 ELSE MOVE SPACE TO Z-TESTDATUM Z-DATE10 MOVE CA-LB-MENDV TO Z-TESTDATUM IF Z-TD-6OPF = SPACE MOVE Z-TD-6OPT TO Z-TT10 MOVE Z-TD-6OPM TO Z-MM10 MOVE Z-TD-6OPJ TO Z-JZ10 IF Z-TD-6OPJ > 80 MOVE 19 TO Z-JH10 ELSE MOVE 20 TO Z-JH10 END-IF ELSE IF Z-TD-8MPJ NUMERIC MOVE Z-TD-8MPX TO Z-DATE10 ELSE IF Z-TD-6MP1 = '.' AND Z-TD-6MP2 = '.' MOVE Z-TD-6MPT TO Z-TT10 MOVE Z-TD-6MPM TO Z-MM10 MOVE Z-TD-6MPJ TO Z-JZ10 IF Z-TD-6MPJ > 80 MOVE 19 TO Z-JH10 ELSE MOVE 20 TO Z-JH10 END-IF ELSE MOVE Z-TD-8OPT TO Z-TT10 MOVE Z-TD-8OPM TO Z-MM10 MOVE Z-TD-8OPJ TO Z-JJ10 END-IF END-IF END-IF PERFORM PL-640 PERFORM PL-650 PERFORM PL-660 PERFORM PL-670 PERFORM PL-680 END-IF END-IF. PL-820. ******** ANZRA UND RATE BEIDE NULL ODER ******** BEIDE NICHT NULL ******** ****************************** IF (CA-LB-ANZRA = ZERO) AND (CA-LB-RATE = ZERO) CONTINUE PERFORM PL-830 ELSE IF (CA-LB-ANZRA NOT = ZERO) AND (CA-LB-RATE NOT = ZERO) CONTINUE PERFORM PL-830 ELSE MOVE 'Q' TO M8ANZRAA MOVE DFHBMBRY TO M8RATEA MOVE -1 TO M8ANZRAL MOVE 30 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF. PL-800. ******** EIN ABLAUFDATUM OBLIGATORISCH ******** ***************************** IF (CA-LB-MENDV = SPACE) AND (CA-LB-MENDZ = SPACE) MOVE DFHBMBRY TO M8MENDZA M8MENDVA MOVE -1 TO M8MENDZL MOVE 74 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL ELSE IF (CA-LB-MENDV NOT = SPACE) AND (CA-LB-MENDZ NOT = SPACE) MOVE DFHBMBRY TO M8MENDZA M8MENDVA MOVE -1 TO M8MENDZL MOVE 30 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL ELSE MOVE K-XM278 TO P200-1 CALL 'XM200' USING P-P008 P200-1 Z-DATE Z-CURRDATE PERFORM MODULE MOVE K-XM005 TO P200-1 CALL 'XM200' USING P-P008 P200-1 Z-DUMMY6 Z-CURR-BIN Z-CURRDATE PERFORM MODULE IF CA-LB-MENDV = SPACE CONTINUE ELSE MOVE K-XM005 TO P200-1 CALL 'XM200' USING P-P008 P200-1 Z-DUMMY6 Z-MENDV-BIN CA-LB-MENDV PERFORM MODULE IF Z-MENDV-BIN > Z-CURR-BIN MOVE DFHBMBRY TO M8MENDVA IF SWFEHL = ZERO MOVE -1 TO M8MENDVL MOVE 03 TO FEHL-NR CA-FEHLNR MOVE 1 TO SWFEHL CA-SWFEHL END-IF END-IF END-IF PERFORM PL-810 PERFORM PL-820 END-IF END-IF. PL-690. IF SWFEHL NOT = ZERO CONTINUE ELSE PERFORM PL-800 END-IF. PL-100. MOVE 1 TO CA-SCHRITT. VERARB-SUBROUTINES SECTION. VA-500. **** PERFORM DRUCKPROGRAMM, RETURN-CODE MIT QUITTUNG **** AN BENUETZER ZURUECKGEBEN (NUR BEI PF11) MOVE ZERO TO CA-FEHLNR IF CA-SACHB1 = SPACE MOVE CA-SACHB2 TO CA-SACHB1 MOVE SPACE TO CA-SACHB2 END-IF MOVE SPACE TO P1-XM314 MOVE CA-ABS1 TO P1-XM314-EL ( 1 ) MOVE CA-ABS2 TO P1-XM314-EL ( 2 ) MOVE CA-ABS3 TO P1-XM314-EL ( 3 ) MOVE CA-ABS4 TO P1-XM314-EL ( 4 ) MOVE K-XM314 TO P200-1 CALL 'XM200' USING P-P008 P200-1 P1-XM314 P2-XM314 PERFORM MODULE MOVE P1-XM314-EL ( 1 ) TO CA-ABS1 MOVE P1-XM314-EL ( 2 ) TO CA-ABS2 MOVE P1-XM314-EL ( 3 ) TO CA-ABS3 MOVE P1-XM314-EL ( 4 ) TO CA-ABS4 PERFORM ADRKOMPR IF CA-ADRESS-SWITCHES NOT = SPACE PERFORM ADRINSERT END-IF IF SWPF NOT = 11 MOVE -1 TO M8SACHTL ELSE PERFORM PRGLINK IF CA-FEHLNR = ZERO MOVE 253 TO CA-FEHLNR END-IF MOVE -1 TO M8SACHTL MOVE 1 TO SWFEHL MOVE CA-FEHLNR TO FEHL-NR END-IF. * ADRESS-LEERZEILEN ELIMINIEREN * ***************************** * GEWUENSCHTE LEERZEILEN INSERTEN * ******************************* **** ENDE VERARBEITUNG DER DATEN CAFILL-SUBROUTINES SECTION. FEHLMELD-SUBROUTINES SECTION. MODULE-SUBROUTINES SECTION. PRGLINK-SUBROUTINES SECTION. SCREENFILL-SUBROUTINES SECTION. SCRIDENT-SUBROUTINES SECTION. ADRINSERT-SUBROUTINES SECTION. ADRKOMPR-SUBROUTINES SECTION. SENDEN-SUBROUTINES SECTION. SE-100. * EXEC CICS SEND MAP ('DBRIM8F') * MAPSET ('DBRIS8') * FROM (DBRIM8DO) * FREEKB * CURSOR * WAIT ERASE * END-EXEC. MOVE 'SN' TO X-CICS-FUNCTION MOVE DBRIM8DO TO X-CICS-MAP EXEC CICS LINK PROGRAM ( 'XTPOUT' ) COMMAREA ( X-CICS-PARAM ) LENGTH ( X-CICS-PARAM-LNG ) END-EXEC MOVE X-CICS-RETCODE TO EIBRESP. SENDFEHL-SUBROUTINES SECTION. SF-100. * EXEC CICS SEND MAP ('DBRIM8F') * MAPSET ('DBRIS8') * FROM (DBRIM8DO) * CURSOR * FREEKB * WAIT ERASE * END-EXEC. MOVE 'SN' TO X-CICS-FUNCTION MOVE DBRIM8DO TO X-CICS-MAP EXEC CICS LINK PROGRAM ( 'XTPOUT' ) COMMAREA ( X-CICS-PARAM ) LENGTH ( X-CICS-PARAM-LNG ) END-EXEC MOVE X-CICS-RETCODE TO EIBRESP. RECEIVEN-SUBROUTINES SECTION. RE-100. * EXEC CICS RECEIVE MAP ('DBRIM8F') * MAPSET ('DBRIS8') * INTO (DBRIM8DI) * END-EXEC. MOVE 'RC' TO X-CICS-FUNCTION MOVE DBRIM8DI TO X-CICS-MAP EXEC CICS LINK PROGRAM ( 'XTPINP' ) COMMAREA ( X-CICS-PARAM ) LENGTH ( X-CICS-PARAM-LNG ) END-EXEC MOVE X-CICS-RETCODE TO EIBRESP EVALUATE TRUE WHEN X-MAPFAIL * GO TO VV-860 PERFORM VV-860 WHEN X-PF1 * GO TO VV-710 PERFORM VV-710 WHEN X-PF2 * GO TO VV-720 PERFORM VV-720 WHEN X-PF3 * GO TO VV-730 PERFORM VV-730 WHEN X-PF10 * GO TO VV-800 PERFORM VV-800 WHEN X-PF11 * GO TO VV-810 PERFORM VV-810 WHEN X-PF12 * GO TO VV-820 PERFORM VV-820 WHEN X-CLEAR * GO TO VV-840 PERFORM VV-840 WHEN X-ANYKEY * GO TO VV-850 PERFORM VV-850 END-EVALUATE. TRANSID-SUBROUTINES SECTION. XCTL-SUBROUTINES SECTION. XJUMP-SUBROUTINES SECTION.