.TITLE INIT='Ukazkovy program objednavka';                                      ************************************************************************        *                                                                      *        * JMENO - Ukazkovy program objednavka                                  *        *                                                                      *        * UCEL - Ilustrovat techniku sestaveni programu.                       *        *                                                                      *        * FUNKCE - Napovedi pro hlavicku a jednotlive polozky objednavky, zapis*        *            na disketu a volitelny tisk seznamu objednavek. Umoznuje  *        *            take aktualizovat drive porizene zaznamy. Tisk neni pouzit*        *            pri prohlizeni a aktualizovani predchazejicich zaznamu.   *        *                                                                      *        *                                                                      *        * OPERACE - Uzivatel je vyzvan, aby udal:                              *        *             1. Jmeno datoveho souboru a adresu.                      *        *             2. Adresu tiskarny (volitelne).                          *        *             3. Datova pole pro hlavicku.                             *        *             4. Datova pole pro jednotlive polozky objednavky.        *        *             5. Pridane zaznamy jednotlivych polozek objednavky.      *        *           Stisknutim SEL se voli nova hlavicka. Stisknutim BLOK ZPET *        *           se vraci na predchazejici zaznam. Dalsi funkcni klavesy    *        *           (BL.KR.,SYST,POZ,->,<-,FUNK1 a 8 (EOJ)) maji svuj obvykly  *        *           vyznam. Ostatni funkcni klavesy a povelove klavesy jsou    *        *           ignorovany.                                                *        *                                                                      *        *                                                                      *        * VYSTUP - Zapis hlavicky na disketu:                                  *        *            pozice        obsah                                       *        *             1 -  8  cislo zakaznika                                  *        *             9 - 16  cislo objednavky                                 *        *            17 - 22  datum (ddmmrr)                                   *        *            23 - 24  cislo skladu                                     *        *            25 - 30  zpusob dopravy                                   *        *                     Platne hodnoty jsou (C)SD,(A)UTO,(P)OSTA,        *        *                                         (O)SOBNE,(V)HODNY            *        *            31 -128  nepouzito, mezery                                *        *          Zapis jednotlivych polozek objednavky na disketu:           *        *            pozice        obsah                                       *        *             1 -  8  cislo zakaznika (z hlavicky)                     *        *             9 - 16  cislo objednavky (z hlavicky)                    *        *            17 - 24  cislo polozky                                    *        *            25 - 29  mnozstvi (limitni mnozstvi je 1000)              *        *            30 - 36  cena za kus (halere)                             *        *            37 - 49  celkova cena = mnozstvi * cena                   *        *              80     znak D - oznacuje polozku objednavky             *        *            50 -128  nepouzito, mezery                                *        *          Tisk seznamu (volitelny):                                   *        *            Hlavicka a prvni polozka objednavky jsou formatovany na   *        *            na stejnem radku. Dalsi polozky objednavky pro stejnou    *        *            hlavicku jsou umisteny na dalsich radcich bez hlavicky.   *        *                                                                      *        * OMEZENI - Je vyzadovana spolecna funkcni oblast (SYSDPRT2).          *        *           Vystupni datovy soubor musi byt alokovan predem.           *        *                                                                      *        ************************************************************************        .EJECT;                                                                         .START PNAM='PRIKLAD' ENTRY=START MCHK=CFPGMCHK;                                .KBCRT CRBA=VVOBL     ETAB=VNSTKL HLIN=X'30' NMIN=X'20';                        .DC LABEL=POVELKL LEVL=2 DISP=X'88';  SOUCASNY POVEL K/D                        .DC LABEL=SNKOD   LEVL=2 DISP=X'A6';  VYBEROVY A ZNAKOVY KOD                    .DC LABEL=REZIMK  LEVL=2 DISP=X'BE';  REZIM KLAVESNICE/OBRAZOVKA                .DCLIND LABEL=EODPR,TISKPR,MNOZPR;                                              .EQUATE NUMB=(1,OBJED),(2,TISK);      CISLA DATOVYCH SOUBORU                    * NASLEDUJICI DEFINICE REGISTRU A INDIKATORU JSOU NEPOVINNE A JSOU              * UVEDENY PROTO,ABY SE SYSTEMOVE REGISTRY A INDIKATORY OBJEVILY                 * VE VYPISU KRIZOVYCH ODKAZU (PREHLEDU JMEN)                                    .EQUATE REG=(BR10,BR10),(BR18,BR18),(BR19,BR19),(BR22,BR22);                    .EQUATE IND=(I115,I115),(I118,I118),(I125,I125);                                .XTRN LABEL=CFPGMCHK,CFGIOERR,CFSTART,CFEOJRTN,CFERCDSM,                                    CFATFBGD,CFDEVCHK,CFKEYRT;                                          .DC LABEL=CFPRAC  TYPE=BIN INIT=ADDR(CFUKLID); ADRESA UKLIDOVE OBLASTI CF       .DC LABEL=CFPARM1 TYPE=BIN;                    PARAMETR PRO SPOL.FCE            .DC LABEL=CFPARM2 TYPE=BIN;                    PARAMETR PRO SPOL.FCE            .DCLBR LABEL=PRBR1;                            BINARNI PRACOCNI REGISTRY        .DC LABEL=RADSL   TYPE=BIN INIT=X'0423';       RADEK A SLOUPEC PRO CRTMM        .DC LABEL=OBL@    TYPE=BIN INIT=ADDR(VVOBL);   UKAZATEL VV OBLASTI              .DC LABEL=TXT@    TYPE=BIN INIT=ADDR(DOPR);    UKAZATEL PRO CRTMM               .DC LABEL=RITISK@ TYPE=BIN INIT=ADDR(RITISK);  UKAZATEL PRO RIZENI TISKU        .DC LABEL=RITISK  TYPE=BIN INIT=X'8000';       RIZENI TISKU                     .DC LABEL=K5      TYPE=BIN INIT=5;                                              .DC LABEL=K22     TYPE=BIN INIT=X'22';                                          .DC LABEL=K29     TYPE=BIN INIT=X'29';                                          .DC LABEL=K3701   TYPE=BIN INIT=X'3701';       KOD PRO EOD                      .DCLDR LABEL=PRDR1,RMNOZ,RCENA;                DEKADICKE PRAC.REGISTRY          .DC LABEL=LIMIT   TYPE=DEC INIT=1000;          LIMITNI MNOZSTVI                 .DC LABEL=MSG9111 INIT=X'F9F1F1F1FF';  9111 - SELF CHECK INCORECT               .SPACE NUMB=3;                                                                  * DEFINICE DATOVEHO SOUBORU OBJEDNAVEK                                          .DATASET DSN=OBJED  DEVID=F1  RECL=128 BSIZ=0 TYPE=SU NAME=DSJMENO                       LBUF=VVOBL PB1=BAFR1 ELAB=VNSTDS;                                      .SPACE NUMB=3;                                                                        * DEFINICE SOUBORU PRO TISK                                                     .DATASET DSN=TISK   DEV=X'8000' RECL=120 BSIZ=256 TYPE=SW,SCS                            PGSIZ=72   LINSZ=120   LSTLN=56                                                 LBUF=PAMTIS PB1=BAFR2   ELAB=GIOERR;                                                        .DC LABEL=BAFR1  LEN=1024 BDY=128;                                              .DC LABEL=BAFR2  LEN=256  BDY=128;                                              .DC LABEL=CFUKLID LEN=128;                                                      .DC LABEL=PAMTIS  LEN=120;                                                      .DC LABEL=DSJMENO LEN=10   INIT=' ';                                            .SPACE NUMB=3;                                                                  * LOGICKA VYROVNAVACI PAMET PRO KLAVESNICI A DISKETU                            .DC LABEL=VVOBL  LEN=128;                                                       .DC LEVL=2     INIT='OBJED   XXXX8000';    PARAMETRY OTEVRENI SOUBORU           .DC LEVL=2 LABEL=ZAKAZ   LEN=8  DISP=0;    CISLO ZAKAZNIKA                      .DC LEVL=2 LABEL=CISOBJ  LEN=8;            CISLO OBJEDNAVKY                     .DC LEVL=2 LABEL=DATUM   LEN=6;            DATUM                                .DC LEVL=2 LABEL=SKLAD   LEN=2;            CISLO SKLADU                         .DC LEVL=2 LABEL=DOPR    LEN=6;            ZPUSOB DOPRAVY                       .DC LEVL=2 LABEL=CIPOL   LEN=8  DISP=16;   CISLO POLOZKY                        .DC LEVL=2 LABEL=MNOZ    LEN=5;            MNOZSTVI                             .DC LEVL=2 LABEL=CENA    LEN=7;            CENA                                 .DC LEVL=2 LABEL=CELKEM  LEN=13;           MNOZ * CENA                          .DC LEVL=2 LABEL=RIZNAK  LEN=1  DISP=79;   RIDICI ZNAK                          .SPACE NUMB=3;                                                                  .SELFCHK MOD=S10;                          STANDARDNI SAMOKONTROLA              .SPACE NUMB=3;                                                                  * TABULKA TEXTU PRO ZPUSOB DOPRAVY                                              .TABLE LABEL=DOPRTXT DCLBL=DOPRAVA  ARGL=6 ENTRIES=5;                           .TABLE LABEL=DOPRID  DCLBL=DOPRAVA  ARGL=1 BYPAS=5 ENTRIES=5;                   .TABLE LABEL=RGPPR   DCLBL=OBLAD  ENTRIES=4 ARGL=2; ZACATKY POLI S RG           .DC LABEL=DOPRAVA  LEN=30;                 TEXT PRO ZPUSOB DOPRAVY              .DC LEVL=2 LEN=6 INIT='CSD   ';                                                 .DC LEVL=2 LEN=6 INIT='AUTO  ';                                                 .DC LEVL=2 LEN=6 INIT='POSTA ';                                                 .DC LEVL=2 LEN=6 INIT='OSOBNE';                                                 .DC LEVL=2 LEN=6 INIT='VHODNY';                                                 .SPACE NUMB=3;                                                                  * FORMATY STINITKA PRO OTEVRENI DATOVYCH SOUBORU                                .SFMTST LABEL=PROBJED CNTL=CS,MV;      FORMAT PRO SOUBOR OBJEDNAVEK             .SFMTPMT PRMT=SP,TITLE;                                                         .SFMTPMT PRMT=SP,OBJED1 CSPS=NL;                                                .SFMTPMT PRMT=SP,OBJED2 CSPS=NL;                                                .SFMTFLD FLDF=A,8 CSPS=+3 CNTL=MC;     JMENO DATOVEHO SOUBORU                   .SFMTPMT PRMT=SP,OBJED3 CSPS=NL;                                                .SFMTFLD FLDF=N,4       CSPS=+3;        ADRESA ZARIZENI (FYZ./LOG.)             .SFMTEND;                                                                       .SPACE;                                                                         .SFMTST LABEL=PRTISK CNTL=CS,MV;       FORMAT PRO ADRESU TISKARNY               .SFMTPMT PRMT=SP,TITLE;                                                         .SFMTPMT PRMT=SP,TISK1 CSPS=NL;                                                 .SFMTFLD FLDF=N,4  CSPS=+3  BFPS=+12;  ADRESA ZARIZENI (FYZ./LOG.)              .SFMTPMT PRMT=SP,TISK2 CSPS=NL;                                                 .SFMTEND;                                                                       .SPACE;                                                                         * VYZVY PRO FORMATY OTEVRENI SOUBORU                                            .DC TYPE=PRMT LABEL=TITLE  INIT='UKAZKOVY PROGRAM OBJEDNAVKY';                  .DC TYPE=PRMT LABEL=OBJED1                                                        INIT='INFORMACE PRO DATOVY SOUBOR OBJEDNAVEK:';                                 .DC TYPE=PRMT LABEL=OBJED2 INIT='JMENO SOUBORU';                                .DC TYPE=PRMT LABEL=OBJED3 INIT='ADRESA ZARIZENI';                              .DC TYPE=PRMT LABEL=TISK1 INIT='UDEJTE ADRESU TISKARNY';                        .DC TYPE=PRMT LABEL=TISK2 INIT='VYMEZERNIKUJTE NENI-LI TISK';                   .SPACE NUMB=3;                                                                  * FORMATY STINITKA PRO VLOZENI UDAJU OBJEDNAVKY                                 .SFMTST LABEL=PRHLV CNTL=CS;           FORMAT PRO HLAVICKU OBJEDNAVKY           .SFMTPMT PRMT=SP,HLAVA1    CSPS=NL;    ZAKAZNIK                                 .SFMTFLD FLDF=D,8,RZ,BC    CSPS=1 CNTL=RG;                                      .SFMTPMT PRMT=SP,HLAVA2    CSPS=2;     OBJEDNAVKA                               .SFMTFLD FLDF=D,8,RZ,BC,DR CSPS=3;                                              .SFMTPMT PRMT=SP,HLAVA3    CSPS=NL;    DATUM                                    .SFMTFLD FLDF=D,6,RZ,BC    CSPS=1;                                              .SFMTPMT PRMT=SP,HLAVA4    CSPS=2;     SKLAD                                    .SFMTFLD FLDF=D,2,RZ,BC    CSPS=1;                                              .SFMTPMT PRMT=SP,HLAVA6    CSPS=3;     ZPUSOB DOPRAVY                           .SFMTFLD FLDF=A,1,BC,DR    CSPS=2;                                              .SFMTEND;                                                                       .SPACE;                                                                         .SFMTST LABEL=PRDOPR;                  FORMAT PRI CHYBNEM ZADANI DOPRAVY        .SFMTPMT PRMT=FP,HLAVA7;               NEZNAMA DOPRAVA                          .SFMTFLD FLDF=A,1,BC,DR CSPS=194 BFPS=24;                                       .SFMTPMT PRMT=CP,40;                   VYMAZANI RADKU PEVNE VYZVY               .SFMTEND;                                                                       .SPACE;                                                                         .SFMTST LABEL=PROBJ;                   FORMAT PRO JEDNOTLIVE POLOZKY            .SFMTCTL CI=EODPR,OFF;                 VYNECHAT,JE-LI AKTUALIZACE               .SFMTPMT PRMT=SP,MEZERY CSPS=240;      SMAZ UDAJE PREDCHOYI POLOZKY:            .SFMTPMT PRMT=SP,MEZERY;                    RADKY 5 A 6                         .SFMTPMT PRMT=SP,MEZERY CSPS=NL;                                                .SFMTPMT PRMT=SP,MEZERY;                                                        .SFMTCTL CSPS=-120 CNTL=CE;            KONEC MIJENI                             .SFMTPMT PRMT=SP,OBJ1;                 POLOZKA                                  .SFMTFLD FLDF=D,8,RZ,DR,BC CSPS=1   BFPS=16;                                    .SFMTPMT PRMT=SP,OBJ2     CSPS=7;      MNOZSTVI                                 .SFMTFLD FLDF=D,5,RZ,DR,BC CSPS=4   CNTL=RG;                                    .SFMTCTL CI=MNOZPR,OFF;                VYNECHAT JE-LI MNOZSTVI V PORADKU        .SFMTPMT CSPS=-280 DSPLY=HI,BL                                                           PRMT=SP,OBJ3;                 ZPRAVA O CHYBNEM MNOZSTVI                         .SFMTPMT PRMT=SP,OBJ4;                 MOZNOSTI PRO CHYBNE MNOZSTVI             .SFMTFLD FLDF=A,1,BC,DR    CSPS=+1 BFPS=+50 CNTL=MC;                            .SFMTPMT PRMT=CP  CNTL=RG;             VYMAZANI RADKU PEVNE VYZVY               .SFMTCTL CSPS=+250 BFPS=-51 CNTL=CE;   KONEC MIJENI,NASTAV CSPS A BFPS          .SFMTPMT PRMT=SP,OBJ5     CSPS=NL;     CENA                                     .SFMTFLD FLDF=D,7,DR,RZ,BC CSPS=5;                                              .SFMTPMT PRMT=SP,OBJ6     CSPS=3;      CELKOVA CENA                             .SFMTFLD FLDF=D,13,BY      CSPS=2  CNTL=RG;                                     .SFMTEND;                                                                       .SPACE;                                                                         .DC LABEL=HLAVA1 TYPE=PRMT INIT='ZAKAZNIK';                                     .DC LABEL=HLAVA2 TYPE=PRMT INIT='OBJEDNAVKA';                                   .DC LABEL=HLAVA3 TYPE=PRMT INIT='DATUM';                                        .DC LABEL=HLAVA4 TYPE=PRMT INIT='SKLAD';                                        .DC LABEL=HLAVA6 TYPE=PRMT INIT='DOPRAVA';                                      .DC LABEL=HLAVA7 TYPE=PRMT INIT='CHYBNA DOPRAVA, ZNOVU';                        .DC LABEL=OBJ1   TYPE=PRMT INIT='POLOZKA';                                      .DC LABEL=OBJ2   TYPE=PRMT INIT='MNOZSTVI';                                     .DC LABEL=OBJ3   TYPE=PRMT INIT='PREKROCEN LIMIT ';                             .DC LABEL=OBJ4   TYPE=PRMT INIT='Z=ZNOVU,P=PRIJMI';                             .DC LABEL=OBJ5   TYPE=PRMT INIT='CENA';                                         .DC LABEL=OBJ6   TYPE=PRMT INIT='CELKEM';                                       .DC LABEL=MEZERY TYPE=PRMT LEN=20 INIT=' ';                                     .SPACE NUMB=3;                                                                  * EDICNI FORMAT PRO TISK POLOZKY OBJEDNAVKY                                     .FMTST LABEL=OBJFMT;                                                            .FMTFLD DCLBL=CIPOL  TYPE=DEC LEN=8  COL=50;                                    .FMTFLD DCLBL=MNOZ   TYPE=DEC LEN=5  COL=60 EDIT=BF;                            .FMTFLD DCLBL=CENA   TYPE=DEC LEN=10 COL=67 EDIT=FL,CP,DP,2;                    .FMTEND DCLBL=CELKEM TYPE=DEC LEN=18 COL=79 EDIT=FX,AF,CP,DP,2;                 .SPACE NUMB=3;                                                                  * EDICNI FORMAT PRO TISK HLAVICKY OBJEDNAVKY                                    .FMTST LABEL=HLVFMT;                                                            .FMTFLD DCLBL=ZAKAZ  TYPE=DEC LEN=8  COL=1;                                     .FMTFLD DCLBL=CISOBJ TYPE=DEC LEN=8  COL=11;                                    .FMTFLD DCLBL=DATUM  TYPE=DEC LEN=8  COL=21 EDIT=C;                             .FMTFLD DCLBL=SKLAD  TYPE=DEC LEN=2  COL=31;                                    .FMTEND DCLBL=DOPR   TYPE=DEC LEN=7  COL=35;                                    .SPACE NUMB=8;                                                                  START:   CALL CFSTART;                 NASTAVENI SPOL.OBLASTI                            SRAT (OBJED,PRBR1);           URCI FYZ.ADRESU 'F1'                              IFIR I118 IS ON GOTO OPNOBJE; SKOC NENI-LI ADR.NALEZENA                         BINHEX (VVOBL(4)+8,PRBR1);    JE-LI NALEZENA,POUZIT STANDARDNI                                                      .SPACE;                                                                         OPNOBJE: CALL CFATFBGD;                PRIPOJENI KLAVESNICE                     OPNOBJ:  ENTR (PROBJED);               PARAMETRY OTEVRENI SOUBORU OBJED.                 CFPARM2 = OBJED;              DSN PRO CFDEVCHK                                  CFPARM1 = ADDR(VVOBL+8);      ADRESA ZARIZENI                                   CALL CFDEVCHK;                KONTROLA ADRESY ZARIZENI                          GOTO OPNOBJ;                  CHYBNA ADRESA ZARIZENI, ZNOVA                     PRDR1 = VVOBL(8);             PRESUN JMENA SOUBORU                              DSJMENO(8) = PRDR1;                                                             OPEN (OBJED);                 OTEVRENI SOUBORU OBJEDNAVEK                       IFDSI 8,OBJED NOT ON GOTO OPNOBJ; JE-LI OPEN NEUSPESNE, ZNOVU                   POSN (OBJED,EOD);             PRIDANI K JIZ EXISTUJICIM DATUM                   SON (EODPR);                  OZNACUJE, ZE JE NA EOD                   .SPACE;                                                                         OPNTSK:  ENTR (PRTISK);                PARAMETRY PRO OTEVRENI SOUB.TISKU                 IFC 12,VVOBL NOT C' ' SKIP;   TEST ZADANI TISKU                                 GOTO MEZ;                     TISK NEZADAN                                      CFPARM2 = TISK;               DSN PRO CFDEVCHK                                  CFPARM1 = ADDR(VVOBL+12);     ADRESA ZARIZENI                                   CALL CFDEVCHK;                KONTROLA ADRESA ZARIZENI                          GOTO OPNTSK;                  CHYBNA ADRESA ZARIZENI, ZNOVU                     OPEN (TISK);                  OTEVRENI SOUBORU TISK                             IFDSI 8,TISK NOT ON GOTO OPNTSK; NENI-LI OPEN USPESNE, ZNOVU                    SON (TISKPR);                 POZNAMKA, ZE JE TISK                     .SPACE;                                                                         *  ZADANI UDAJU PRO HLAVICKU OBJEDNAVKY                                         MEZ:     0(OBL@) = C' ';               UMISTENI MEZERY NA ZACATEK VVOBL                  DUP (0,OBL@,79);              MEZEROVANI VVOBL                         ZAK:     ENTR (PRHLV);                 ZADANI UDAJU HLAVICKY OBJEDNAVKY         DOPRAV:  PRDR1 = DOPR(1);              PRECTI KOD DOPRAVY                                PRBR1 = TBFX(DOPRID,PRDR1);   HLEDANI V TABULCE TEXTU DOPRAVY                   IFIR I125 NOT ON GOTO DOPROK; SKOC,JE-LI KOD NALEZEN                            ENTR (PRDOPR);                CHYBOVA ZPRAVA - KOD NENALEZEN                    GOTO DOPRAV;                  ZKONTROLUJ NOVY KOD DOPRAVY              .SPACE;                                                                         DOPROK:  PRDR1 = TBRD(DOPRTXT,PRBR1);  ULOZENI TEXTU DOPRAVY:                            DOPR = PRDR1;                      DO PAMETI SOUCASNEHO ZAZNAMU                 CRTMM (RADSL,TXT@,K5);             NA OBRAZOVKU                        .SPACE;                                                                         *  ZPRACOVANI HLAVICKY OBJEDNAVKY                                                        IF BR10 IS 0 GOTO READ;       SKOC,NENI-LI HLAVICKA MODIFIK.                    IFI TISKPR NOT ON GOTO WRTHL; SKOC,NENI-LI TISK                                 RITISK = X'9003';             TRI RADKY (SCS)                                   IFIR I115 NOT ON GOTO TISKHL; SKOC,NENI-LI NA KONCI STRANKY                     RITISK = X'5003';             NASTAVENI NA 3.RADEK NOVE STRANKY        TISKHL:  WRT (TISK,,RITISK@);          PROSTOR PRED ZACATKEM TISKU                       RITISK = X'8000';             ZADNY VOLNY PROSTOR                               WRT (TISK,HLVFMT,RITISK@,,B); TISK NA TISKARNE,ZADNE VOLNE RADKY       WRTHL:   WRT (OBJED,,0);               ZAPIS NA DISKETU                                  IFI EODPR NOT ON GOTO READ;   SKOC PRI AKTUALIZACI STARYCH ZAZ.        .SPACE;                                                                         *  NAPOVED PRO JEDNOTLIVE OBJEDNAVKY                                            JOBJ:    16(OBL@) = C' ';              UMISTENI MEZERNIKU                                DUP (16,OBL@,32);             MEZEROVANI VVOBL PRO POLOZKU             POLOZ:   ENTR (PROBJ);                 VLOZENI UDAJU POLOZKY OBJEDNAVKY         .SPACE;                                                                         *  ZPRACOVANI POLOZKY OBJEDNAVKY                                                         IF BR10 IS 0 GOTO READ;       SKOC NEBYL-LI ZAZNAM MODIFIKOVAN                  IFI TISKPR NOT ON GOTO WRTOB; SKOC NENI-LI TISK                                 WRT (TISK,OBJFMT,,,B);        TISK NA TISKARNE                         WRTOB:   RIZNAK = C'D';                RIDICI KOD PRO RIZENI FMT DATY                    WRT (OBJED,,0);               ZAPIS NA DISKETU                                  IFI EODPR IS ON GOTO JOBJ;    ZPRACUJ DALSI POLOZKU OBJEDNAVKY         .SPACE;                                                                         *  CTENI ZE SOUBORU OBJEDNAVKA,RIZENI FORMATU OBRAZOVKY DATY                    READ:    READ (OBJED,*,+);             CTENI DALSIHO ZAZNAMU                             IFI EODPR IS ON GOTO JOBJ;    SKOC,JE-LI DOSAZENO EOD                  ROZDEL:  IFC RIZNAK IS C'D' SKIP;      PRESKOC,JE-LI ZAZNAM POLOZKA OBJ.                 GOTO ZAK;                     ZAZNAM OBSAHUJE HLAVICKU OBJEDN.                  GOTO POLOZ;                   ZAZNAM OBSAHUJE POLOZKU OBJEDN.          .SPACE NUMB=3;                                                                  *  VNEJSI STAVY DISKETY A TISKARNY                                              VNSTDS:  PRBR1 = 4(2,BR22);            VEZMI KOD CHYBY Z RIDICIHO BLOKU                  IF PRBR1 EQ K3701 GOTO EOD;   SKOC,JE-LI KONEC DAT                     GIOERR:  CALL CFGIOERR;                JINAK OZNAM NA STAVOVEM RADKU                     GOTO EOJ;                     SKOC,JE-LI KONEC PRACE                            RETURN;                       JINAK SE VRAT A POKRACUJ                 EOD:     SON (EODPR);                  OZNAC,ZE JE NA KONCI DAT                          PRBR1 = REZIMK;               CTI REZIM KLAVESNICE                              PRBR1 X= X'C0';               ZMEN REZIM AKTUALICE NA VSTUP                     REZIMK = PRBR1;               ULOZ REZIM VSTUP                                  IFDSI 8,TISK NOT ON GOTO DKRTN; PRESKOC,NENI-LI DOSTUPNY TISK                   SON (TISKPR);                 JINAK ZASE ZAPNI PRIZNAK TISKU           DKRTN:   RETURN;                       DELEJ DALSI POLOZKU                      .SPACE NUMB=3;                                                                  *  VNEJSI STAVY KLAVESNICE                                                                       .LABTAB LABEL=VNSTKL ENTRY=VNST0,VNST1,VNST2,VNST3,VNST4,VNST5,VNST6,                    VNST7,VNST8,VNST9,VNST10,VNST11,VNST12,VNST13;                         VNST0:   ;                             0 - DVOJITY VNEJSI STAV                  VNST2:   ;                             2 - FUNK1 BEZ PREMYKU                    VNST3:   ;                             3 - FUNK1 S DRZENYM PREMYKEM             VNST8:   ;                             8 - CHYBA KLAVESNICE                     VNST9:   ;                             9 - REZERVOVANO PRO VYSSI SYSTEMY        VNST10:  ;                             10- CHYBNA KLAVESOVA OPERACE             VNST11:  ;                             11- REZERVOVANO PRO VYSSI SYSTEMY        VNST12:  ;                             12- REZERVOVANO PRO VYSSI SYSTEMY        VNST13:  ;                             13- CHYBA RETEZCE SFMT                   .SPACE;                                                                         KEYRT:   ;                             PODPROGRAM ZPRAC.VN.ST.KLAV.                      CALL CFKEYRT;                 STANDARDNI OBSLUHA VN.ST.KLAV.                    GOTO EOJ;                     BYLA POUZITA KLAVESA KONEC PRACE                  GOTO KRTN;                    NA NAVRAT                                .SPACE;                                                                         *  KONEC PRACE - NORMALNE NEBO CHYBOU                                           EOJ:     CALL CFEOJRTN;                UKONCENI UZIVATELSKEHO PROGRAMU          .SPACE;                                                                         VNST1:   ;                             1 - FUNKCNI KLAVESA                               PRBR1 = SNKOD(2);             TEST ZNAKOVEHO KODU FUNKCE                        IFH PRBR1 NE X'33' GOTO KEYRT;NEBYLA-LI KLAVESA SEL (VOLBA FMT)                 IFI EODPR NOT ON GOTO KRTN;   IGNORUJ SEL, JE-LI AKTUALIZACE                    CNENTR;                       ZRUSENI ENTR                                      ENABLE (MEZ,POP);             SKOC NA ZACATEK NOVE HLAVICKY            .SPACE;                                                                         VNST4:   ;                             4 - PRECHOD PRES RG DOPREDU              *                         BR19 OBSAHUJE ADR.SOUCASNEHO POLE VE VVOBL                     PRDR1 = BR19+0;               KOPIROVANI ADRESY BEZ PREVODU                     PRBR1 = TBFX(RGPPR,PRDR1);    HLEDANI ADRESY POLE V TABULCE                     GOTAB PRBR1,RGPODP;           BEZ NA ODPOVIDAJICI PODPROGRAM           .LABTAB LABEL=OBLAD       ENTRY=   ZAKAZ,   MNOZ,  RIZNAK,  CELKEM;             .LABTAB LABEL=RGPODP ENTRY = VNST13,ZAKPP,MNOZPP,MNOZL,CENAPP;                  .SPACE;                                                                         ZAKPP:   GOTO KRTN;                    TEST CISLA ZAKAZNIKA SE NEDELA                    PRDR1 = ZAKAZ;                POZDEJSI OBSLUHA CHYBY CISLA ZAK.                 IF PRDR1 IS CK GOTO KRTN;     SKOC,JE-LI CIS.ZAKAZNIKA SPRAVNE                  CFPARM1 = ADDR(MSG9111);      DEJ ZPRAVU                                        CALL CFERCDSM;                UMISTENI CHYBOVE ZPRAVY NA STAV.R.                GOTO EOJ;                     JE-LI KONEC PRACE                                 RESUME (B);                   ZPET NA CISLO ZAKAZNIKA                           GOTO KRTN;                    ZPET DO FORMATU                          .SPACE;                                                                         MNOZPP:  RMNOZ = MNOZ;                 ULOZ MNOZSTVI DO DEKADICKEHO REG.                 IFD RMNOZ LE LIMIT GOTO MNOZOK; SKOC, VYHOVUJE-LI LIMITU                        SON (MNOZPR);                 PROVEDENI CHYBOVE NAPOVEDI                        GOTO KRTN;                    POZADEJ OPERATORA O NAPRAVU              .SPACE;                                                                         MNOZL:   IFC RIZNAK IS C'Z' SKIP;      PRESKOC, JE-LI 'ZNOVA'                            GOTO MNOZOK;                  JE-LI ODPOVED 'PRIJMI',POKRACUJ                   ENABLE;                       UVOLNENI PRERUSENI KLAVESNICE                     RESUME (B);                   POLE ZPET NA ZACATEK MNOZSTVI                     KEYOP (X'11',K22);                                                              GOTO KRTN;                    ZPET DO FORMATU                          .SPACE;                                                                         MNOZOK:  SOFF (MNOZPR);                VYNECHANI CHYBOVE NAPOVEDI                        GOTO KRTN;                    POKRACUJ ZADANIM CENY                    .SPACE;                                                                         CENAPP:  RCENA = CENA;                 DEJ CENU DO DEKADICKEHO REGISTRU                  PRDR1 = RMNOZ * RCENA;        NASOBENI CENA * MNOZSTVI                          CELKEM = PRDR1;               ULOZENI DO PAMETI DAT (VVOBL)                     REPFLD;                       UMISTENI NA OBRAZOVKU                             GOTO KRTN;                    POKRACOVANI FORMATU                      .SPACE;                                                                         VNST7:   ;                             7 - BLOK ZPET                                     IFC RIZNAK IS C'D' SKIP;      PRESKOC,JE-LI ZAZNAM POLOZKA OBJ.                 KEYOP (X'11',K29);            SMAZ OBRAZOVKU (PREDCHOZI OBJED.)                 READ (OBJED,,-);              CTI PREDCHAZEJICI ZAZNAM                          SOFF (EODPR, TISKPR);         NASTAV AKTUALIZACI,ZASTAV TISK                    PRBR1 = REZIMK;               VEZMI SLABIKU REZIMU KLAVESNICE                   PRBR1 &= X'0F';               VYMAZ BITY REZIMU,OSTATNI NE                      PRBR1 V= X'40';               NASTAV REZIM AKTUALIZACE                          REZIMK = PRBR1;               ULOZ REZIM AKTUALIZACE                            ENABLE (ROZDEL,POP);          URCI,JE-LI HLAVICKA NEBO POLOZKA         .SPACE;                                                                         VNST5:   ;                             5 - PRECHOD PRES RG ZPATKY               VNST6:   ;                             6 - BLOK KROK                            KRTN:    IFC POVELKL NOT X'00' SKIP;   SKOC NENI-LI ENTR DODELAN                         RETEXT;                       ENABLE, RETURN                                    RESMXT;                       RESUME, ENABLE, RETURN                   .SPACE NUMB=3;                                                                  .END;