Example 1 Creating a New Document in a Database

Visual LANSA

Example 1: Creating a New Document in a Database

    ********** Beginning of RDML commands **********         

    FUNCTION   OPTIONS(*DIRECT)                              

    DEFINE     FIELD(#DATABASE) TYPE(*CHAR) LENGTH(50)

               INPUT_ATR(LC)

               DEFAULT('''BIFTEST''')                        

    DEFINE     FIELD(#SERVER) TYPE(*CHAR) LENGTH(50) INPUT_ATR(LC)

    DEFINE     FIELD(#RETCODE) TYPE(*CHAR) LENGTH(2)         

    DEFINE     FIELD(#DBHANDLE) TYPE(*CHAR) LENGTH(4)        

    DEFINE     FIELD(#DOCHANDLE) TYPE(*CHAR) LENGTH(4)       

    DEFINE     FIELD(#ITEMNAME) TYPE(*CHAR) LENGTH(20)       

    DEFINE     FIELD(#ITEMTYPE) TYPE(*DEC) LENGTH(1) DECIMALS(0)

    DEFINE     FIELD(#INVCODE) TYPE(*CHAR) LENGTH(10)        

    DEFINE     FIELD(#INVAMT) TYPE(*DEC) LENGTH(15) DECIMALS(2)

               EDIT_CODE(3)                                  

    DEFINE     FIELD(#INVDATE) TYPE(*CHAR) LENGTH(20)

               INPUT_ATR(LC) 

    DEFINE     FIELD(#DUMMY) TYPE(*CHAR) LENGTH(1)           

    REQUEST    FIELDS((#DATABASE *L5 *P2) (#SERVER *L9 *P2))

               DESIGN(*DOWN) IDENTIFY(*LABEL) DOWN_SEP(001)

               ACROSS_SEP(001)

    ********** Open the database                                

    USE        BUILTIN(DOM_OPEN_DATABASE) WITH_ARGS(#DATABASE

               #DUMMY #SERVER) TO_GET(#RETCODE #DBHANDLE)     

    IF         COND('#RETCODE *NE ''OK''')                   

    MENU                                                     

    ENDIF                                                    

    ********** Add new documents to database                 

    BEGIN_LOOP       

    REQUEST    FIELDS((#INVCODE *L3 *P2) (#INVAMT *L5 *P2) 

               (#INVDATE *L7 *P2)) DESIGN(*DOWN) IDENTIFY(*LABEL) 

               DOWN_SEP(001) ACROSS_SEP(001) EXIT_KEY(*YES L1) 

                MENU_KEY(*YES L1)    

    ********** Create a new document in the database         

    USE        BUILTIN(DOM_CREATE_DOCUMENT) WITH_ARGS(#DBHANDLE) 

               TO_GET(#RETCODE #DOCHANDLE)                   

    IF         COND('#RETCODE *NE ''OK''')                   

    GOTO       LABEL(L1)                                     

    ENDIF                                                    

    ********** Add data items to the document                

    CHANGE     FIELD(#ITEMNAME) TO(INVCODE)                  

    CHANGE     FIELD(#ITEMTYPE) TO(2)                        

    USE        BUILTIN(DOM_ADD_ITEM) WITH_ARGS(#DOCHANDLE 

               #ITEMNAME #ITEMTYPE #INVCODE) 

               TO_GET(#RETCODE)  

    IF         COND('#RETCODE *NE ''OK''')                   

    GOTO       LABEL(L1)                                     

    ENDIF                                                    

    CHANGE     FIELD(#ITEMNAME) TO(INVAMT)                   

    CHANGE     FIELD(#ITEMTYPE) TO(1)                        

    USE        BUILTIN(DOM_ADD_ITEM) WITH_ARGS(#DOCHANDLE 

               #ITEMNAME #ITEMTYPE #DUMMY #INVAMT) 

               TO_GET(#RETCODE)

    IF         COND('#RETCODE *NE ''OK''')                   

    GOTO       LABEL(L1)                                     

    ENDIF                                                    

    CHANGE     FIELD(#ITEMNAME) TO(INVDATE)                  

    CHANGE     FIELD(#ITEMTYPE) TO(3)                        

    USE        BUILTIN(DOM_ADD_ITEM) WITH_ARGS(#DOCHANDLE 

               #ITEMNAME #ITEMTYPE #INVDATE) TO_GET(#RETCODE) 

    IF         COND('#RETCODE *NE ''OK''')                   

    GOTO       LABEL(L1)                                     

    ENDIF                                                    

    ********** Update the new document in the database       

    USE        BUILTIN(DOM_UPDATE_DOCUMENT) WITH_ARGS(#DOCHANDLE) 

               TO_GET(#RETCODE)                              

    IF         COND('#RETCODE *NE ''OK''')                   

    GOTO       LABEL(L1)                                     

    ELSE                                                     

    MESSAGE    MSGTXT('New document added to BIF Test Database')

    ENDIF                                                    

    ********** Close the document to release memory          

    USE        BUILTIN(DOM_CLOSE_DOCUMENT) WITH_ARGS(#DOCHANDLE)

               TO_GET(#RETCODE)                              

    IF         COND('#RETCODE *NE ''OK''')                   

    GOTO       LABEL(L1)                                     

    ENDIF                                                    

    END_LOOP                                                 

    ********** Close the database upon exit or an error      

L1  USE        BUILTIN(DOM_CLOSE_DATABASE) WITH_ARGS(#DBHANDLE) 

               TO_GET(#RETCODE)                              

    ********** End of RDML commands **********