API tools faq
paste
Advertisement
jelledebock

Insert in DB

jelledebock
Nov 26th, 2014
778
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 7.61 KB | None | 0 0
raw download clone embed print report
  1.  000001        IDENTIFICATION DIVISION.
  2.  000002        PROGRAM-ID. SEQINS.
  3.  000003        ENVIRONMENT DIVISION.
  4.  000004        INPUT-OUTPUT SECTION.
  5.  000005        FILE-CONTROL.
  6.  000006            SELECT INFILE ASSIGN TO RECSIN.
  7.  000007        DATA DIVISION.
  8.  000008        FILE SECTION.
  9.  000009        FD INFILE.
  10.  000010        01 INREC PIC X(80).
  11.  000011
  12.  000012        WORKING-STORAGE SECTION.
  13.  000013            EXEC SQL
  14.  000014                 INCLUDE BEDG
  15.  000015       *        INCLUDE BEDTYPG
  16.  000016       *        INCLUDE ROOMG
  17.  000017            END-EXEC
  18.  000018            EXEC SQL
  19.  000019       *        INCLUDE BEDG
  20.  000020                 INCLUDE BEDTYPG
  21.  000021       *        INCLUDE ROOMG
  22.  000022            END-EXEC
  23.  000023            EXEC SQL
  24.  000024       *        INCLUDE BEDG
  25.  000025       *        INCLUDE BEDTYPG
  26.  000026                 INCLUDE ROOMG
  27.  000027            END-EXEC
  28.  000028            EXEC SQL
  29.  000029                 INCLUDE SQLCA
  30.  000030            END-EXEC
  31.  000031        01 WS-VARS.
  32.  000032             02 NUMTRUN   PIC X(50).
  33.  000033             02 ALPHANUM  PIC X(8).
  34.  000034             02 ALPHANUM2 PIC X(8).
  35.  000035             02 ALPHANUM3 PIC X(8).
  36.  000036             02 ALPHANUM4 PIC X(8).
  37.  000037             02 BUFNUM    PIC X(8).
  38.  000038             02 STRINGF   PIC X(50).
  39.  000039             02 BEDV      PIC X(50) VALUE "BED".
  40.  000040             02 BEDTYPEV  PIC X(50) VALUE "BED-TYPE".
  41.  000041             02 ROOMV     PIC X(50) VALUE "ROOM".
  42.  000042        01 F-CTR       PIC 9(1).
  43.  000043             88 EOF    VALUE 1.
  44.  000044        01 L-CTR       PIC 9(1).
  45.  000045             88 BLLINE VALUE 1.
  46.  000046             88 NBL VALUE 0.
  47.  000047        01 EMPLINE PIC X(50) VALUE SPACES.
  48.  000048
  49.  000049        PROCEDURE DIVISION.
  50.  000050        MAIN.
  51.  000051             OPEN INPUT INFILE
  52.  000052             READ INFILE
  53.  000053                  AT END SET EOF TO TRUE
  54.  000054             END-READ
  55.  000055             PERFORM UNTIL EOF
  56.  000056               DISPLAY INREC
  57.  000057               MOVE INREC TO NUMTRUN
  58.  000058               DISPLAY NUMTRUN
  59.  000059               EVALUATE TRUE
  60.  000060                 WHEN BEDV =  NUMTRUN
  61.  000061                    PERFORM BED
  62.  000062                 WHEN BEDTYPEV = NUMTRUN
  63.  000063                    PERFORM BEDTP
  64.  000064                 WHEN ROOMV = NUMTRUN
  65.  000065                    PERFORM ROOM
  66.  000066                 WHEN OTHER
  67.  000067                    DISPLAY "INVALID CODE ENTERED"
  68.  000068                    STOP RUN
  69.  000069                END-EVALUATE
  70.  000070             END-PERFORM
  71.  000071             CLOSE INFILE
  72.  000072             STOP RUN
  73.  000073             .
  74.  000074        BED.
  75.  000075            DISPLAY "IN LOOP BED"
  76.  000076            SET NBL TO TRUE
  77.  000077            READ INFILE
  78.  000078                 AT END SET EOF TO TRUE
  79.  000079            END-READ
  80.  000080            PERFORM UNTIL EOF OR BLLINE
  81.  000081               MOVE INREC TO NUMTRUN
  82.  000082               IF NUMTRUN EQUAL TO EMPLINE THEN
  83.  000083                 SET BLLINE TO TRUE
  84.  000084               ELSE
  85.  000085                 UNSTRING INREC DELIMITED BY "," INTO
  86.  000086                   ALPHANUM ALPHANUM2 ALPHANUM3 ALPHANUM4
  87.  000087                 COMPUTE BBED-NUMBER = FUNCTION NUMVAL(ALPHANUM)
  88.  000088                 COMPUTE BBED-AVAILABILITY =
  89.  000089                   FUNCTION NUMVAL(ALPHANUM2)
  90.  000090                 COMPUTE BROOM-ID = FUNCTION NUMVAL(ALPHANUM3)
  91.  000091                 COMPUTE BBED-TYPE-ID = FUNCTION NUMVAL(ALPHANUM4)
  92.  000092                 DISPLAY BBED-NUMBER ":" BBED-AVAILABILITY
  93.  000093                   ":" BROOM-ID ":" BBED-TYPE-ID
  94.  000094                 DISPLAY ALPHANUM4
  95.  000095                 EXEC SQL
  96.  000096                   INSERT INTO HOG0009.BED VALUES (:BBED-NUMBER,
  97.  000097                   :BBED-AVAILABILITY, :BROOM-ID,
  98.  000098                    :BBED-TYPE-ID)
  99.  000099                 END-EXEC
  100.  000100                 PERFORM SQLDEB
  101.  000101                 EXEC SQL
  102.  000102                   COMMIT
  103.  000103                 END-EXEC
  104.  000104                 PERFORM SQLDEB
  105.  000105               END-IF
  106.  000106               READ INFILE
  107.  000107                 AT END SET EOF TO TRUE
  108.  000108               END-READ
  109.  000109            END-PERFORM
  110.  000110            .
  111.  000111        BEDTP.
  112.  000112            SET NBL TO TRUE
  113.  000113            DISPLAY "IN LOOP BEDTYPE"
  114.  000114            READ INFILE
  115.  000115                 AT END SET EOF TO TRUE
  116.  000116            END-READ
  117.  000117            PERFORM UNTIL EOF OR BLLINE
  118.  000118               MOVE INREC TO NUMTRUN
  119.  000119               IF NUMTRUN EQUAL TO EMPLINE THEN
  120.  000120                 SET BLLINE TO TRUE
  121.  000121               ELSE
  122.  000122                 UNSTRING INREC DELIMITED BY "," INTO
  123.  000123                   ALPHANUM
  124.  000124                   BTBED-DESCRIPTION-TEXT
  125.  000125                 MOVE 50 TO BTBED-DESCRIPTION-LEN
  126.  000126                 COMPUTE BTBED-TYPE-ID = FUNCTION NUMVAL-C(ALPHANUM)
  127.  000127                 DISPLAY BTBED-TYPE-ID ":" BTBED-DESCRIPTION
  128.  000128                 EXEC SQL
  129.  000129                   INSERT INTO HOG0009.BED_TYPE VALUES
  130.  000130                   (:BTBED-TYPE-ID,
  131.  000131                   :BTBED-DESCRIPTION)
  132.  000132                 END-EXEC
  133.  000133                 PERFORM SQLDEB
  134.  000134                 EXEC SQL
  135.  000135                   COMMIT
  136.  000136                 END-EXEC
  137.  000137                 PERFORM SQLDEB
  138.  000138               END-IF
  139.  000139               READ INFILE
  140.  000140                 AT END SET EOF TO TRUE
  141.  000141               END-READ
  142.  000142            END-PERFORM
  143.  000143            .
  144.  000144        ROOM.
  145.  000145            DISPLAY "IN LOOP ROOM"
  146.  000146            SET NBL TO TRUE
  147.  000147            READ INFILE
  148.  000148                 AT END SET EOF TO TRUE
  149.  000149            END-READ
  150.  000150            PERFORM UNTIL EOF OR BLLINE
  151.  000151               MOVE INREC TO NUMTRUN
  152.  000152               IF NUMTRUN EQUAL TO EMPLINE THEN
  153.  000153                 SET BLLINE TO TRUE
  154.  000154               ELSE
  155.  000155                 UNSTRING INREC DELIMITED BY "," INTO
  156.  000156                   ALPHANUM
  157.  000157                   STRINGF
  158.  000158                 COMPUTE RROOM-ID = FUNCTION NUMVAL(ALPHANUM)
  159.  000159                 MOVE STRINGF TO RROOM-DESCRIPTION-TEXT
  160.  000160                 MOVE 50 TO RROOM-DESCRIPTION-LEN
  161.  000161                 DISPLAY RROOM-ID ":" RROOM-DESCRIPTION
  162.  000162                 EXEC SQL
  163.  000163                   INSERT INTO HOG0009.ROOM VALUES
  164.  000164                   (:RROOM-ID,
  165.  000165                   :RROOM-DESCRIPTION)
  166.  000166                 END-EXEC
  167.  000167                 PERFORM SQLDEB
  168.  000168                 EXEC SQL
  169.  000169                   COMMIT
  170.  000170                 END-EXEC
  171.  000171                 PERFORM SQLDEB
  172.  000172               END-IF
  173.  000173               READ INFILE
  174.  000174                 AT END SET EOF TO TRUE
  175.  000174                 AT END SET EOF TO TRUE
  176.  000175               END-READ
  177.  000176            END-PERFORM
  178.  000177            .
  179.  000178         SQLDEB.
  180.  000179            DISPLAY "SQLCODE: " SQLCODE
  181.  000180            DISPLAY "REASON:  " SQLERRMC
  182.  000181            DISPLAY "WARING:  " SQLWARN
  183.  000182            EVALUATE SQLCODE
  184.  000183              WHEN 0
  185.  000184                DISPLAY 'SUCCESFULL'
  186.  000185              WHEN +100
  187.  000186                DISPLAY 'CANNOT FIND ROW'
  188.  000187              WHEN OTHER
  189.  000188                DISPLAY 'UNKNOWN ERROR'
  190.  000189            END-EVALUATE
  191.  000190            .
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!