# Prog. Version..: '5.00.03-07.09.05(00004)' #
# Pattern name...: cimp901.4gl
# Descriptions...: ???辣銝餅?/BOM銝餅??蔥?芷雿平
# Date & Author..: 10/12/28 By Jeffrey Hu
DATABASE ds
GLOBALS "../../../tiptop/config/top.global"
#TQC-6B0191
DEFINE tm RECORD
wc STRING,
moddate LIKE type_file.dat, #No.FUN-680137 DATE
userid LIKE type_file.chr10,
type LIKE type_file.chr1
END RECORD,
g_change_lang LIKE type_file.chr1 #?臬??隤???
DEFINE g_sql STRING
MAIN
DEFINE l_flag LIKE type_file.num5
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("CIM")) THEN
EXIT PROGRAM
END IF
IF cl_null(g_bgjob) THEN
LET g_bgjob = "N"
END IF
CALL cl_used(g_prog,g_time,1) RETURNING g_time
ERROR ""
LET g_success = 'Y'
WHILE TRUE
IF g_bgjob = "N" THEN
CALL p001_tm() # ?恍璇辣頛詨 ?批
IF cl_sure(18,20) THEN
BEGIN WORK
LET g_success = 'Y'
CALL exec_sp() # 鞈???蝔?
CALL s_showmsg() #No.FUN-710025
IF g_success = 'Y' THEN
COMMIT WORK
MESSAGE('?祆活?瑁?雿平蝯?==> 撌唇???')
CALL cl_end2(1) RETURNING l_flag
ELSE
ROLLBACK WORK
MESSAGE('?祆活?瑁?雿平蝯?==> ?∩遙雿????')
CALL cl_end2(2) RETURNING l_flag
END IF
IF l_flag THEN
CONTINUE WHILE
ELSE
CLOSE WINDOW p001_w
EXIT WHILE
END IF
ELSE
CONTINUE WHILE
END IF
CLOSE WINDOW p001_w
ELSE
BEGIN WORK
LET g_success = 'Y'
CALL exec_sp()
CALL s_showmsg() #No.FUN-710025
IF g_success = "Y" THEN
COMMIT WORK
MESSAGE('?祆活?瑁?雿平蝯?==> 撌唇???')
ELSE
ROLLBACK WORK
MESSAGE('?祆活?瑁?雿平蝯?==> ?∩遙雿????')
END IF
EXIT WHILE
MESSAGE('')
END IF
MESSAGE('')
END WHILE
CALL cl_used(g_prog,g_time,2) RETURNING g_time
END MAIN
FUNCTION p001_tm()
DEFINE p_row,p_col LIKE type_file.num5
DEFINE lc_cmd LIKE type_file.chr1000
IF s_shut(0) THEN RETURN END IF
LET p_row = 3 LET p_col = 15
OPEN WINDOW p001_w AT p_row,p_col WITH FORM "cim/42f/cimp901"
ATTRIBUTE (STYLE = g_win_style CLIPPED)
CALL cl_ui_init()
CALL cl_opmsg('z')
CALL cl_set_comp_entry("userid,moddate",FALSE)
MESSAGE('')
WHILE TRUE
CLEAR FORM
INITIALIZE tm.* TO NULL # Default condition
IF cl_null(tm.type) THEN
LET tm.type = '1'
END IF
IF cl_null(tm.moddate) THEN
LET tm.moddate = TODAY
END IF
IF cl_null(tm.userid) THEN
LET tm.userid = g_user
END IF
CONSTRUCT BY NAME tm.wc ON ima01
BEFORE CONSTRUCT
CALL cl_qbe_init()
ON ACTION controlp
CASE
WHEN INFIELD(ima01) #?辣蝺刻?
CALL cl_init_qry_var()
LET g_qryparam.form = "q_ima"
LET g_qryparam.state = "c"
CALL cl_create_qry() RETURNING g_qryparam.multiret
DISPLAY g_qryparam.multiret TO ima01
NEXT FIELD ima01
END CASE
ON IDLE g_idle_seconds
CALL cl_on_idle()
CONTINUE CONSTRUCT
ON ACTION about #MOD-4C0121
CALL cl_about() #MOD-4C0121
ON ACTION help #MOD-4C0121
CALL cl_show_help() #MOD-4C0121
ON ACTION controlg #MOD-4C0121
CALL cl_cmdask() #MOD-4C0121
ON ACTION locale #genero
LET g_change_lang = TRUE
EXIT CONSTRUCT
ON ACTION exit #????篇enero
LET INT_FLAG = 1
EXIT CONSTRUCT
ON ACTION qbe_select
CALL cl_qbe_select()
END CONSTRUCT
IF g_change_lang THEN
LET g_change_lang = FALSE
CALL cl_dynamic_locale()
CALL cl_show_fld_cont() #FUN-550037(smin)
CONTINUE WHILE
END IF
IF INT_FLAG THEN
LET INT_FLAG = 0
CLOSE WINDOW p001_w
EXIT PROGRAM
END IF
IF tm.wc = " 1=1" THEN
CALL cl_err('','9046',0)
CONTINUE WHILE
END IF
LET g_bgjob = 'N'
INPUT BY NAME tm.moddate,tm.userid,tm.type WITHOUT DEFAULTS
AFTER FIELD moddate
IF tm.moddate IS NULL THEN NEXT FIELD tm.moddate END IF
AFTER FIELD userid
IF tm.userid IS NULL THEN NEXT FIELD userid END IF
ON ACTION CONTROLZ
CALL cl_show_req_fields()
ON ACTION CONTROLG
CALL cl_cmdask()
ON IDLE g_idle_seconds
CALL cl_on_idle()
CONTINUE INPUT
ON ACTION about #MOD-4C0121
CALL cl_about() #MOD-4C0121
ON ACTION help #MOD-4C0121
CALL cl_show_help() #MOD-4C0121
ON ACTION exit #????篇enero
LET INT_FLAG = 1
EXIT INPUT
ON ACTION qbe_save
CALL cl_qbe_save()
ON ACTION locale
LET g_change_lang = TRUE
EXIT INPUT
END INPUT
EXIT WHILE
END WHILE
END FUNCTION
FUNCTION exec_sp()
DEFINE l_sql STRING
DEFINE l_cnt LIKE type_file.num10
DEFINE l_ima01 LIKE ima_file.ima01
DEFINE l_sp1 STRING
DEFINE l_sp2 STRING
LET l_sp1 = "call DS.DEL_BOM(?)"
LET l_sp2 = "call DS.DEL_ITEM(?)"
PREPARE exec_sp1 FROM l_sp1
IF SQLCA.SQLCODE THEN
CALL cl_err('prepare exec_sp1',SQLCA.SQLCODE,1)
LET g_success = 'N'
RETURN
END IF
PREPARE exec_sp2 FROM l_sp2
IF SQLCA.SQLCODE THEN
CALL cl_err('prepare exec_sp2',SQLCA.SQLCODE,1)
LET g_success = 'N'
RETURN
END IF
LET l_sql=" SELECT DISTINCT ima01 ",
" FROM ima_file",
" WHERE ",tm.wc CLIPPED,
" ORDER BY 1 "
PREPARE item_cs_p FROM l_sql
IF SQLCA.sqlcode THEN
CALL cl_err('prepare item_cs_p',SQLCA.sqlcode,1)
LET g_success = 'N'
RETURN
END IF
DECLARE item_cs CURSOR FOR item_cs_p
CALL s_showmsg_init() #No.FUN-710025
FOREACH item_cs INTO l_ima01
IF SQLCA.SQLCODE THEN
CALL s_errmsg('','','prepare FOREACH',SQLCA.SQLCODE,1)
LET g_success = 'N'
RETURN
END IF
CASE tm.type
WHEN "1"
EXECUTE exec_sp1 USING l_ima01 IN
WHEN "2"
EXECUTE exec_sp2 USING l_ima01 IN
WHEN "3"
EXECUTE exec_sp1 USING l_ima01 IN
EXECUTE exec_sp2 USING l_ima01 IN
OTHERWISE
LET g_success='N'
RETURN
END CASE
IF SQLCA.SQLCODE THEN
CALL s_errmsg('','','exec exec_sp',SQLCA.SQLCODE,1)
LET g_success = 'N'
RETURN
EXIT FOREACH
END IF
END FOREACH
END FUNCTION
全站熱搜
留言列表
站台介紹 (1)