tiptop erp 一份出厂测试报告程序部分的代码

 

一个CR报表csfr010作业的4gl代码，程序是用在了genero中输出一份出厂测试报告的4gl代码

# Prog. Version..: '5.10.08-09.06.11(00009)'     #
# Pattern name...: csfr010.4gl
# Descriptions...: test
# Date & Author..: 111223 By  
DATABASE ds

GLOBALS "../../../tiptop/config/top.global"

   DEFINE tm  RECORD
              wc      STRING,           # Where condition
	      #oeb01   LIKE oeb_file.oeb01,因字段长度不够，改为下边的声明
              oeb01   LIKE type_file.chr1000,
	      type    LIKE type_file.chr1,
              dat     LIKE oga_file.oga02,   # Prog. Version..: '5.10.08-09.06.11(01)             
              more    LIKE type_file.chr1000 # Prog. Version..: '5.10.08-09.06.11(01)               # Input more condition(Y/N)
              END RECORD

DEFINE    l_table     STRING,                 
          g_str       STRING,                 
          g_sql       STRING                  
DEFINE g_type         LIKE type_file.chr2           #add by chenyu --100319

MAIN
   OPTIONS
       FORM LINE     FIRST + 2,
       MESSAGE LINE  LAST,
       PROMPT LINE   LAST,
       INPUT NO WRAP
   DEFER INTERRUPT                        # Supress DEL key function

   IF (NOT cl_user()) THEN
      EXIT PROGRAM
   END IF
 
   WHENEVER ERROR CALL cl_err_msg_log
 
   IF (NOT cl_setup("CSF")) THEN
      EXIT PROGRAM
   END IF
   CALL cl_used(g_prog,g_time,1) RETURNING g_time #No.FUN-690126

   ## *** 與 Crystal Reports 串聯段 - <<<< 產生Temp Table >>>> ##
   LET g_sql =  " oeb01.oeb_file.oeb01,",
                " oeb03.oeb_file.oeb03,",
                " oeb04.oeb_file.oeb04,",
                " oeb06.oeb_file.oeb06,",
                " num1.oeb_file.oeb12 "

   LET l_table = cl_prt_temptable('csfr010',g_sql) CLIPPED   # 產生Temp Table
   IF l_table = -1 THEN EXIT PROGRAM END IF                  # Temp Table產生
   LET g_sql = "INSERT INTO ds_report.",l_table CLIPPED,
               " VALUES(?, ?, ?, ?, ? )"

   PREPARE insert_prep FROM g_sql
   IF STATUS THEN
      CALL cl_err('insert_prep:',status,1) EXIT PROGRAM
   END IF
   #----------------------------------------------------------CR (1) ------------#

   INITIALIZE tm.* TO NULL            # Default condition
   LET g_pdate  = ARG_VAL(1)	             # Get arguments from command line
   LET g_towhom = ARG_VAL(2)
   LET g_rlang  = ARG_VAL(3)
   LET g_bgjob  = ARG_VAL(4)
   LET g_prtway = ARG_VAL(5)
   LET g_copies = ARG_VAL(6)
   LET tm.wc = ARG_VAL(7)
   LET tm.dat  = ARG_VAL(8)
   LET g_rep_user = ARG_VAL(9)
   LET g_rep_clas = ARG_VAL(10)
   LET g_template = ARG_VAL(11)
   LET g_rpt_name = ARG_VAL(12) 
   LET g_type     = ARG_VAL(13)   #add by chenyu --100322 

   IF cl_null(g_bgjob) THEN LET g_bgjob = 'N' END IF   #add by chenyu --100322

   IF cl_null(tm.wc)
      THEN CALL csfr010_tm(0,0)             
   ELSE
      CALL csfr010()   
   END IF
   CALL cl_used(g_prog,g_time,2) RETURNING g_time 
END MAIN

FUNCTION csfr010_tm(p_row,p_col)
   DEFINE lc_qbe_sn      LIKE gbm_file.gbm01   
   DEFINE p_row,p_col    LIKE type_file.num5,       
          l_cmd          LIKE type_file.chr1000       

   LET p_row = 5 LET p_col = 17

   OPEN WINDOW csfr010_w AT p_row,p_col WITH FORM "csf/42f/csfr010"
       ATTRIBUTE (STYLE = g_win_style CLIPPED) 
 
   CALL cl_ui_init()

   LET tm.type = '1'
   LET tm.dat = g_today
   LET g_pdate = g_today
   LET g_rlang = g_lang
   LET g_bgjob = 'N'
   LET g_copies = '1'
      
   CALL cl_opmsg('p')
