* ********************************************************** ************* FANUO856ALLIF E Disk Rename (ANUO856ALL: INPUT_FMT) f recno (rrn) FQAN856 UF AF 600 Disk Block (* no) FQADSPFFD IF E DISK FBOLRESULT IF E DISK RENAME (BolResult: BOL_RESULT) FASN001D2 CF E WORKSTN * DINPUT_REC DS D REC_TYPE 1 3 D BOL_NO 44 51 D S01_SHIP_TO_ID 338 354 DRRN 9P 0 INZ (0) * * DOUTPUT_REC DS D OREC_TYPE 1 3 D O01_CUST_DEPT 97 103 D O01_BILL_TO_ID 178 194 D O01_MARKFOR_ID 195 211 * = ============================================================================================================================================================================================================= ============= iqasn856 aa 05 i 1 600 OUTPUT_REC IINPUT_FMT I ANUO856ALL INPUT_REC IBOL_RESUSED I ANUO856ALL UNUSED_FLD * ============================================== ====================
* MAIN PROCESS * C MOVEL * BLANKS FUNC_ID 1 C MOVEL * BLANKS FIRST_TIME 1 C MOVEL * BLANKS FOUND_BOL 1 C MOVEL * BLANKS FOUND_H01 1 C MOVEL * BLANKS VAR_SHIP_TO_ID 17 C MOVEL * BLANKS WRITE_NEW 1 C MOVEL (P) * ALL'0 ' STR_ZEROS 35 C Movel * Blanks ftpsuccess 1 C Z-Add * Zeros TestResult 11 1 c Clear Errmsg C Eval OvrwRT = 'N' c Eval Updflg = 'N' * C * Entry PLIST C PARM Bolno 7 C Parm Opt 1 * C EXSR # Screen_b * c evAl * inlR = * on * ======================================== ================================================================================================================================================================================ =====================================
=== c #Screen_B Begsr * c * IN02 Doweq * Off C exfmt rcdfmtb c Eval Opt = 'n' c SELECT C * IN02 WHENEQ * ON C EXSR # clrasn856 C Leave C * IN07 WHENEQ * ON C Eval Opt = '7' C Leave C * IN05 WHENEQ * ON C EXSR #CHK_SCRB C IF * IN60 = * OFF C Exsr #Update C Eval * IN60 = * ON C Eval errmsg = bolno c 'Has Been Updated SuccessFully. 'C endif c * IN08 WHENEQ * ON C CALL' ASN 003C1 'C PARM' 8 'FUNC_ID C * IN09 WHENEQ * ON C * FEOD QASN856 C Call' ASN003C1 'C PARM' 9 'FUNC_ID C * IN20 WHENEQ * ON C EXSR #CHK_SCRB C if * IN60 = * OFF C EXSR #Update C call 'Asnftp' C Parm * Blank ftpsuccess c if ftpsuccess <> 'y' c evAl * in60 =
* On c evar errmsg = 'ftp to edi failed.' C else c evAl * IN60 = * ON C evaler = 'ftp to edi success,' ftif c Endif C Other C Exsr #CHK_SCRB C endsl c enddo * c endsr * =========================================================================================================================================================================================== =============== ** * =============================== ========================================================================== Clear WHFLDP C CLEAR WHFDEC CSETOFF 4041 * C IF fldnam = * blanks and fldVal <> * Blanks c evAl * in60 = * on c eval * IN40 =
* On c evar errmsg = 'please input update field.' C endif c if Fldnam <> * blanks and fldval = * blanks c ev at * IN60 = * on c evval * in41 = * on c evataMSG = 'please input Correct Value . 'C ENDIF C IF * IN60 = * OFF AND FLDNAM <> * BLANKS C 1 SETLL QADSPFFD C READ QADSPFFD 61 C * IN61 DOWEQ * OFF C IF WHFLDE = FLDNAM C EVAL WHFDEC = WHFTXT C LEAVE C ENDIF C READ QADSPFFD 61 C Enddo c endif c iffdec = * blanks and * in60 = * OFF C And FldNam <> * Blanks C Clear WHFOB C CLEAR WHFLDT C CLEAR WHFDB C clear WHFLDP C CLEAR WHFDEC C EVAL * IN60 = * ON C Eval * IN40 = * ON C evAl errmsg = 'please input valid field,' c 'F8 For Inquiry. 'c endif * c evAl testResult =
* Zeros C if WHFLDT <> A 'and WHFLDT <> * Blank C Monitor C EVAL TestResult =% DEC (% Trim (FLDVAL): 11: 1) C on-Error * All c evAl * IN60 = * ON C Eval * IN41 = * ON C evar errmsg = fldnam 'is not a character field.' C endmon c endif * c if FldNam = 'fd0001' c eval * IN60 = * ON C Eval * IN40 = * ON C evalerMsg = ' NOT ALOW TO MODIFY THE FD0001. 'C endif * c endsr * ====================================== ============================ ** * * ========================================================================================================================================= ====================================================== ** C # Update begsr * c evAl write_new = 'y'
* C 1 CHAIN QASN856 62 C * IN62 DOWEQ * OFF C IF OREC_TYPE = 'O01' C EXSR # UPDO01 C UPDATE QASN856 OUTPUT_REC C EVAL WRITE_NEW = 'N' C LEAVE C ENDIF C READ QASN856 62 C ENDDO * C IF WRITE_NEW = ' Y 'C Read Bolresult 72 C Eval RRN = SEL1 C Eval Found_bol =' N 'c Eval Found_H01 =' N '* C RRN CHAIN ANUO856ALL 70 C #Readf Tag C * In70 Doweq * Off * c Eval Output_rec = INPUT_REC * C If FOUND_BOL = 'Y' and REC_TYPE <> 'H01' C and Found_H01 = 'N' c Readp ANUO856ALL 70 C GOTO #Readf C Endif * C if Found_bol = 'Y' and REC_TYPE = 'H01' C if Found_H01 = 'Y 'C Leave C Else C Eval Found_H01 =' Y '
C ENDIF C ENDIF * C IF REC_TYPE = 'S01' AND FOUND_BOL = 'N' C IF BOL_NO = BOLNO C EVAL VAR_SHIP_TO_ID = S01_SHIP_TO_ID C EVAL FOUND_BOL = 'Y' C EVAL FOUND_H01 = 'N' C READP ANUO856ALL 70 C GOTO #READF C ELSE C EVAL * IN60 = * ON C EVAL ERRMSG = 'Can not found corresponding BOLNO.' C LEAVE C ENDIF C ENDIF * C IF REC_TYPE = 'O01' AND FOUND_BOL = 'Y' C EXSR # UPDO01 C ENDIF * C WRITE QASN856 Output_rec * c Read Anuo856all 70 c Enddo * c endif * c endsr * * ======================================== ========================= ** * * ============================================================================================================================================================= ================
=========================== ** c # clrasn856 begsr * c 1 setll qasn856 c r2556 70 c * in70 Doweq * Off C delete QASN856 70 c readdo * c endsr * ======================================== ========================== ** * * =============================================================================================================================================================================================== ==================================================== ** c # Updo01 begsr * C if Updflg = 'y' c eval = var_ship_to_id c evAl = var_markfor_id = var_ship_to_id c endif * c if WHFLDT <> * Blanks c if WHFLDT = 'a' c if% Subst (Output_Rec: WH FOBO: WHFLDB) = c * blanks or ovrwrt = 'y'
