Programmare in COBOL: Che avventura!

Negli anni '80, la programmazione era una attività di nicchia, adatta a persone dal carattere flemmatico e meticoloso. 

I caratteri perspicaci difficilmente restavano inchiodati sulle proprie sedie per mettere a punto codici molto meno “intelligenti” di quelli che girano oggi nelle macchine super-veloci e dotati di risorse hardware allora inimmaginabili.

Ecco il mio primo programma sviluppato nel linguaggio COBOL, ormai estinto: 

       IDENTIFICATION DIVISION.

       PROGRAM-ID. LBMENU.

       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.

       SPECIAL-NAMES.

           CRT STATUS IS KEY-STATUS.

       INPUT-OUTPUT SECTION.

       FILE-CONTROL.

            SELECT DITTA ASSIGN TO DISK

            ORGANIZATION IS LINE SEQUENTIAL.

       COPY LBTABPSW.SEL.

       DATA DIVISION.

       FILE SECTION.

       COPY LBDITTA.FD.

       COPY LBTABPSW.FD.

       WORKING-STORAGE SECTION.

       77 RIGA                 PIC 9(2).

       77 COLONNA        PIC 9(2).

       77 CHIAVE             PIC X(10)  VALUE SPACES.

       77 I                         PIC 9(3)   VALUE 0.

       77 Q                       PIC 9(2)   VALUE 2.

       77 MAX                  PIC 99     OCCURS 8 VALUE ZEROES.

       77 TIPO-RIS           PIC X      VALUE "T".

       01 K                        PIC 9(2)  VALUE 7.

       01 W-STATUS       PIC XX.

       01 W-DATA.

          02 W-AA           PIC 99.

          02 W-MM           PIC 99.

          02 W-GG           PIC 99.

       01 W-PSWFILE.

          02 W-DRV-PSW    PIC X(8).

          02 W-NOME-PSW   PIC X(12)  VALUE "LBTABPSW.DAT".

       01 KEY-STATUS.

          03 KEY-TYPE PIC X.

          03 KEY-CODE-1 PIC 99 COMP-X.

          03 KEY-CODE-2 PIC 99 COMP-X.

       01 W-DITTA         PIC X(9)  VALUE "DITTA.TXT".

       01 W-REC-DITTA.

          02 W-INTESTA-DITTA  PIC X(80).

        01 USER-KEY-CONTROL.

           03 USER-KEY-SETTING PIC 99 COMP-X.

           03 FILLER PIC X VALUE "1".

           03 FIRST-USER-KEY PIC 99 COMP-X.

           03 NUMBER-OF-KEYS PIC 99 COMP-X.

         01  ADIS-KEY-CONTROL.

           03 ADIS-KEY-SETTING  PIC 99 COMP-X.

           03 FILLER PIC X VALUE "2".

           03 FIRST-ADIS-KEY PIC 99 COMP-X.

           03 NUMBER-OF-ADIS-KEYS PIC 99 COMP-X.

       01 GET-MOUSE-DETAILS    PIC 9(2) COMP-X value 67.

       01 MOUSE-DETAILS.

          03 MOUSE-X-POSITION  PIC 9(4) COMP-X.

          03 MOUSE-Y-POSITION  PIC 9(4) COMP-X.

          03 MOUSE-STATUS      PIC 9(4) COMP-X.

       01 BACK.

          02 BK    PIC 9(2) OCCURS 40.

       LINKAGE SECTION.

       01 LK-FLAG-ERR PIC 9.

       SCREEN SECTION.

       01  PULVIDEOF BACKGROUND-COLOR 0 FOREGROUND-COLOR 7 BLANK SCREEN.

       01 RIGO-PASS.

          02 LINE 10 COLUMN 30 VALUE "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"

                     BACKGROUND-COLOR 6 FOREGROUND-COLOR  14.

          02 LINE 11 COLUMN 30 VALUE "º    PASSWORD    º"

                     BACKGROUND-COLOR 6 FOREGROUND-COLOR  14.

          02 LINE 12 COLUMN 30 VALUE "º                º"

                     BACKGROUND-COLOR 6 FOREGROUND-COLOR  14.

          02 LINE 13 COLUMN 30 VALUE "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"

                     BACKGROUND-COLOR 6 FOREGROUND-COLOR  14.

             01 OPZ.

          02 LINE 23 COLUMN 69 PIC ZZ USING K AUTO

                    BACKGROUND-COLOR 1 FOREGROUND-COLOR 1.

       01 Q-TIPO.

         02 LINE 19 COLUMN 24 VALUE " T"

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  15.

         02 VALUE "utte le richieste           "

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  11.

         02 LINE 20 COLUMN 24 VALUE " SOLO le richieste da "

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  11.

         02 VALUE "V" BACKGROUND-COLOR 5 FOREGROUND-COLOR  15.

         02 VALUE "alidare"

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  11.

         02 LINE 21 COLUMN 24 VALUE " A"

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  15.

         02 VALUE "CCET. con esiti Fuori Range "

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  11.

         02 LINE 22 COLUMN 24 VALUE " E"

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  15.

         02 VALUE "SAMI  con esiti Fuori Range "

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  11.

         02 LINE 23 COLUMN 24 VALUE     "           Scelta :           "

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  14.

         02 COLUMN 44 AUTO PIC X USING TIPO-RIS

                   BACKGROUND-COLOR 5 FOREGROUND-COLOR  15.

       01 INTESTAZIONE.

          02 BACKGROUND-COLOR 1 FOREGROUND-COLOR 7 BLANK SCREEN.

          02 LINE 1 COLUMN 1 BACKGROUND-COLOR 3 FOREGROUND-COLOR 1

             PIC X(80) USING INT-VIDEO.

          02 LINE 25 COLUMN 1 BACKGROUND-COLOR 3 FOREGROUND-COLOR 1

             PIC X(64) USING INTESTA-DITTA.

          02 PIC 9(2) USING GG-OD-LAB

                   BACKGROUND-COLOR 7 FOREGROUND-COLOR 4.

          02 PIC 9(2) USING MM-OD-LAB

                   BACKGROUND-COLOR 7 FOREGROUND-COLOR 1.

          02 PIC 9(4) USING AA-OD-LAB

                   BACKGROUND-COLOR 7 FOREGROUND-COLOR 0.

          02 PIC X(8) USING DRIVE-BIS-LAB

                   BACKGROUND-COLOR 6 FOREGROUND-COLOR 15.

       01 QUADRO.

         02 LINE 2 COLUMN 1 BACKGROUND-COLOR 7 FOREGROUND-COLOR 0

            "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ".

         02 BACKGROUND-COLOR 0 FOREGROUND-COLOR 15 VALUE "FINE".

         02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 0 VALUE "ÍÍÍ»".

         02 LINE 3 COLUMN 1 BACKGROUND-COLOR 7 FOREGROUND-COLOR 0 VALUE

      -     "º Archivi  Accettazioni  Liste  On-line  Menu' Esiti  Refer

      -     "ti  Amministrazione º".

          02 LINE 4 COLUMN 1 BACKGROUND-COLOR 7 FOREGROUND-COLOR 0

            "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ".

       01 PULRIGHI.

            02 LINE 5  COLUMN 1 BLANK LINE.

            02 LINE 6  COLUMN 1 BLANK LINE.

            02 LINE 7  COLUMN 1 BLANK LINE.

            02 LINE 8  COLUMN 1 BLANK LINE.

            02 LINE 9  COLUMN 1 BLANK LINE.

            02 LINE 10 COLUMN 1 BLANK LINE.

            02 LINE 24 COLUMN 1 VALUE " F1 " FOREGROUND-COLOR 11.

            02 VALUE "Cambio gestione" FOREGROUND-COLOR  3.

            02 COLUMN 62 VALUE " F10 " FOREGROUND-COLOR 11.

            02 VALUE "Ricerca rapida" FOREGROUND-COLOR  3.

       01 Q1.

         02 LINE 3 COLUMN 2 VALUE " Archivi "

                        BACKGROUND-COLOR 4 FOREGROUND-COLOR  15.

         02 LINE 5 COLUMN 1 VALUE "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"

                        BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 LINE 6 COLUMN 1 VALUE "º  "

                           BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 COLUMN 26 VALUE "º" BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 VALUE "°" BACKGROUND-COLOR 0.

         02 COLUMN 4 VALUE "1 " BACKGROUND-COLOR 3 FOREGROUND-COLOR  14.

         02 COLUMN 6 VALUE  "Codici Esami        "

                          BACKGROUND-COLOR BK(1) FOREGROUND-COLOR  15.

         02 LINE 7 COLUMN 1 VALUE "º  "

                           BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 COLUMN 26 VALUE "º" BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 VALUE "° " BACKGROUND-COLOR 0.

         02 COLUMN 4 VALUE "2 " BACKGROUND-COLOR 3 FOREGROUND-COLOR  14.

         02 COLUMN 6 VALUE  "Risposte Standard   "

                          BACKGROUND-COLOR BK(2) FOREGROUND-COLOR  15.

         02 LINE 8 COLUMN 1 VALUE "º  " BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 COLUMN 26 VALUE "º" BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 VALUE "° " BACKGROUND-COLOR 0. 

         02 COLUMN 4 VALUE "3 " BACKGROUND-COLOR 3 FOREGROUND-COLOR  14.

         02 COLUMN 6 VALUE  "USL/DISTRETTI prov. "

                           BACKGROUND-COLOR BK(3) FOREGROUND-COLOR  15.

         02 LINE 9 COLUMN 1 VALUE "º  " BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 COLUMN 26 VALUE "º" BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 VALUE "° " BACKGROUND-COLOR 0.

         02 COLUMN 4 VALUE "4 " BACKGROUND-COLOR 3 FOREGROUND-COLOR  14.

         02 COLUMN 6 VALUE  "Ticket/Listini      "

                           BACKGROUND-COLOR BK(4) FOREGROUND-COLOR  15.

         02 LINE 10 COLUMN 1 VALUE "º  "  BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 COLUMN 26 VALUE "º" BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 VALUE "° " BACKGROUND-COLOR 0.

         02 COLUMN 4 VALUE "5 " BACKGROUND-COLOR 3 FOREGROUND-COLOR  14.

         02 COLUMN 6 VALUE  "Anagrafiche Pazienti"

                           BACKGROUND-COLOR BK(5) FOREGROUND-COLOR  15.

         02 LINE 11 COLUMN 1 VALUE "º  "  BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 COLUMN 26 VALUE "º" BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 VALUE "° " BACKGROUND-COLOR 0.

         02 COLUMN 4 VALUE "6 " BACKGROUND-COLOR 3 FOREGROUND-COLOR  14.

         02 COLUMN 6 VALUE  "Medici mandatari    "

                           BACKGROUND-COLOR BK(6) FOREGROUND-COLOR  15.

         02 LINE 12 COLUMN 1 VALUE "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"

                         BACKGROUND-COLOR 3 FOREGROUND-COLOR  0.

         02 VALUE "° " BACKGROUND-COLOR 0.

         02 LINE 13 COLUMN 2 VALUE "                           " BACKGROUND-COLOR 0.

       PROCEDURE DIVISION.

       INIZIO.

           CALL "LBPRSENT". CANCEL "LBPRSENT".

           OPEN INPUT DITTA. READ DITTA INTO W-REC-DITTA. CLOSE DITTA.

           ACCEPT W-DATA FROM DATE.

           OPEN OUTPUT DITTA.

           MOVE W-AA TO W-AA-OD.

           MOVE W-MM TO W-MM-OD.

           MOVE W-GG TO W-GG-OD.

           ADD 2000 TO W-AA-OD.         

           WRITE REC-DITTA FROM W-REC-DITTA.

           CLOSE DITTA.

       ABILITA-TASTO-FINE.

           MOVE 6  TO MAX(1)  MOVE 17 TO MAX(2)  MOVE 22 TO MAX(3).

           MOVE 23 TO MAX(4)  MOVE 29 TO MAX(5)  MOVE 34 TO MAX(6).

           MOVE 35 TO MAX(7)  MOVE 40 TO MAX(8).

           MOVE 1 TO ADIS-KEY-SETTING

           MOVE 2 TO NUMBER-OF-ADIS-KEYS

           MOVE 10 TO FIRST-ADIS-KEY

           CALL X"AF" USING SET-BIT-PAIRS ADIS-KEY-CONTROL.

      * ABILITAZIONE-TASTO-ESC.

           MOVE 0 TO FIRST-USER-KEY

           CALL X"AF" USING SET-BIT-PAIRS USER-KEY-CONTROL.

      *ABILITA-MOUSE.

           MOVE 1  TO FIRST-USER-KEY.

           MOVE 64 TO USER-KEY-SETTING.

           CALL X"AF" USING USER-KEY-SETTING FIRST-USER-KEY.

           MOVE 3   TO ADIS-KEY-SETTING.

           MOVE 27  TO FIRST-ADIS-KEY.

           MOVE 2   TO NUMBER-OF-ADIS-KEYS.

           CALL X"AF" USING SET-BIT-PAIRS ADIS-KEY-CONTROL.

       APRI-DITTA.

           OPEN INPUT DITTA READ DITTA CLOSE DITTA.

           IF FLOPPY = "S" CALL "LBACCDSK" CANCEL "LBACCDSK".

           IF ATT-CHIUS = "S"

              IF FLOPPY = "S" CALL "LBCHIUS2" RETURNING LK-FLAG-ERR

                              CANCEL "LBCHIUS2"

                              IF LK-FLAG-ERR = 1 GO TO FINE

                                ELSE

               ELSE CALL "LBCHIUSU" RETURNING LK-FLAG-ERR

                    CANCEL "LBCHIUSU"

                    IF LK-FLAG-ERR = 1 GO TO FINE.

           MOVE DRIVE-LAB TO W-DRV-PSW.

           CALL "_MSEXIST" USING W-PSWFILE,

                            LENGTH OF W-PSWFILE, W-STATUS.

           IF W-STATUS="30" MOVE ZEROES TO PSW

            ELSE OPEN INPUT TABPSW MOVE 0 TO COD-PSW

                READ TABPSW CLOSE TABPSW.

       VAI.

           DISPLAY INTESTAZIONE.      

      * ABILITA-FRECCETTE.

           MOVE 1 TO ADIS-KEY-SETTING

           MOVE 2 TO NUMBER-OF-ADIS-KEYS

      *ABILITA-FRECCIA-DX-SX

           MOVE 3 TO FIRST-ADIS-KEY.

           CALL X"AF" USING SET-BIT-PAIRS ADIS-KEY-CONTROL.

           MOVE 4 TO FIRST-ADIS-KEY.

           CALL X"AF" USING SET-BIT-PAIRS ADIS-KEY-CONTROL.

           MOVE 5 TO FIRST-ADIS-KEY

           CALL X"AF" USING SET-BIT-PAIRS ADIS-KEY-CONTROL.

           MOVE 6 TO FIRST-ADIS-KEY

           CALL X"AF" USING SET-BIT-PAIRS ADIS-KEY-CONTROL.

           MOVE 7 TO FIRST-ADIS-KEY

           CALL X"AF" USING SET-BIT-PAIRS ADIS-KEY-CONTROL.

       RIPOSIZ.

           DISPLAY PULRIGHI.

       SET-COLOR.

           MOVE ALL "03" TO BACK.

           MOVE 4 TO BK(K).

       SELEZ.

           DISPLAY QUADRO.

           IF Q=1 DISPLAY Q1

            ELSE IF Q=2 DISPLAY Q2

                 ELSE IF Q=3 DISPLAY Q3

                      ELSE IF Q=4 DISPLAY Q4

                           ELSE IF Q=5 DISPLAY Q5

                                ELSE IF Q=6 DISPLAY Q6

                                      ELSE IF Q=7 DISPLAY Q7

                                            ELSE  DISPLAY Q8.

       ACC-OPZ.

      *     MOVE SPACES TO KK.

           ACCEPT OPZ.

           IF KEY-TYPE="1" AND KEY-CODE-1=9 PERFORM RIPRENDI

                        CALL "LBIMPACC" CANCEL "LBIMPACC" GO TO VAI.

           IF KEY-TYPE="1" AND KEY-CODE-1=10 PERFORM RIPRENDI

                        CALL "LBRICANA" CANCEL "LBRICANA" GO TO VAI.

           IF KEY-TYPE="1" AND KEY-CODE-1=4 PERFORM RIPRENDI

                        CALL "LBFLOPPY" CANCEL "LBFLOPPY" GO TO VAI.

           IF KEY-TYPE="1" AND KEY-CODE-1=0  GO TO ACC-OPZ.

           IF KEY-TYPE="2" AND KEY-CODE-1=10 GO TO FINE.

           IF KEY-TYPE="1" AND KEY-CODE-1=1 GO TO CAMBIO-DITTA.

           IF KEY-TYPE=2 AND KEY-CODE-1=12

              IF Q > 1

                IF K > MAX(Q - 1) + 1 SUBTRACT 1 FROM K GO TO SET-COLOR

                     ELSE GO TO ACC-OPZ

               ELSE IF K > 1 SUBTRACT 1 FROM K GO TO SET-COLOR

                     ELSE GO TO ACC-OPZ.

           IF KEY-TYPE=2 AND KEY-CODE-1=11 AND KEY-CODE-2=0

              IF K < MAX(Q) ADD 1 TO K GO TO SET-COLOR

               ELSE IF Q > 1 COMPUTE K=MAX(Q - 1) + 1 GO TO SET-COLOR

                     ELSE MOVE 1 TO K GO TO SET-COLOR.

           IF KEY-TYPE=2 AND KEY-CODE-1=4

              IF Q < 8 COMPUTE K=MAX(Q) + 1 ADD 1 TO Q GO TO RIPOSIZ

               ELSE MOVE 1 TO Q K GO TO RIPOSIZ.

 

           IF KEY-TYPE=2 AND KEY-CODE-1=3

              IF Q > 2 SUBTRACT 1 FROM Q COMPUTE K=MAX(Q - 1) + 1

                       GO TO RIPOSIZ

               ELSE IF Q=2 MOVE 1 TO K Q GO TO RIPOSIZ

                     ELSE MOVE 8 TO Q MOVE 36 TO K GO TO RIPOSIZ.

           IF NOT( KEY-TYPE = "2" AND KEY-CODE-1 = 27 ) GO TO DOPO.

           CALL X"AF" USING GET-MOUSE-DETAILS MOUSE-DETAILS.

           MOVE MOUSE-X-POSITION TO COLONNA.

           MOVE MOUSE-Y-POSITION TO RIGA. ADD 1 TO RIGA COLONNA.

           IF RIGA = 24 AND COLONNA > 61 GO TO CAMBIO-DITTA.

           IF RIGA > 5

            IF Q=1

              IF RIGA<12 AND COLONNA>1 AND COLONNA<26

                               COMPUTE K = RIGA - 5 ELSE GO TO ACC-OPZ

            ELSE IF Q=2

                  IF RIGA < 17 AND COLONNA>12 AND COLONNA<37

                               COMPUTE K = RIGA + 1 ELSE GO TO ACC-OPZ

                 ELSE IF Q=3

                       IF RIGA<11 AND COLONNA>25 AND COLONNA<51

                               COMPUTE K = RIGA + 12 ELSE GO TO ACC-OPZ

                      ELSE

            IF Q=4

             IF RIGA=6 AND COLONNA>33 AND COLONNA<56 MOVE 23 TO K

                                                ELSE GO TO ACC-OPZ

             ELSE IF Q=5

                   IF RIGA<12 AND COLONNA>42 AND COLONNA<68

                               COMPUTE K = RIGA + 18 ELSE GO TO ACC-OPZ

                   ELSE IF Q=6

                         IF RIGA<11 AND COLONNA>47 AND COLONNA<72

                               COMPUTE K = RIGA + 24 ELSE GO TO ACC-OPZ

                        ELSE IF Q=7

                              IF RIGA=6 AND COLONNA>55 AND COLONNA<71

                               MOVE 35 TO K ELSE GO TO ACC-OPZ

                             ELSE

                              IF RIGA > 5 AND RIGA < 11 AND

                                 COLONNA>54 AND COLONNA<79

                               COMPUTE K = RIGA + 30 ELSE GO TO ACC-OPZ

         ELSE IF RIGA = 3

          IF COLONNA<11 MOVE 1 TO Q K GO TO RIPOSIZ

          ELSE

           IF COLONNA< 22 MOVE 2 TO Q MOVE 7 TO K GO TO RIPOSIZ

           ELSE IF COLONNA< 32 MOVE 3 TO Q MOVE 18 TO K GO TO RIPOSIZ

           ELSE IF COLONNA< 41 MOVE 23 TO K GO TO DOPO

                      ELSE IF COLONNA< 47 MOVE 5 TO Q

                                          MOVE 24 TO K GO TO RIPOSIZ

               ELSE IF COLONNA<54 MOVE 6 TO Q MOVE 30 TO K GO TO RIPOSIZ

               ELSE IF COLONNA<63 MOVE 35 TO K GO TO DOPO

               ELSE MOVE 8 TO Q MOVE 36 TO K GO TO RIPOSIZ

           ELSE IF RIGA=2 AND COLONNA > 72 AND COLONNA < 77 GO TO FINE

                 ELSE GO TO ACC-OPZ.

       DOPO.

           IF K = 0 OR K > 40 MOVE 1 TO Q K GO TO RIPOSIZ.