WHILE TRUE
   CONSTRUCT BY NAME tm.oeb01 ON oeb01
   #END CONSTRUCT
   #INPUT BY NAME tm.oeb01 WITHOUT DEFAULTS
      BEFORE CONSTRUCT
          CALL cl_qbe_display_condition(lc_qbe_sn)
      
      ON ACTION CONTROLZ
         CALL cl_show_req_fields()
      ON ACTION CONTROLG 
         CALL cl_cmdask()    # Command execution
      ON IDLE g_idle_seconds
         CALL cl_on_idle()
         CONTINUE CONSTRUCT
 
      ON ACTION about        
         CALL cl_about()     
 
      ON ACTION help          
         CALL cl_show_help()  
 
      ON ACTION exit
         LET INT_FLAG = 1
         EXIT CONSTRUCT

      ON ACTION qbe_save
         CALL cl_qbe_save()
       ON ACTION controlp
           IF INFIELD(oeb01) THEN
              CALL cl_init_qry_var()
              LET g_qryparam.form = "q_oeb12"
              LET g_qryparam.state = "c"
              CALL cl_create_qry() RETURNING g_qryparam.multiret
              DISPLAY g_qryparam.multiret TO oeb01
              NEXT FIELD oeb01
           END IF    

   END CONSTRUCT
   IF INT_FLAG THEN
      LET INT_FLAG = 0 CLOSE WINDOW csfr010_w 
      CALL cl_used(g_prog,g_time,2) RETURNING g_time 
      EXIT PROGRAM
   END IF

   IF g_bgjob = 'Y' THEN
      SELECT zz08 INTO l_cmd FROM zz_file    #get exec cmd (fglgo xxxx)
             WHERE zz01='csfr010'
      IF SQLCA.sqlcode OR l_cmd IS NULL THEN
         CALL cl_err('csfr010','9031',1)
      ELSE
         LET tm.wc=cl_replace_str(tm.wc, "'", "\"")#"
         LET l_cmd = l_cmd CLIPPED,        #(at time fglgo xxxx p1 p2 p3)
                         " '",g_pdate CLIPPED,"'",
                         " '",g_towhom CLIPPED,"'",
                         " '",g_rlang CLIPPED,"'", 
                         " '",g_bgjob CLIPPED,"'",
                         " '",g_prtway CLIPPED,"'",
                         " '",g_copies CLIPPED,"'",
                         " '",tm.wc CLIPPED,"'" ,
                         " '",tm.dat CLIPPED,"'" ,
                         " '",g_rep_user CLIPPED,"'",           
                         " '",g_rep_clas CLIPPED,"'",           
                         " '",g_template CLIPPED,"'",          
                         " '",g_rpt_name CLIPPED,"'"           
         CALL cl_cmdat('csfr010',g_time,l_cmd)    # Execute cmd at later time
      END IF
      CLOSE WINDOW csfr010_w
      CALL cl_used(g_prog,g_time,2) RETURNING g_time 
      EXIT PROGRAM
   END IF
   CALL cl_wait()
   CALL csfr010()
   ERROR ""
END WHILE
   CLOSE WINDOW csfr010_w
END FUNCTION

FUNCTION csfr010()
   DEFINE l_name    LIKE type_file.chr20,
          l_sql     LIKE type_file.chr1000,       
          l_exrate  LIKE azk_file.azk03,
          sr        RECORD
                    oeb01     LIKE oeb_file.oeb01,
                    oeb03     LIKE oeb_file.oeb03,
                    oeb04     LIKE oeb_file.oeb04,
                    oeb06     LIKE oeb_file.oeb06,
                    num1      LIKE oeb_file.oeb12		    
                    END RECORD
DEFINE  l_geb01     LIKE geb_file.geb01
DEFINE  l_occ01     LIKE occ_file.occ01
DEFINE  l_occ02     LIKE occ_file.occ02
DEFINE  l_occ33     LIKE occ_file.occ33
DEFINE  l_occ63     LIKE occ_file.occ63
DEFINE  l_tot2      LIKE occ_file.occ63
DEFINE  g_occ63     LIKE occ_file.occ63
DEFINE  l_cnt       LIKE type_file.num5

   LET tm.oeb01=tm.oeb01
   ## *** 與 Crystal Reports 串聯段 - <<<< 清除暫存資料 >>>>
   CALL cl_del_data(l_table)
   #------------------------------ CR (2) ------------------------------#

   SELECT zo02 INTO g_company FROM zo_file WHERE zo01 = g_rlang
   SELECT zz05 INTO g_zz05 FROM zz_file WHERE zz01 = g_prog   
