PARTEX1: PROC OPTIONS(MAIN);

     DCL PTS_ARRAY(3) FIXED BIN(31);
     DCL PTN_ARRAY(4) FIXED BIN(31);
     DCL (CUR_PTN(1),BAD_PTN) FIXED BIN(31);
     DCL CHAR936 CHAR(936);
     DCL FILE_NO CHAR(3);
     DCL ERROR_FLAG CHAR(1) INIT('0');
     DCL I PIC'ZZ9';
     DCL (TYPE,ATVAL,COUNT) FIXED BIN(31);

     CALL FSINIT;


     /* Define partition set grid                                  */
     PTS_ARRAY(1)=5;                 /* 5 rows in partition set    */    A
     PTS_ARRAY(2)=1;                 /* 1 col  in partition set    */    A
     PTS_ARRAY(3)=0;                 /* Real partitions if possible*/    A
     /*      P-SET ID   NO. OF PARMS    PARAMETER ARRAY            */
     CALL PTSCRT(1,        3,             PTS_ARRAY);                    B


     /* Create partition at top of screen                          */
     PTN_ARRAY(1)=1;         /* Starts in row 1 (of 5-row PTN-SET) */    C
     PTN_ARRAY(2)=1;         /* Starts in col 1 (of 1-col PTN-SET) */    C
     PTN_ARRAY(3)=2;                 /* Depth is 2 rows            */    C
     PTN_ARRAY(4)=1;                 /* Width is 1 column          */    C
     /*       PTN ID    NO. OF PARMS   PARAMETER ARRAY             */
     CALL PTNCRT(1,          4,           PTN_ARRAY);                    D


     /* Create display in top partition                            */
     CALL CREATE_FIELDS;
     CALL ASCPUT(1,32,'DATA ENTRY PROGRAM.  PARTITION 1');


     /* Create partition in bottom of screen                       */
     PTN_ARRAY(1)=4;         /* Starts in row 4 (of 5-row PTN-SET) */    E
     CALL PTNCRT(2,      4,       PTN_ARRAY);                            F
     /* Create display in bottom partition                         */
     CALL CREATE_FIELDS;
     CALL ASCPUT(1,32,'DATA ENTRY PROGRAM.  PARTITION 2');


     /* Dialog with operator                                       */
     DO I=1 TO 999 UNTIL (ATVAL=3);
       RETRY:;
       CALL ASFCUR(4,1,1);
       CALL ASREAD(TYPE,ATVAL,COUNT);  /* Read from 'active' partn.  */  G
       CALL PTNQRY(1,1,CUR_PTN);    /* Which partn. was 'active'? */     H


       /* If input not from partn. that was bad, re-prompt operator*/
       IF (ERROR_FLAG='1')&(CUR_PTN(1)=BAD_PTN) THEN DO;                J
         CALL PTNSEL(BAD_PTN);         /* Make bad partition current */  K
         CALL ASCPUT(2,46,
                   'PLEASE CORRECT INPUT FROM THIS PARTITION FIRST');
         GOTO RETRY;
       END;


       /* Check input                                              */
       ERROR_FLAG='0';
       CALL INPUT_PROCESS;                                               M
       IF ERROR_FLAG='1' THEN DO;    /* Input was faulty           */
         BAD_PTN=CUR_PTN(1);         /* Record id. of faulty partn.*/    N
         CALL ASCPUT(2,48,
                'INPUT FAULTY FROM THIS PARTITION. PLEASE CORRECT');
         CALL PTNSEL(-1);  /* Force current partition to be active */    O
       END;
       ELSE CALL ASCPUT(2,34,'INPUT '||I||' PROCESSED SATISFACTORILY');
     END;
     CALL FSTERM;


     /* Subroutine to create the input menu for each partition     */

     CREATE_FIELDS: PROC;
     CALL FSPCRT(1,20,110,0);
     CALL GSPAT(1);
     CALL GSAREA(1);
     CALL GSLINE(100.0,0.0);
     CALL GSLINE(100.0,100.0);
     CALL GSLINE(0.0,100.0);
     CALL GSENDA;


     CALL ASDFLD(1,1,34,1,32,2);     /* Protected 32-char field    */
     CALL ASFCOL(1,1);               /* .. with a color of blue    */
     CALL ASDFLD(2,3,26,1,48,2);     /* Protected 48-char blue fld.*/
     CALL ASFCOL(2,2);               /* Message field is red       */
     CALL ASDFLD(3,5,20,1,15,2);
     CALL ASCPUT(3,15,'FILE NUMBER IS=');
     CALL ASDFLD(4,5,36,1,3,0);
     CALL ASDFLD(5,7,17,12,78,0);    /* Unprotected field 12 X 78  */
     END CREATE_FIELDS;


     /* Subroutine to check and process operator input             */

     INPUT_PROCESS: PROC;
     CALL ASCGET(4,3,FILE_NO);
     IF (FILE_NO<'200')|(FILE_NO>'490') THEN ERROR_FLAG='1';
     ELSE DO;
       CALL ASCGET(5,936,CHAR936);

       /*  .                            Code to copy               */
       /*  .                            operator's input           */
       /*  .                            data to disk file          */

       CALL ASCPUT(4,3,'   ');       /* Reset file number to empty */
     END;
     END INPUT_PROCESS;


     %INCLUDE ADMUPINA;
     %INCLUDE ADMUPINF;
     %INCLUDE ADMUPING;
     %INCLUDE ADMUPINP;

     END PARTEX1;




   Figure 120. Example of a program using partitions to control data entry

Subtopics:

• 22.1.1.1 Setting up a grid in which to define partitions
• 22.1.1.2 Creating partitions
• 22.1.1.3 Current partition sets, partitions, and pages
• 22.1.1.4 Input/Output
• 22.1.1.5 Active and current partitions
• 22.1.1.6 Handling terminal-user errors