*********************************************************************

           MOVE 0  TO I.

       CICLO-VEDI.

           ADD 1 TO I.

           IF I > 152 OR PASSWORD = SPACES GO TO RIPRENDI.

           IF DATO1-PSW(I) NOT = K GO TO CICLO-VEDI.

           IF DATO2-PSW(I) NOT = 0 GO TO CICLO-VEDI.

           DISPLAY RIGO-PASS.

           ACCEPT (12, 34) CHIAVE WITH NO-ECHO.

           IF (KEY-TYPE="1" AND KEY-CODE-1=0) OR CHIAVE NOT = PASSWORD

                                                 GO TO VAI.

************************************************************************

       RIPRENDI.

           MOVE 2 TO ADIS-KEY-SETTING NUMBER-OF-ADIS-KEYS.

           MOVE 3 TO FIRST-ADIS-KEY.

           CALL X"AF" USING SET-BIT-PAIRS ADIS-KEY-CONTROL.

           MOVE 4 TO FIRST-ADIS-KEY.

           CALL X"AF" USING SET-BIT-PAIRS ADIS-KEY-CONTROL.

       SALTI-ETX.

           GO TO ET1  ET2  ET3  ET4  ET5  ET6  ET7  ET8  ET9  ET10 ET11

                 ET12 ET13 ET14 ET15 ET16 ET17 ET18 ET19 ET20 ET21 ET22

                 ET23 ET24 ET25 ET26 ET27 ET28 ET29 ET30 ET31 ET32 ET33

                 ET34 ET35 ET36 ET37 ET38 ET39 ET40 DEPENDING ON K.

       ET1.

           CALL "LBMENESA" CANCEL "LBMENESA" GO TO FQ1.

       ET2.

           CALL "LBMENRSP" CANCEL "LBMENRSP" GO TO FQ1.

       ET3.

           CALL "LBMENUSL" CANCEL "LBMENUSL" GO TO FQ1.

       ET4.

           CALL "LBMENTIK" CANCEL "LBMENTIK" GO TO FQ1.

       ET5.

           CALL "LBMENPAZ" CANCEL "LBMENPAZ" GO TO FQ1.

       ET6.

           CALL "LBMENMED" CANCEL "LBMENMED".

       FQ1.

           MOVE 1 TO Q GO TO VAI.

       ET7.

           CALL "LBINSACC" CANCEL "LBINSACC" GO TO FQ2.

       ET8.

           CALL "LBRICACC" CANCEL "LBRICACC" GO TO FQ2.

       ET9.

           CALL "LBSELACC" CANCEL "LBSELACC" GO TO FQ2.

       ET10.

           CALL "LBVARACC" CANCEL "LBVARACC" GO TO FQ2.

       ET11.

           CALL "LBCANACC" CANCEL "LBCANACC" GO TO FQ2.

       ET12.

           CALL "LBMENACC" CANCEL "LBMENACC" GO TO FQ2.

       ET13.

           CALL "LBMENPRN" CANCEL "LBMENPRN" GO TO FQ2.

       ET14.

           CALL "LBELEACC" CANCEL "LBELEACC" GO TO FQ2.

       ET15.

           CALL "LBTRAACC" CANCEL "LBTRAACC" GO TO FQ2.

       ET16.

           CALL "LBMENQLT" CANCEL "LBMENQLT".   GO TO FQ2.

       ET17.

           CALL "LBMENIMP" CANCEL "LBMENIMP".

       FQ2.

           MOVE 2 TO Q GO TO VAI.

       ET18.

           CALL "LBESALIS" CANCEL "LBESALIS" GO TO FQ3.

       ET19.

           CALL "LBPAZLIS" CANCEL "LBPAZLIS" GO TO FQ3.

       ET20.

           CALL "LBMENLLI" CANCEL "LBMENLLI" GO TO FQ3.

       ET21.

           CALL "LBMENLIS" CANCEL "LBMENLIS" GO TO FQ3.

       ET22.

           CALL "LBGENLIS" CANCEL "LBGENLIS".

       FQ3.

           MOVE 3 TO Q GO TO VAI.

       ET23.

           CALL "LBMENSTR" CANCEL "LBMENSTR" MOVE 4 TO Q GO TO VAI.

       ET24.

           CALL "LBMENINV" CANCEL "LBMENINV" GO TO FQ5.

       ET25.

           CALL "LBMENCIT" CANCEL "LBMENCIT" GO TO FQ5.

       ET26.

           CALL "LBMENREA" CANCEL "LBMENREA" GO TO FQ5.

       ET27.

           CALL "LBPRVESA" CANCEL "LBPRVESA" GO TO FQ5.

       ET28.

           CALL "LBMENAGE" CANCEL "LBMENAGE" GO TO FQ5.

       ET29.

           CALL "LBMENSER" CANCEL "LBMENSER".

       FQ5.

           MOVE 5 TO Q GO TO VAI.

       ET30.

           CALL "LBESARIS" CANCEL "LBESARIS" GO TO FQ6.

       ET31.

           MOVE "T" TO TIPO-RIS.

           DISPLAY Q-TIPO.

           ACCEPT  Q-TIPO.

           IF KEY-TYPE = "1" AND KEY-CODE-1 = 0 GO TO FQ6.

           IF TIPO-RIS = "E"         CALL "LBPAZPT2" CANCEL "LBPAZPT2"

            ELSE IF TIPO-RIS = "A"   CALL "LBPAZPT1" CANCEL "LBPAZPT1"

              ELSE IF TIPO-RIS = "V" CALL "LBPAZPTV" CANCEL "LBPAZPTV"

                      ELSE           CALL "LBPAZRIS" CANCEL "LBPAZRIS".

           GO TO FQ6.

       ET32.

           CALL "LBSOSESA" CANCEL "LBSOSESA" GO TO FQ6.

       ET33.

           CALL "LBSOSPAZ" CANCEL "LBSOSPAZ" GO TO FQ6.

       ET34.

           CALL "LBSOSELE" CANCEL "LBSOSELE".

       FQ6.

           MOVE 6 TO Q GO TO VAI.

       ET35.

           CALL "LBMENREF" CANCEL "LBMENREF" MOVE 7 TO Q GO TO VAI.

       ET36.

           CALL "LBMENAMM" CANCEL "LBMENAMM" GO TO FQ8.

       ET37.

           CALL "LBMENCON" CANCEL "LBMENCON" GO TO FQ8.

       ET38.

           CALL "CNMENCON" CANCEL "CNMENCON" GO TO FQ8.

       ET39.

            GO TO FQ8.

       ET40.

           CALL "LBRICOST" CANCEL "LBRICOST".

       FQ8.

           MOVE 8 TO Q GO TO VAI.

       CAMBIO-DITTA.

           DISPLAY PULRIGHI PERFORM RIPRENDI.

           CALL "LBDITTA" CANCEL "LBDITTA" PERFORM INIZIO. GO TO VAI.

       FINE.

           DISPLAY PULVIDEOF.  STOP RUN. 

Come potete facilmente notare, scrivere oggi questo codice, è da maniaci. Il numero delle istruzioni è notevole rispetto alla semplicità della funzione implementata. 

Infatti si tratta di un semplice programma di menù dove l’utente deve scegliere tra diverse opzioni numerate. 

La scelta avviene tramite la digitazione di un nr d’ordine oppure con il click del mouse. Quest’ultima possibilità operativa era già un “novità” in quanto l’uso del mouse arrivava da poco nei sistemi Windows e sconosciuto nei sistemi MS-DOS,

Il programmatore doveva conoscere alla perfezione sintassi e semantica di ogni istruzione, pena fiume di tempo che si perdeva. Inoltre, le diverse sezioni del codice programma sono perfettamente collegate e congruenti. 

Diversamente sarebbe impossibile tradurlo in codice eseguibile direttamente dalla macchina.

Non oso ricordami quante volte ho dovuto correggere e ricompilare (tradurre nel linguaggio della macchina) prima di tentare la prima esecuzione. 

L’euforia della prima esecuzione si spegneva ben presto quando si riscontrava che il programma non rispondeva correttamente alle idee del programmatore.