SAP QM：UD冲销入库凭证
在SAP项目中上过QM的都会遇到这样的问题，品质已经做了判定并对质检库存做了移动，但是因为某些原因要冲销，这时却怎么也冲销不了。其实SAP已经考虑到这样的问题，通过SAP note 74638和SAP note 175842中有详细说明，并在note中提供两个程序：qevac40用来取消质检判定及RQEVAC50用来冲销质检库存过账。
可以复制这两个程序：
zqevac40
1 *&---------------------------------------------------------------------* 2 *& Title: Taking back usage decision for single lots * 3 *&---------------------------------------------------------------------* 4 report zqevac40. 5 *----------------------------------------------------------------------* 6 * Datendefinitionen 7 *----------------------------------------------------------------------* 8 * Tabellen 9 *----------------------------------------------------------------------* 10 tables sscrfields. 11 tables qals. 12 tables qave. 13 *----------------------------------------------------------------------* 14 * Konstanten 15 constants: 16 c_rc_0 like sy-subrc value 0, 17 c_rc_4 like sy-subrc value 4, 18 c_rc_20 like sy-subrc value 20, 19 * 20 c_kreuz like qm00-qkz value 'X'. 21 * 22 *----------------------------------------------------------------------* 23 * Eingabebildschirm 24 selection-screen skip 2. 25 parameters prueflos like qals-prueflos matchcode object qals 26 memory id qls . 27 selection-screen skip 1. 28 selection-screen begin of block search with frame. 29 selection-screen begin of line. 30 selection-screen pushbutton 3(20) text-s01 user-command sear. 31 selection-screen pushbutton 40(20) text-s02 user-command show. 32 selection-screen end of line. 33 selection-screen end of block search. 34 *----------------------------------------------------------------------* 35 at selection-screen. 36 if sscrfields-ucomm eq 'SEAR' 37 or prueflos is initial. 38 call function 'QELA_START_SELECTION_OF_LOTS' 39 exporting 40 i_selid = ' ' 41 i_stat_aenderung = 'X' 42 i_stat_ero = 'X' 43 i_stat_frei = 'X' 44 i_stat_ve = ' ' 45 importing 46 e_prueflos = prueflos 47 exceptions 48 no_entry = 1 49 no_selected = 2 50 others = 3. 51 endif. 52 if sscrfields-ucomm eq 'SHOW'. 53 call function 'QSS1_LOT_SHOW' 54 exporting 55 i_prueflos = prueflos. 56 endif. 57 check sscrfields-ucomm eq 'ONLI'. 58 * ab hier muß Prüflosnummer gefüllt sein. 59 if prueflos is initial. 60 message e164(qa). 61 endif. 62 * Lesen Los 63 call function 'ENQUEUE_EQQALS1' 64 exporting 65 prueflos = prueflos. 66 call function 'QPSE_LOT_READ' 67 exporting 68 i_prueflos = prueflos 69 importing 70 e_qals = qals 71 exceptions 72 no_lot = 1. 73 if not sy-subrc is initial. 74 message e102(qa). 75 endif. 76 *----------------- 77 * Prüfen Status 78 call function 'QAST_STATUS_CHECK' 79 exporting 80 i_objnr = qals-objnr 81 i_status = 'I0218' "Status VE getroffen 82 exceptions 83 status_not_activ = 1. 84 if not sy-subrc is initial. 85 message e102(qv) with qals-prueflos. 86 endif. 87 * 88 call function 'QEVA_UD_READ' 89 exporting 90 i_prueflos = qals-prueflos 91 importing 92 e_qave = qave. 93 *---------------------------------------------------------------------* 94 start-of-selection. 95 * Vorgaben sind ok. 1. Material Umlagern und Los ändern 96 perform qals_aendern. 97 ************************************************************************ 98 *----------------------------------------------------------------------* 99 * FORM QALS_aendern 100 *----------------------------------------------------------------------* 101 form qals_aendern. 102 * 103 perform status_fix_setzen using 'I0002' c_kreuz. 104 perform status_fix_setzen using 'I0216' space. 105 perform status_fix_setzen using 'I0217' space. 106 perform status_fix_setzen using 'I0218' space. 107 clear: qals-stat14. 108 clear: qals-stat35. 109 clear: qave-vauswahlmg, 110 qave-vwerks, 111 qave-versionam, 112 qave-vcodegrp, 113 qave-vcode, 114 qave-vbewertung, 115 qave-versioncd, 116 qave-vfolgeakti, 117 qave-qkennzahl. 118 *--... verbuchen 119 call function 'QEVA_UD_UPDATE' in update task 120 exporting 121 qals_new = qals 122 qave_new = qave. 123 commit work. 124 message s101(qa) with qals-prueflos. 125 endform. 126 *----------------------------------------------------------------------* 127 * Form STATUS_FIX_SETZEN 128 *----------------------------------------------------------------------* 129 * Setzen eines Status aufgrund von Voreinstellungen wie QMAT etc. * 130 *----------------------------------------------------------------------* 131 * --> STATUS Status der gesetzt werden soll 132 * --> AKTIV Status wird aktiviert sonst deaktiviert 133 *----------------------------------------------------------------------* 134 form status_fix_setzen using 135 value(status) like tj02-istat 136 value(aktiv) like c_kreuz. 137 * lokale Tabelle fuer Statusfortschreibung 138 data: begin of l_stattab occurs 0. 139 include structure jstat. 140 data end of l_stattab. 141 * 142 * Falls Objektnr. nicht gefüllt. --> Fehlermeldung !!! 143 if qals-objnr eq space. 144 message e013(qv). 145 * Fehlende Objektnr.: Problem fü 146 endif. 147 move status to l_stattab-stat. 148 if aktiv eq space. 149 move c_kreuz to l_stattab-inact. 150 endif. 151 * 152 append l_stattab. 153 * 154 call function 'STATUS_CHANGE_INTERN' 155 exporting 156 check_only = space 157 objnr = qals-objnr 158 tables 159 status = l_stattab. 160 endform. " STATUS_FIX_SETZEN
ZRQEVAC50
1 REPORT RQEVAC50 MESSAGE-ID QA. 2 "*********************************************************************** 3 "* Report is provided by Modification Note 175842 * 4 "* * 5 "* CAUTION: Please be aware that this is a Modification! * 6 "* Please refer to note 170183. * 7 "*********************************************************************** 8 TYPES: 9 T_MKPF_TAB LIKE MKPF OCCURS 0, 10 T_MSEG_TAB LIKE MSEG OCCURS 0. 11 PARAMETERS: 12 PRUEFLOS LIKE QALS-PRUEFLOS OBLIGATORY MEMORY ID QLS. 13 DATA: 14 G_MSGV1 LIKE SY-MSGV1, 15 G_QALS LIKE QALS, 16 G_QALS_LEISTE LIKE QALS, 17 G_QAMB_TAB TYPE QAMBTAB, 18 G_QAMB_VB_TAB TYPE QAMBTAB, 19 G_MKPF_TAB TYPE T_MKPF_TAB, 20 G_MSEG_TAB TYPE T_MSEG_TAB, 21 G_SUBRC LIKE SY-SUBRC. 22 START-OF-SELECTION. 23 PERFORM ENQUEUE_QALS USING PRUEFLOS 24 G_SUBRC. 25 IF NOT G_SUBRC IS INITIAL. 26 MESSAGE ID SY-MSGID TYPE 'S' NUMBER SY-MSGNO 27 WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4. 28 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 29 ENDIF. 30 PERFORM READ_QALS USING PRUEFLOS 31 G_QALS 32 G_QALS_LEISTE 33 G_SUBRC. 34 IF NOT G_SUBRC IS INITIAL. 35 MESSAGE ID 'QA' TYPE 'S' NUMBER '102' 36 WITH PRUEFLOS. 37 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 38 ENDIF. 39 PERFORM CHECK_LOT USING G_QALS 40 G_SUBRC. 41 IF NOT G_SUBRC IS INITIAL. 42 CASE G_SUBRC. 43 WHEN 256. 44 G_MSGV1 = 'Lot & does not refer to a material doc'. 45 WHEN 128. 46 G_MSGV1 = 'Material & is serialized'. 47 REPLACE '&' WITH G_QALS-MATNR INTO G_MSGV1. 48 WHEN 64. 49 G_MSGV1 = 'Lot & is not stock relevant'. 50 WHEN 32. 51 G_MSGV1 = 'Lot &: No stock transferred'. 52 WHEN 16. 53 G_MSGV1 = 'Lot & is cancelled'. 54 WHEN 8. 55 G_MSGV1 = 'Lot & is archived'. 56 WHEN 4. 57 G_MSGV1 = 'Lot & is blocked'. 58 WHEN 2. 59 G_MSGV1 = 'Lot & is HU managed'. 60 ENDCASE. 61 REPLACE '&' WITH PRUEFLOS INTO G_MSGV1. 62 MESSAGE ID '00' TYPE 'S' NUMBER '208' 63 WITH G_MSGV1. 64 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 65 ENDIF. 66 PERFORM READ_QAMB USING G_QALS 67 G_QAMB_TAB 68 G_SUBRC. 69 IF NOT G_SUBRC IS INITIAL. 70 MESSAGE ID 'QA' TYPE 'S' NUMBER '068' 71 WITH PRUEFLOS. 72 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 73 ENDIF. 74 PERFORM READ_MKPF USING G_QAMB_TAB 75 G_MKPF_TAB 76 G_SUBRC. 77 IF NOT G_SUBRC IS INITIAL. 78 MESSAGE ID SY-MSGID TYPE 'S' NUMBER SY-MSGNO 79 WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4. 80 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 81 ENDIF. 82 PERFORM CHECK_MKPF USING G_MKPF_TAB 83 G_SUBRC. 84 IF NOT G_SUBRC IS INITIAL. 85 MESSAGE ID 'QA' TYPE 'S' NUMBER '068' 86 WITH PRUEFLOS. 87 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 88 ENDIF. 89 PERFORM READ_MSEG USING G_MKPF_TAB 90 G_MSEG_TAB 91 G_SUBRC. 92 IF NOT G_SUBRC IS INITIAL. 93 MESSAGE ID SY-MSGID TYPE 'S' NUMBER SY-MSGNO 94 WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4. 95 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 96 ENDIF. 97 PERFORM CHECK_MSEG USING G_MSEG_TAB 98 G_QAMB_TAB 99 G_SUBRC. 100 IF NOT G_SUBRC IS INITIAL. 101 MESSAGE ID 'QA' TYPE 'S' NUMBER '068' 102 WITH PRUEFLOS. 103 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 104 ENDIF. 105 PERFORM CREATE_GOODS_MOVEMENT USING G_QALS 106 G_MSEG_TAB 107 G_SUBRC. 108 IF NOT G_SUBRC IS INITIAL. 109 MESSAGE ID 'QA' TYPE 'S' NUMBER '068' 110 WITH PRUEFLOS. 111 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 112 ENDIF. 113 PERFORM POST_GOODS_MOVEMENT. 114 PERFORM POST_DATA USING G_QALS 115 G_QALS_LEISTE 116 G_QAMB_TAB 117 G_QAMB_VB_TAB 118 G_SUBRC. 119 IF NOT G_SUBRC IS INITIAL. 120 MESSAGE ID SY-MSGID TYPE 'S' NUMBER SY-MSGNO 121 WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4. 122 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 123 ELSE. 124 COMMIT WORK AND WAIT. 125 G_MSGV1 = 'inspection lot &'. 126 REPLACE '&' WITH PRUEFLOS INTO G_MSGV1. 127 MESSAGE ID '00' TYPE 'S' NUMBER '368' 128 WITH 'Stock posting reversed for ' G_MSGV1. 129 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 130 ENDIF. 131 *----------------------------------------------------------------------* 132 * Form ENQUEUE_QALS * 133 *----------------------------------------------------------------------* 134 * Los sperren * 135 *----------------------------------------------------------------------* 136 FORM ENQUEUE_QALS USING P_PRUEFLOS LIKE QALS-PRUEFLOS 137 P_SUBRC LIKE SY-SUBRC. 138 CLEAR: P_SUBRC. 139 CALL FUNCTION 'ENQUEUE_EQQALS1' 140 EXPORTING 141 PRUEFLOS = P_PRUEFLOS 142 EXCEPTIONS 143 FOREIGN_LOCK = 1 144 SYSTEM_FAILURE = 2 145 OTHERS = 3. 146 P_SUBRC = SY-SUBRC. 147 ENDFORM. " ENQUEUE_QALS 148 *----------------------------------------------------------------------* 149 * Form READ_QALS * 150 *----------------------------------------------------------------------* 151 * Prüflos lesen * 152 *----------------------------------------------------------------------* 153 FORM READ_QALS USING P_PRUEFLOS LIKE QALS-PRUEFLOS 154 P_QALS LIKE QALS 155 P_QALS_LEISTE LIKE QALS 156 P_SUBRC LIKE SY-SUBRC. 157 CLEAR: P_SUBRC. 158 CALL FUNCTION 'QPSE_LOT_READ' 159 EXPORTING 160 I_PRUEFLOS = P_PRUEFLOS 161 I_RESET_LOT = 'X' 162 IMPORTING 163 E_QALS = P_QALS 164 EXCEPTIONS 165 NO_LOT = 1. 166 P_SUBRC = SY-SUBRC. 167 IF P_SUBRC IS INITIAL. 168 P_QALS_LEISTE = P_QALS. 169 ELSE. 170 CLEAR: P_QALS, 171 P_QALS_LEISTE. 172 ENDIF. 173 ENDFORM. " READ_QALS 174 *----------------------------------------------------------------------* 175 * Form CHECK_LOT * 176 *----------------------------------------------------------------------* 177 * Prüflos prüfen * 178 *----------------------------------------------------------------------* 179 FORM CHECK_LOT USING P_QALS LIKE QALS 180 P_SUBRC LIKE SY-SUBRC. 181 DATA: 182 L_STAT LIKE JSTAT, 183 L_STAT_TAB LIKE JSTAT OCCURS 0 WITH HEADER LINE. 184 P_SUBRC = 256. 185 */No reference to material document 186 IF P_QALS-ZEILE IS INITIAL. 187 EXIT. 188 ELSE. 189 P_SUBRC = 128. 190 ENDIF. 191 */Serialized Material 192 IF NOT P_QALS-SERNP IS INITIAL. 193 EXIT. 194 ELSE. 195 P_SUBRC = 64. 196 ENDIF. 197 */BERF 198 CALL FUNCTION 'STATUS_CHECK' 199 EXPORTING 200 OBJNR = P_QALS-OBJNR 201 STATUS = 'I0203' 202 EXCEPTIONS 203 STATUS_NOT_ACTIVE = 2. 204 IF NOT SY-SUBRC IS INITIAL. 205 EXIT. 206 ELSE. 207 P_SUBRC = 32. 208 ENDIF. 209 */BTEI & BEND 210 CLEAR L_STAT. CLEAR L_STAT_TAB. REFRESH L_STAT_TAB. 211 L_STAT-STAT = 'I0219'. APPEND L_STAT TO L_STAT_TAB. "BTEI 212 L_STAT-STAT = 'I0220'. APPEND L_STAT TO L_STAT_TAB. "BEND 213 CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI' 214 EXPORTING 215 OBJNR = P_QALS-OBJNR 216 TABLES 217 STATUS_CHECK = L_STAT_TAB. 218 IF L_STAT_TAB[] IS INITIAL. 219 EXIT. 220 ELSE. 221 P_SUBRC = 16. 222 ENDIF. 223 */LSTO & LSTV 224 CLEAR L_STAT. CLEAR L_STAT_TAB. REFRESH L_STAT_TAB. 225 L_STAT-STAT = 'I0224'. APPEND L_STAT TO L_STAT_TAB. "LSTO 226 L_STAT-STAT = 'I0232'. APPEND L_STAT TO L_STAT_TAB. "LSTV 227 CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI' 228 EXPORTING 229 OBJNR = P_QALS-OBJNR 230 TABLES 231 STATUS_CHECK = L_STAT_TAB. 232 IF NOT L_STAT_TAB[] IS INITIAL. 233 EXIT. 234 ELSE. 235 P_SUBRC = 8. 236 ENDIF. 237 */ARSP & ARCH & REO1 & REO2 & REO3 238 CLEAR L_STAT. CLEAR L_STAT_TAB. REFRESH L_STAT_TAB. 239 L_STAT-STAT = 'I0225'. APPEND L_STAT TO L_STAT_TAB. "ARSP 240 L_STAT-STAT = 'I0226'. APPEND L_STAT TO L_STAT_TAB. "ARCH 241 L_STAT-STAT = 'I0227'. APPEND L_STAT TO L_STAT_TAB. "REO3 242 L_STAT-STAT = 'I0228'. APPEND L_STAT TO L_STAT_TAB. "REO2 243 L_STAT-STAT = 'I0229'. APPEND L_STAT TO L_STAT_TAB. "REO1 244 CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI' 245 EXPORTING 246 OBJNR = P_QALS-OBJNR 247 TABLES 248 STATUS_CHECK = L_STAT_TAB. 249 IF NOT L_STAT_TAB[] IS INITIAL. 250 EXIT. 251 ELSE. 252 P_SUBRC = 4. 253 ENDIF. 254 */SPER 255 CALL FUNCTION 'STATUS_CHECK' 256 EXPORTING 257 OBJNR = P_QALS-OBJNR 258 STATUS = 'I0043' 259 EXCEPTIONS 260 STATUS_NOT_ACTIVE = 2. 261 IF SY-SUBRC IS INITIAL. 262 EXIT. 263 ELSE. 264 P_SUBRC = 2. 265 ENDIF. 266 */HUM 267 CALL FUNCTION 'STATUS_CHECK' 268 EXPORTING 269 OBJNR = P_QALS-OBJNR 270 STATUS = 'I0443' 271 EXCEPTIONS 272 STATUS_NOT_ACTIVE = 2. 273 IF SY-SUBRC IS INITIAL. 274 EXIT. 275 ELSE. 276 P_SUBRC = 0. 277 ENDIF. 278 ENDFORM. " CHECK_LOT 279 *----------------------------------------------------------------------* 280 * Form READ_QAMB * 281 *----------------------------------------------------------------------* 282 * QAMBs lesen * 283 *----------------------------------------------------------------------* 284 FORM READ_QAMB USING P_QALS LIKE QALS 285 P_QAMB_TAB TYPE QAMBTAB 286 P_SUBRC LIKE SY-SUBRC. 287 CLEAR: P_SUBRC. 288 SELECT * FROM QAMB INTO TABLE P_QAMB_TAB 289 WHERE PRUEFLOS = P_QALS-PRUEFLOS 290 AND TYP = '3'. 291 P_SUBRC = SY-SUBRC. 292 ENDFORM. " READ_QAMB 293 *----------------------------------------------------------------------* 294 * Form READ_MKPF * 295 *----------------------------------------------------------------------* 296 * Read material document header * 297 *----------------------------------------------------------------------* 298 FORM READ_MKPF USING P_QAMB_TAB TYPE QAMBTAB 299 P_MKPF_TAB TYPE T_MKPF_TAB 300 P_SUBRC LIKE SY-SUBRC. 301 DATA: 302 BEGIN OF L_MKPF_KEY_TAB OCCURS 0, 303 MBLNR LIKE MKPF-MBLNR, 304 MJAHR LIKE MKPF-MJAHR, 305 END OF L_MKPF_KEY_TAB. 306 DATA: 307 L_QAMB LIKE QAMB, 308 L_MKPF LIKE MKPF, 309 L_TRTYP LIKE T158-TRTYP VALUE 'A', 310 L_VGART LIKE T158-VGART VALUE 'WQ', 311 L_XEXIT LIKE QM00-QKZ. 312 P_SUBRC = 4. 313 LOOP AT P_QAMB_TAB INTO L_QAMB. 314 L_MKPF_KEY_TAB-MBLNR = L_QAMB-MBLNR. 315 L_MKPF_KEY_TAB-MJAHR = L_QAMB-MJAHR. 316 COLLECT L_MKPF_KEY_TAB. 317 ENDLOOP. 318 LOOP AT L_MKPF_KEY_TAB. 319 CALL FUNCTION 'ENQUEUE_EMMKPF' 320 EXPORTING 321 MBLNR = L_MKPF_KEY_TAB-MBLNR 322 MJAHR = L_MKPF_KEY_TAB-MJAHR 323 EXCEPTIONS 324 FOREIGN_LOCK = 1 325 SYSTEM_FAILURE = 2 326 OTHERS = 3. 327 IF NOT SY-SUBRC IS INITIAL. 328 L_XEXIT = 'X'. 329 EXIT. 330 ENDIF. 331 CLEAR: L_MKPF. 332 CALL FUNCTION 'MB_READ_MATERIAL_HEADER' 333 EXPORTING 334 MBLNR = L_MKPF_KEY_TAB-MBLNR 335 MJAHR = L_MKPF_KEY_TAB-MJAHR 336 TRTYP = L_TRTYP 337 VGART = L_VGART 338 IMPORTING 339 KOPF = L_MKPF 340 EXCEPTIONS 341 ERROR_MESSAGE = 1. 342 IF NOT SY-SUBRC IS INITIAL. 343 L_XEXIT = 'X'. 344 EXIT. 345 ELSE. 346 APPEND L_MKPF TO P_MKPF_TAB. 347 ENDIF. 348 ENDLOOP. 349 IF NOT L_XEXIT IS INITIAL. 350 EXIT. 351 ELSE. 352 P_SUBRC = 0. 353 ENDIF. 354 ENDFORM. " READ_MKPF 355 *----------------------------------------------------------------------* 356 * Form READ_MSEG * 357 *----------------------------------------------------------------------* 358 * MSEGs lesen * 359 *----------------------------------------------------------------------* 360 FORM READ_MSEG USING P_MKPF_TAB TYPE T_MKPF_TAB 361 P_MSEG_TAB TYPE T_MSEG_TAB 362 P_SUBRC LIKE SY-SUBRC. 363 DATA: 364 L_MKPF LIKE MKPF, 365 L_MSEG_TAB LIKE MSEG OCCURS 0 WITH HEADER LINE, 366 L_TRTYP LIKE T158-TRTYP VALUE 'A', 367 L_XEXIT LIKE QM00-QKZ. 368 P_SUBRC = 4. 369 LOOP AT P_MKPF_TAB INTO L_MKPF. 370 CLEAR: L_MSEG_TAB. REFRESH: L_MSEG_TAB. 371 CALL FUNCTION 'MB_READ_MATERIAL_POSITION' 372 EXPORTING 373 MBLNR = L_MKPF-MBLNR 374 MJAHR = L_MKPF-MJAHR 375 TRTYP = L_TRTYP 376 */ ZEILB = P_ZEILE 377 */ ZEILE = P_ZEILE 378 TABLES 379 SEQTAB = L_MSEG_TAB 380 EXCEPTIONS 381 ERROR_MESSAGE = 1. 382 IF NOT SY-SUBRC IS INITIAL. 383 L_XEXIT = 'X'. 384 EXIT. 385 ELSE. 386 APPEND LINES OF L_MSEG_TAB TO P_MSEG_TAB. 387 ENDIF. 388 ENDLOOP. 389 IF NOT L_XEXIT IS INITIAL. 390 EXIT. 391 ELSE. 392 */ XAuto-Zeilen und Chargenzustands?nderung werden gel?scht 393 DELETE P_MSEG_TAB WHERE XAUTO NE SPACE 394 OR BWART EQ '341' 395 OR BWART EQ '342'. 396 P_SUBRC = 0. 397 ENDIF. 398 ENDFORM. " READ_MSEG 399 *----------------------------------------------------------------------* 400 * Form CREATE_GOODS_MOVEMENT * 401 *----------------------------------------------------------------------* 402 * Warenbewegung anlegen * 403 *----------------------------------------------------------------------* 404 FORM CREATE_GOODS_MOVEMENT USING P_QALS LIKE QALS 405 P_MSEG_TAB TYPE T_MSEG_TAB 406 P_SUBRC LIKE SY-SUBRC. 407 DATA: 408 L_LMENGEZUB LIKE QALS-LMENGEZUB, 409 L_LMENGEGEB LIKE QALS-LMENGEZUB, 410 L_MBQSS LIKE MBQSS, 411 L_IMKPF LIKE IMKPF, 412 L_IMSEG LIKE IMSEG, 413 L_IMSEG_TAB LIKE IMSEG OCCURS 1, 414 L_EMKPF LIKE EMKPF, 415 L_EMSEG LIKE EMSEG, 416 L_EMSEG_TAB LIKE EMSEG OCCURS 1, 417 L_MSEG LIKE MSEG, 418 L_MSEG_TAB LIKE MSEG OCCURS 1, 419 L_TCODE LIKE SY-TCODE VALUE 'QA11', 420 L_TABIX LIKE SY-TABIX VALUE 1, 421 L_XSTBW LIKE T156-XSTBW, 422 L_VMENGE03_BWART like mseg-bwart. 423 CLEAR: P_SUBRC. 424 */QAMB initialisieren 425 CALL FUNCTION 'QAMB_REFRESH_DATA'. 426 */Kopf füllen 427 L_IMKPF-BLDAT = SY-DATLO. 428 L_IMKPF-BUDAT = SY-DATLO. 429 L_IMKPF-BKTXT = 'Cancellation of QM UD postings'. 430 */Ursprüngliche zu buchende Menge merken + inkrementieren 431 L_LMENGEZUB = P_QALS-LMENGEZUB. 432 L_LMENGEGEB = P_QALS-LMENGE01 433 + P_QALS-LMENGE02 434 + P_QALS-LMENGE03 435 + P_QALS-LMENGE04 436 + P_QALS-LMENGE05 437 + P_QALS-LMENGE06 438 + P_QALS-LMENGE07 439 + P_QALS-LMENGE08 440 + P_QALS-LMENGE09. 441 IF P_QALS-STAT11 is not INITIAL and P_qals-lmenge03 is not INITIAL. 442 DATA ls_tq07m like tq07m. 443 DATA: s_tq07m_buf LIKE tq07m OCCURS 9. 444 SELECT * FROM tq07m INTO TABLE s_tq07m_buf 445 WHERE feldname LIKE 'VMENGE%' . 446 SORT s_tq07m_buf BY feldname ASCENDING 447 herkunft ASCENDING. 448 READ TABLE s_tq07m_buf INTO ls_tq07m 449 WITH KEY feldname = 'VMENGE03' 450 herkunft = ' ' BINARY SEARCH. 451 * Bin?re Suche mit Feld und Herkunft 452 IF sy-subrc IS INITIAL. 453 MOVE ls_tq07m-bwartwesp TO l_vmenge03_bwart. 454 ENDIF. 455 ENDIF. 456 */Zeilen aufbauen 457 L_MSEG_TAB[] = P_MSEG_TAB[]. 458 LOOP AT L_MSEG_TAB INTO L_MSEG. 459 MOVE-CORRESPONDING L_MSEG TO L_MBQSS. 460 MOVE-CORRESPONDING L_MBQSS TO L_IMSEG. 461 */ Referenzbeleg übergeben, falls Bestellnummer gefüllt 462 IF NOT L_MSEG-EBELN IS INITIAL. 463 MOVE: L_MSEG-LFBNR TO L_IMSEG-LFBNR, 464 L_MSEG-LFBJA TO L_IMSEG-LFBJA, 465 L_MSEG-LFPOS TO L_IMSEG-LFPOS. 466 ENDIF. 467 MOVE L_MSEG-KDAUF TO L_IMSEG-KDAUF. 468 MOVE L_MSEG-KDPOS TO L_IMSEG-KDPOS. 469 MOVE L_MSEG-PS_PSP_PNR TO L_IMSEG-PS_PSP_PNR. 470 */ Umlagerungsfelder setzen 471 MOVE: 472 L_MSEG-UMMAT TO L_IMSEG-UMMAT, 473 L_MSEG-UMWRK TO L_IMSEG-UMWRK, 474 L_MSEG-UMLGO TO L_IMSEG-UMLGO, 475 L_MSEG-UMCHA TO L_IMSEG-UMCHA. 476 */ Storno-Beleg setzen 477 MOVE: L_MSEG-MJAHR TO L_IMSEG-SJAHR, 478 L_MSEG-MBLNR TO L_IMSEG-SMBLN, 479 L_MSEG-ZEILE TO L_IMSEG-SMBLP. 480 */ Falsch gefüllte Felder initialisieren 481 CLEAR: L_IMSEG-MBLNR, 482 L_IMSEG-MENGE, 483 L_IMSEG-MEINS. 484 */ Bewegungsart lesen 485 SELECT SINGLE XSTBW FROM T156 INTO L_XSTBW 486 WHERE BWART = L_IMSEG-BWART. 487 IF NOT SY-SUBRC IS INITIAL. 488 P_SUBRC = 4. 489 EXIT. 490 ENDIF. 491 */ Werk/Lagerort füllen 492 IF P_QALS-STAT11 IS INITIAL. 493 IF L_XSTBW IS INITIAL. 494 MOVE P_QALS-LAGORTVORG TO L_IMSEG-LGORT. 495 ELSE. 496 MOVE P_QALS-LAGORTVORG TO L_IMSEG-UMLGO. 497 ENDIF. 498 ENDIF. 499 IF L_XSTBW IS INITIAL. 500 MOVE P_QALS-WERKVORG TO L_IMSEG-WERKS. 501 ELSE. 502 MOVE P_QALS-WERKVORG TO L_IMSEG-UMWRK. 503 ENDIF. 504 */ Zus?tzliche Felder 505 MOVE P_QALS-MENGENEINH TO L_IMSEG-ERFME. 506 "MOVE P_GRUND TO L_IMSEG-GRUND. 507 "MOVE P_ELIKZ TO L_IMSEG-ELIKZ. 508 */ Kennzeichen Storno-Buchung setzen 509 MOVE 'X' TO L_IMSEG-XSTOB. 510 MOVE P_QALS-PRUEFLOS TO L_IMSEG-QPLOS. 511 APPEND L_IMSEG TO L_IMSEG_TAB. 512 IF P_QALS-STAT11 IS INITIAL. 513 ADD L_IMSEG-ERFMG TO L_LMENGEZUB. 514 SUBTRACT L_IMSEG-ERFMG FROM L_LMENGEGEB. 515 ELSE. 516 IF ( L_IMSEG-KZBEW EQ SPACE 517 AND L_IMSEG-WERKS NE SPACE 518 AND L_IMSEG-LGORT NE SPACE 519 AND L_IMSEG-UMWRK NE SPACE 520 AND L_IMSEG-UMLGO NE SPACE 521 AND L_IMSEG-WERKS EQ L_IMSEG-UMWRK 522 AND L_IMSEG-UMLGO EQ L_IMSEG-UMLGO ) 523 OR 524 ( L_IMSEG-KZBEW EQ SPACE 525 AND l_IMSEG-BWART EQ L_VMENGE03_BWART 526 AND L_IMSEG-WERKS NE SPACE 527 AND L_IMSEG-LGORT NE SPACE 528 AND L_IMSEG-UMLGO NE SPACE 529 AND L_IMSEG-UMLGO EQ L_IMSEG-UMLGO ). 530 */ Dummy Buchung bei WE-Sperrbestand & Stichprobe 531 ELSE. 532 ADD L_IMSEG-ERFMG TO L_LMENGEZUB. 533 SUBTRACT L_IMSEG-ERFMG FROM L_LMENGEGEB. 534 ENDIF. 535 ENDIF. 536 ENDLOOP. 537 IF NOT P_QALS-STAT11 IS INITIAL. 538 */ Bei WE-Sperrbestand und Stichprobenbuchung Zeilen tauschen 539 DO. 540 READ TABLE L_IMSEG_TAB INDEX SY-INDEX INTO L_IMSEG. 541 IF ( SY-SUBRC IS INITIAL and 542 L_IMSEG-KZBEW EQ SPACE 543 AND L_IMSEG-WERKS NE SPACE 544 AND L_IMSEG-LGORT NE SPACE 545 AND L_IMSEG-UMWRK NE SPACE 546 AND L_IMSEG-UMLGO NE SPACE 547 AND L_IMSEG-WERKS EQ L_IMSEG-UMWRK 548 AND L_IMSEG-UMLGO EQ L_IMSEG-UMLGO ) 549 OR 550 ( SY-SUBRC IS INITIAL and 551 L_IMSEG-KZBEW EQ SPACE 552 AND l_IMSEG-BWART EQ L_VMENGE03_BWART 553 AND L_IMSEG-WERKS NE SPACE 554 AND L_IMSEG-LGORT NE SPACE 555 AND L_IMSEG-UMLGO NE SPACE 556 AND L_IMSEG-UMLGO EQ L_IMSEG-UMLGO ). 557 IF SY-TABIX NE L_TABIX. 558 DELETE L_IMSEG_TAB INDEX SY-TABIX. 559 INSERT L_IMSEG INTO L_IMSEG_TAB INDEX L_TABIX. 560 L_TABIX = L_TABIX + 1. 561 ELSE. 562 L_TABIX = L_TABIX + 1. 563 CONTINUE. 564 ENDIF. 565 ELSEIF SY-SUBRC IS INITIAL. 566 CONTINUE. 567 ELSE. 568 EXIT. "from do 569 ENDIF. 570 ENDDO. 571 ENDIF. 572 */QM deaktivieren 573 CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE' 574 EXPORTING 575 AKTIV = SPACE. 576 */Buchen 577 CALL FUNCTION 'MB_CREATE_GOODS_MOVEMENT' 578 EXPORTING 579 IMKPF = L_IMKPF 580 XALLP = 'X' 581 XALLR = 'X' 582 CTCOD = L_TCODE 583 XQMCL = ' ' 584 IMPORTING 585 EMKPF = L_EMKPF 586 TABLES 587 IMSEG = L_IMSEG_TAB 588 EMSEG = L_EMSEG_TAB. 589 */QM wieder aktivieren 590 CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE' 591 EXPORTING 592 AKTIV = 'X'. 593 */Buchung auswerten 594 IF L_EMKPF-SUBRC GT 1. 595 IF L_EMKPF-MSGID NE SPACE. 596 */ Fehler auf Kopfebene 597 MESSAGE ID L_EMKPF-MSGID TYPE 'S' 598 NUMBER L_EMKPF-MSGNO 599 WITH L_EMKPF-MSGV1 L_EMKPF-MSGV2 600 L_EMKPF-MSGV3 L_EMKPF-MSGV4. 601 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 602 ELSE. 603 */ Fehler auf Zeilenebene (Ausgabe des ersten Fehlers) 604 LOOP AT L_EMSEG_TAB INTO L_EMSEG. 605 IF L_EMSEG-MSGID NE SPACE. 606 MESSAGE ID L_EMSEG-MSGID TYPE 'S' 607 NUMBER L_EMSEG-MSGNO 608 WITH L_EMSEG-MSGV1 L_EMSEG-MSGV2 609 L_EMSEG-MSGV3 L_EMSEG-MSGV4. 610 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 611 ENDIF. 612 ENDLOOP. 613 ENDIF. 614 ENDIF. 615 LOOP AT L_EMSEG_TAB INTO L_EMSEG. 616 CALL FUNCTION 'QAMB_COLLECT_RECORD' 617 EXPORTING 618 LOTNUMBER = P_QALS-PRUEFLOS 619 DOCYEAR = L_EMKPF-MJAHR 620 DOCNUMBER = L_EMKPF-MBLNR 621 DOCPOSITION = L_EMSEG-MBLPO 622 TYPE = '7'. 623 ENDLOOP. 624 */Sonderkorrektur für Frei-An-Frei & WE-Sperr-An-We-Sperr 625 IF NOT P_QALS-STAT11 IS INITIAL. 626 IF P_QALS-LMENGE04 EQ L_LMENGEGEB. 627 ADD P_QALS-LMENGE04 TO L_LMENGEZUB. 628 SUBTRACT P_QALS-LMENGE04 FROM L_LMENGEGEB. 629 ENDIF. 630 ELSEIF P_QALS-INSMK IS INITIAL. 631 IF P_QALS-LMENGE01 GE L_LMENGEGEB 632 AND NOT P_QALS-LMENGE01 IS INITIAL. 633 ADD L_LMENGEGEB TO L_LMENGEZUB. 634 SUBTRACT L_LMENGEGEB FROM L_LMENGEGEB. 635 ENDIF. 636 ENDIF. 637 CLEAR: P_QALS-STAT34, 638 P_QALS-MATNRNEU, 639 P_QALS-CHARGNEU, 640 P_QALS-LMENGE01, 641 P_QALS-LMENGE02, 642 P_QALS-LMENGE03, 643 P_QALS-LMENGE04, 644 P_QALS-LMENGE05, 645 P_QALS-LMENGE06, 646 P_QALS-LMENGE07, 647 P_QALS-LMENGE08, 648 P_QALS-LMENGE09. 649 P_QALS-LMENGEZUB = L_LMENGEZUB. 650 IF NOT L_LMENGEGEB IS INITIAL. 651 P_SUBRC = 4. 652 ENDIF. 653 ENDFORM. " CREATE_GOODS_MOVEMENT 654 *----------------------------------------------------------------------* 655 * Form POST_GOODS_MOVEMENT * 656 *----------------------------------------------------------------------* 657 * Warenbewegung buchen * 658 *----------------------------------------------------------------------* 659 FORM POST_GOODS_MOVEMENT. 660 CALL FUNCTION 'MB_POST_GOODS_MOVEMENT'. 661 ENDFORM. " POST_GOODS_MOVEMENT 662 *----------------------------------------------------------------------* 663 * Form POST_DATA * 664 *----------------------------------------------------------------------* 665 * QM-Daten verbuchen * 666 *----------------------------------------------------------------------* 667 FORM POST_DATA USING P_QALS LIKE QALS 668 P_QALS_LEISTE LIKE QALS 669 P_QAMB_TAB TYPE QAMBTAB 670 P_QAMB_VB_TAB TYPE QAMBTAB 671 P_SUBRC LIKE SY-SUBRC. 672 DATA: 673 L_STAT LIKE JSTAT, 674 L_STAT_TAB LIKE JSTAT OCCURS 0, 675 L_QAMB LIKE QAMB, 676 L_UPDKZ LIKE QALSVB-UPSL VALUE 'U'. 677 */QAMBs umsetzen (7 = VE-Buchung storniert) 678 LOOP AT P_QAMB_TAB INTO L_QAMB. 679 L_QAMB-TYP = '7'. 680 APPEND L_QAMB TO P_QAMB_VB_TAB. 681 ENDLOOP. 682 */BERF & BTEI zurücknehmen 683 CLEAR L_STAT. CLEAR L_STAT_TAB. 684 L_STAT-INACT = 'X'. 685 L_STAT-STAT = 'I0219'. APPEND L_STAT TO L_STAT_TAB. "BTEI 686 L_STAT-STAT = 'I0220'. APPEND L_STAT TO L_STAT_TAB. "BEND 687 CALL FUNCTION 'STATUS_CHANGE_INTERN' 688 EXPORTING 689 OBJNR = P_QALS-OBJNR 690 TABLES 691 STATUS = L_STAT_TAB 692 EXCEPTIONS 693 ERROR_MESSAGE = 1. 694 IF SY-SUBRC <> 0. 695 MESSAGE ID SY-MSGID TYPE 'S' NUMBER SY-MSGNO 696 WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4. 697 SUBMIT (SY-REPID) VIA SELECTION-SCREEN. 698 ENDIF. 699 */Prüflos aktualisieren 700 CALL FUNCTION 'QPL1_UPDATE_MEMORY' 701 EXPORTING 702 I_QALS = P_QALS 703 I_UPDKZ = L_UPDKZ. 704 CALL FUNCTION 'QPL1_INSPECTION_LOTS_POSTING' 705 EXPORTING 706 I_MODE = '1'. 707 CALL FUNCTION 'STATUS_UPDATE_ON_COMMIT'. 708 */QAMB initialisieren 709 CALL FUNCTION 'QAMB_REFRESH_DATA'. 710 PERFORM UPDATE_QAMB ON COMMIT. 711 P_SUBRC = 0. 712 ENDFORM. " POST_DATA 713 *----------------------------------------------------------------------* 714 * Form UPDATE_QAMB * 715 *----------------------------------------------------------------------* 716 * Update auf QAMB * 717 *----------------------------------------------------------------------* 718 FORM UPDATE_QAMB. 719 CALL FUNCTION 'QEVA_QAMB_CANCEL' IN UPDATE TASK 720 EXPORTING 721 T_QAMB_TAB = G_QAMB_VB_TAB. 722 ENDFORM. " UPDATE_QAMB 723 *----------------------------------------------------------------------* 724 * Form CHECK_MSEG * 725 *----------------------------------------------------------------------* 726 * MSEGs prüfen * 727 *----------------------------------------------------------------------* 728 FORM CHECK_MSEG USING P_MSEG_TAB TYPE T_MSEG_TAB 729 P_QAMB_TAB TYPE QAMBTAB 730 P_SUBRC LIKE SY-SUBRC. 731 DATA: 732 L_MSEG_STOR_TAB LIKE MSEG OCCURS 0 WITH HEADER LINE. 733 CLEAR: P_SUBRC. 734 */Zeilen bereits storniert? 735 SELECT MBLNR MJAHR ZEILE SMBLN SJAHR SMBLP 736 FROM MSEG INTO CORRESPONDING FIELDS OF TABLE L_MSEG_STOR_TAB 737 FOR ALL ENTRIES IN P_MSEG_TAB 738 WHERE SMBLN EQ P_MSEG_TAB-MBLNR 739 AND SJAHR EQ P_MSEG_TAB-MJAHR 740 AND SMBLP EQ P_MSEG_TAB-ZEILE. 741 IF SY-SUBRC IS INITIAL. 742 LOOP AT L_MSEG_STOR_TAB. 743 DELETE P_MSEG_TAB WHERE MBLNR = L_MSEG_STOR_TAB-SMBLN 744 AND MJAHR = L_MSEG_STOR_TAB-SJAHR 745 AND ZEILE = L_MSEG_STOR_TAB-SMBLP. 746 DELETE P_QAMB_TAB WHERE MBLNR = L_MSEG_STOR_TAB-SMBLN 747 AND MJAHR = L_MSEG_STOR_TAB-SJAHR 748 AND ZEILE = L_MSEG_STOR_TAB-SMBLP. 749 ENDLOOP. 750 IF P_MSEG_TAB[] IS INITIAL. 751 P_SUBRC = 4. 752 EXIT. 753 ENDIF. 754 ENDIF. 755 ENDFORM. " CHECK_MSEG 756 *----------------------------------------------------------------------* 757 * Form CHECK_MKPF * 758 *----------------------------------------------------------------------* 759 * Materialbelege prüfen (Wurde durch VE-Buchung Prüfllos erzeugt?* 760 *----------------------------------------------------------------------* 761 FORM CHECK_MKPF USING P_MKPF_TAB TYPE T_MKPF_TAB 762 P_SUBRC LIKE SY-SUBRC. 763 DATA: 764 L_MKPF_TAB TYPE T_MKPF_TAB. 765 CLEAR: P_SUBRC. 766 SELECT MBLNR FROM QAMB INTO CORRESPONDING FIELDS OF TABLE L_MKPF_TAB 767 FOR ALL ENTRIES IN P_MKPF_TAB 768 WHERE MBLNR EQ P_MKPF_TAB-MBLNR 769 AND MJAHR EQ P_MKPF_TAB-MJAHR 770 AND TYP = '1'. 771 IF SY-SUBRC IS INITIAL. 772 P_SUBRC = 4. 773 ENDIF. 774 ENDFORM. " CHECK_MKPF
在执行ZRQEVAC50时还需要在OMJJ中做配置，具体可参考SAP note中的说明。
参考https://blogs.sap.com/2014/01/22/reversal-of-usage-decision-and-stock-posting-of-inspection-lot/。
原创声明：转载或引用请务必@SAP蛋妞 Daniel-胡莲舟