#   FOR g_i = 1 TO g_len LET g_dash[g_i,g_i] = '=' END FOR
  
   IF g_priv2='4' THEN                   #只能使用自己的資料
       LET tm.wc = tm.wc CLIPPED," AND occuser = '",g_user,"'"
   END IF
   IF g_priv3='4' THEN                   #只能使用相同群的資料
       LET tm.wc = tm.wc clipped," AND occgrup MATCHES '",g_grup CLIPPED,"*'"
   END IF
   IF g_priv3 MATCHES "[5678]" THEN    #TQC-5C0134群組權限
       LET tm.wc = tm.wc clipped," AND occgrup IN ",cl_chk_tgrup_list()
   END IF

 
   LET l_sql = "SELECT oeb01,oeb03,oeb04,oeb06,1 ",
               "  FROM ds01.oeb_file a,(SELECT rownum rn FROM ",
	       " (SELECT max(oeb12) max_rec FROM ds01.oeb_file ",
	       "   WHERE ",tm.oeb01,  # 'SMSXX-2211070130' ",
               "  ) connect by level <= max_rec) b WHERE a.oeb12>=rn ",
	       " AND ",tm.oeb01,      # 'SMSXX-2211070130' ",
	       " ORDER BY oeb03 "

   
   PREPARE csfr010_prepare FROM l_sql
   IF SQLCA.sqlcode THEN
      CALL cl_err('prepare:',SQLCA.sqlcode,1)
      CALL cl_used(g_prog,g_time,2) RETURNING g_time
      EXIT PROGRAM
   END IF
   DECLARE csfr010_curs CURSOR FOR csfr010_prepare


   FOREACH csfr010_curs INTO sr.*
      
      EXECUTE insert_prep USING sr.* 
      INITIALIZE sr.*  TO NULL

   END FOREACH

   ## **** 與 Crystal Reports 串聯段 - <<<< CALL cs3() >>>>  **** ##
   LET l_sql = "SELECT * FROM ",g_cr_db_str CLIPPED,l_table CLIPPED  

   #是否列印選擇條件
   IF g_zz05 = 'Y' THEN
      CALL cl_wcchp(tm.wc,'geb01') 
           RETURNING tm.wc
      LET g_str = tm.wc
   END IF        

   CALL cl_prt_cs3('csfr010','csfr010',l_sql,g_str)  



END FUNCTION

4fd文件

<?xml version="1.0" encoding="UTF-8" ?>
<Form width="54" lstrtoalltitle="false" lstrtoallitem="false" database_name="ds" spacing="normal" CHECKSUM="-1" posX="0" posY="0" height="6" percommentheader="" percommentinstruction="" percommentattribute="" lstrtoallcomment="false" percommentschema="" name="csfr010" fourSTFile="" defaultspacing="true" text="csfr010" percommentlayout="GRID
GRID
GROUP
GRID
VBOX
LAYOUT
" lstrtoalltext="false" gstVersion="11401" browserStatus="true" >
 <Grid width="50" posX="3" posY="0" height="4" lstrcomment="false" hidden="--------" name="gr8224" fontPitch="default" scroll="false" >
  <Group width="48" lstrtext="false" gridWidth="49" posX="0" posY="0" height="3" lstrcomment="false" hidden="--------" name="group01" fontPitch="default" text="QBE" gridHeight="5" gridChildrenInParent="--------" >
   <Text width="5" lstrtext="false" gridWidth="16" posX="1" posY="1" height="1" sizePolicy="initial" name="text27968" text="oeb01" />
   <FormField sqlDBName="formonly" colName="oeb01" sqlTabName="formonly" fieldId="0" name="oeb01" fieldtype="FORM_ONLY" >
    <ButtonEdit width="20" case="NONE" justify="none" invisible="--------" notNull="--------" posX="23" image="zoom" posY="1" height="1" formfieldname="formfield0" action="controlp" lstrcomment="false" length="10" autoNext="--------" colorCondition="black" verify="--------" imagetype="Image as URL" hidden="--------" tabIndex="1" sizePolicy="initial" reverse="--------" name="oeb01" data_type="VARCHAR" fontPitch="default" color="black" century="R" scroll="--------" required="--------" noEntry="--------" />
   </FormField>
  </Group>
 </Grid>
</Form>