× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  1.  Home
  2. MAPICS-L
  3. September 2007

Re: source code for AMBFMPFP

1) Typically it is the support site to get the latest. Often you use the
matching RPG and the source contains the DDS too.
2) You can also have a look at the install CD's (original and cumpacks)
3) As you did, ask the forum, I've attached the R7 version, I think it is
still the latest and I've added the matching RPG. I sent them to your
address too, since the forum strips attachments.

Just an additional thought: since the source you request is the Acknowledge
layout, you may want to consider using the special print user exit of the
acknowledge. It facilitates later upgrades if the layout is in "your"
section instead of the MAPICS sources. Just juggle some parameters and
activate the user exit.
I am pleased to know there are other R7's around like us (on PTF5700) and
would like to stay in touch as I indicated earlier on this forum.

Kind regards


Kris


-----Original Message-----
From: mapics-l-bounces@xxxxxxxxxxxx [mailto:mapics-l-bounces@xxxxxxxxxxxx]
On Behalf Of Weston Wheat
Sent: vrijdag 21 september 2007 0:48
To: mapics-l@xxxxxxxxxxxx
Subject: [MAPICS-L] source code for AMBFMPFP

Hello Group.
I am looking for the source code for the print file AMBFMPFP.
Any ideas how I might get my hands on that code?
We are at R7 PTF level 5132.

Thanks

Weston Wheat
Information Systems Manager
Quality Thermistor Inc
208-377-3373 ext 115
wwheat@xxxxxxxxxxxxxx
www.thermistor.com <http://www.thermistor.com/>

F*******************************************************************
F* MODULE NAME- AMBFMPFR *
F* DESCRIPTION- PRT:Acknowledgement Print file *
F* *
F* 5733-M79 THIS MODULE IS "RESTRICTED MATERIAL OF MAPICS, INC." *
F* (C) COPYRIGHT MAPICS, INC. 1997 *
F* LICENSED MATERIALS - PROPERTY OF MAPICS, INC. *
F* REFER TO COPYRIGHT INSTRUCTIONS FORM NUMBER G120-2083 *
F* *
F* VERSION 02/MODIFICATION 07 PTF Z *
F* DATE 09/12/01 *
F* APARS/PTFS APPLIED - SCXXXXX/Z *
F* *
F*******************************************************************
H/TITLE PRT:Acknowledgement Print file
H Y
Z* CRTRPGPGM
Z* CVTOPT(*DATETIME) OPTION(*SRCDBG)
W* Warning: This program does not set on the LR indicator
*================================================================
M* Maintenance :
*================================================================
FMBVLLSL0IF E K DISK
* Values list details file
FMBA5RES1IF E K DISK
* RTV : Company Retrieval index
FMBC6RES3IF E K DISK
* RTV : Quote/Order Header Retrieval with Virtuals
FMZIWRES2IF E K DISK
* RSQ : EDI trading partner RSQ: by Company/Customer
FMBJURES1IF E K DISK
* RTV : EC Document/Media XREF Retrieval index
FMBBVRES1IF E K DISK
* RTV : Header Type Retrieval index
FMBDYRES0IF E K DISK
* RTV : Terms Retrieval index
FCURRIDS1IF E K DISK
* RTV : Currency Retrieval index
FMBBFRES0IF E K DISK
* RTV : Customer Retrieval index
FMBDERES2IF E K DISK
* RSQ : Ship to By ship to number
FMBALRES1IF E K DISK
* RTV : Address Retrieval index
FMBALRES3IF E K DISK
* RSQ : Address By Co#/Cust#/Type/Code
FMBBCCPS1IF E K DISK
* RTV : Credit Memo Extension Retrieval index
FMBGACPS6IF E K DISK
* RSQ : History Comment Shipment header only
FMBGACPS9IF E K DISK
* RSQ : History Comment Co/Invoice/User Ref/Seq
FMBGACPS1IF E K DISK
* RTV : History Comment Retrieval index
FMBDHRES1IF E K DISK
* RTV : Shipment Header Retrieval index
FMBCDRESNIF E K DISK
* RSQ : Line Item By Order/User Seq/Sys Se
FMBDMCPS1IF E K DISK
* RTV : Substitution XREF Retrieval index
FITEMASS1IF E K DISK
* RTV : ITEM MASTER Retrieval index
FMBB2CPS0IF E K DISK
* RTV : Item Master Extension Retrieval index
FMBCHRES0IF E K DISK
* RTV : Non-Inventoried Item Retrieval index
FITEMBLS1IF E K DISK
* RTV : ITEM BALANCE Retrieval index
FMBB6CPS1IF E K DISK
* RTV : Item/Industry Class XREF Retrieval index
FITMLANS1IF E K DISK
* RTV : ITEM FOREIGN LANGUAGE Retrieval index
FMBDERES1IF E K DISK
* RTV : Ship to Retrieval index
FMBADRES1IF E K DISK
* RTV : Release Retrieval index
FWHSMSTS1IF E K DISK
* RTV : WAREHOUSE MASTER Retrieval index
FMBAQRES3IF E K DISK
* RSQ : Calendar Day Retrieval descending
FMBAQRES4IF E K DISK
* RSQ : Calendar Day Rtv Work Days (D)
FCALNDRS2IF E K DISK
* RSQ : CALENDARX (old assim) RTV: Descending sequence
FMBACRES1IF E K DISK
* RTV : Line Item Feature/Option Retrieval index
FMBCARES1IF E K DISK
* RTV : Kit Component Retrieval index
FMBADRES4IF E K DISK
* RSQ : Release Descending Release seq.
FMBADRESBIF E K DISK
* RTV : Release Retrieval with virtuals
FMBGACPS8IF E K DISK
* RSQ : History Comment Shipment hdr/release/lan
FMBGFCPS3IF E K DISK
* RSQ : Historical Tax By Shipment release
FMBF9CPS5IF E K DISK
* RSQ : History Special Charge By Co/invoice/seq
FMBF9CPS0IF E K DISK
* RTV : History Special Charge Retrieval index
FMBGACPS7IF E K DISK
* RSQ : History Comment by Co/Inv./Seq/Lang/Seq
FMBGFCPS5IF E K DISK
* RSQ : Historical Tax By Special charge
FMBGFCPS1IF E K DISK
* RTV : Historical Tax Retrieval index
FMBGFCPS4IF E K DISK
* RSQ : Historical Tax By Co/Invoice/Sequence
FMBLJRES1IF E K DISK
* RTV : Quote/Order Euro Xref Retrieval index
FMBC7RES1IF E K DISK
* RTV : Quote/Order Spec Charge Retrieval index
FAMBFMPFPO E 97 PRINTER
F KINFDS INFDS$
* PRT: PRT:Acknowledgement Print file
* Long constants
E @C01 1 2 20 4
* Long constants
E @C02 1 2 19 4
* Long constants
E @C03 1 2 15 3
* Long constants
E @C04 1 2 21 2
E YK01 5 11 A Currency File D
E YK02 1 6 A SYSCTL XMREPT f
E YK03 9999 12 A History Special
E YK04 9999 8 A History Special
E YK05 9999 8 A Historical Tax
IFALREZM
* Address By Co#/Cust#/Type/Code
* Renamed input format fields
I ALAENB WAAENB
I ALCANB WACANB
I ALCUCD WACUCD
I ALE2ST WAE2ST
I ALCLTX WACLTX
I ALCMTX WACMTX
I ALCNTX WACNTX
I ALCOTX WACOTX
I ALZ9HH WAZ9HH
I ALZ9HG WAZ9HG
I ALCVCD WACVCD
I ALCPTX WACPTX
I ALCQTX WACQTX
I ALCRTX WACRTX
I ALCSTX WACSTX
I ALCDTX WACDTX
I ALZ9PB WAZ9PB
I ALZ9PA WAZ9PA
I ALCOCD WACOCD
I ALBYCD WABYCD
I ALG5CD WAG5CD
I ALBKCD WABKCD
I ALALDT WAALDT
I ALABTM WAABTM
I ALAFVN WAAFVN
I ALAGVN WAAGVN
I ALAMDT WAAMDT
I ALACTM WAACTM
I ALAHVN WAAHVN
I ALAIVN WAAIVN
IFGACPLS
* History Comment Co/Invoice/User Ref/Seq
* Renamed input format fields
I GAAENB WBAENB
I GAGGNB WBGGNB
I GAHYNB WBHYNB
I GAKBNB WBKBNB
I GAAKCD WBAKCD
I GAAAD9 WBAAD9
I GAHDTX WBHDTX
I GAHXCD WBHXCD
I GADCCD WBDCCD
I GACVNB WBCVNB
I GAK4NB WBK4NB
I GAAFAD WBAFAD
I GALCNB WBLCNB
I GAAASZ WBAASZ
I GAAAD2 WBAAD2
I GAAD1N WBAD1N
I GAALDT WBALDT
I GAABTM WBABTM
I GAAFVN WBAFVN
I GAAGVN WBAGVN
IFGACPYO
* History Comment Retrieval index
* Renamed input format fields
I GAAENB WCAENB
I GAGGNB WCGGNB
I GAHYNB WCHYNB
I GAKBNB WCKBNB
I GAAKCD WCAKCD
I GAAAD9 WCAAD9
I GAHDTX WCHDTX
I GAHXCD WCHXCD
I GADCCD WCDCCD
I GACVNB WCCVNB
I GAK4NB WCK4NB
I GAAFAD WCAFAD
I GALCNB WCLCNB
I GAAASZ WCAASZ
I GAAAD2 WCAAD2
I GAAD1N WCAD1N
I GAALDT WCALDT
I GAABTM WCABTM
I GAAFVN WCAFVN
I GAAGVN WCAGVN
IFPMASB0
* Ship to Retrieval index
* Renamed input format fields
I DEAENB WDAENB
I DECANB WDCANB
I DEB9CD WDB9CD
I DECPNB WDCPNB
I DEHITX WDHITX
I DEAPPC WDAPPC
I DEAA9L WDAA9L
I DEE2ST WDE2ST
I DEAD0V WDAD0V
I DEAD0Z WDAD0Z
I DEAFCW WDAFCW
I DEUUSA WDUUSA
I DEUUCA WDUUCA
I DEUUCB WDUUCB
I DEUUCC WDUUCC
I DEUUD1 WDUUD1
I DEUU40 WDUU40
I DEAFFA WDAFFA
I DEZ93M WDZ93M
I DEZ95V WDZ95V
I DEZ95W WDZ95W
I DEZ0J7 WDZ0J7
I DEBNST WDBNST
I DECUCD WDCUCD
I DEBHST WDBHST
I DEBXCD WDBXCD
I DEC7CD WDC7CD
I DEAAB4 WDAAB4
I DEAABZ WDAABZ
I DEAAB6 WDAAB6
I DEADR6 WDADR6
I DEF1CD WDF1CD
I DECHNB WDCHNB
I DEA3CD WDA3CD
I DEZ0J8 WDZ0J8
I DEALDT WDALDT
I DEABTM WDABTM
I DEAFVN WDAFVN
I DEAGVN WDAGVN
I DEAMDT WDAMDT
I DEACTM WDACTM
I DEAHVN WDAHVN
I DEAIVN WDAIVN
IFAQRELH
* Calendar Day Rtv Work Days (D)
* Renamed input format fields
I AQGSCD WEGSCD
I AQC2NB WEC2NB
I AQHFST WEHFST
I AQHGST WEHGST
I AQALDT WEALDT
I AQABTM WEABTM
I AQAFVN WEAFVN
I AQAGVN WEAGVN
I AQAMDT WEAMDT
I AQACTM WEACTM
I AQAHVN WEAHVN
I AQAIVN WEAIVN
IFADRECD
* Release Descending Release seq.
* Renamed input format fields
I ADAENB WGAENB
I ADDCCD WGDCCD
I ADCVNB WGCVNB
I ADFCNB WGFCNB
I ADAA26 WGAA26
I ADAA27 WGAA27
I ADHJTX WGHJTX
I ADH2TX WGH2TX
I ADDRNB WGDRNB
I ADAASZ WGAASZ
I ADCACD WGCACD
I ADHFCD WGHFCD
I ADIIST WGIIST
I ADIJST WGIJST
I ADBIDT WGBIDT
I ADAIDT WGAIDT
I ADK3NB WGK3NB
I ADDZVA WGDZVA
I ADIKST WGIKST
I ADBJDT WGBJDT
I ADAJDT WGAJDT
I ADAKDT WGAKDT
I ADAQQT WGAQQT
I ADAAN6 WGAAN6
I ADAASL WGAASL
I ADILST WGILST
I ADAABW WGAABW
I ADAAN7 WGAAN7
I ADICST WGICST
I ADAAPG WGAAPG
I ADEJST WGEJST
I ADZ93N WGZ93N
I ADZ93T WGZ93T
I ADCANB WGCANB
I ADZ08D WGZ08D
I ADZ08F WGZ08F
I ADAFVL WGAFVL
I ADAF79 WGAF79
I ADAF70 WGAF70
I ADAITX WGAITX
I ADALTX WGALTX
I ADCQCD WGCQCD
I ADA4NB WGA4NB
I ADA5NB WGA5NB
I ADBUCD WGBUCD
I ADK0NB WGK0NB
I ADA3CD WGA3CD
I ADCKTX WGCKTX
I ADALDT WGALDT
I ADABTM WGABTM
I ADAFVN WGAFVN
I ADAGVN WGAGVN
I ADAMDT WGAMDT
I ADACTM WGACTM
I ADAHVN WGAHVN
I ADAIVN WGAIVN
I ADJ9VA WGJ9VA
I ADJ8NB WGJ8NB
IFADREMC
* Release Retrieval with virtuals
* Renamed input format fields
I ADAENB WHAENB
I ADDCCD WHDCCD
I ADCVNB WHCVNB
I ADFCNB WHFCNB
I ADAA26 WHAA26
I ADAA27 WHAA27
I ADHJTX WHHJTX
I ADH2TX WHH2TX
I ADDRNB WHDRNB
I ADAASZ WHAASZ
I ADCACD WHCACD
I ADHFCD WHHFCD
I ADIIST WHIIST
I ADIJST WHIJST
I ADBIDT WHBIDT
I ADAIDT WHAIDT
I ADK3NB WHK3NB
I ADDZVA WHDZVA
I ADIKST WHIKST
I ADBJDT WHBJDT
I ADAJDT WHAJDT
I ADAKDT WHAKDT
I ADAQQT WHAQQT
I ADAAN6 WHAAN6
I ADAASL WHAASL
I ADILST WHILST
I ADAABW WHAABW
I ADAAN7 WHAAN7
I ADICST WHICST
I ADAAPG WHAAPG
I ADEJST WHEJST
I ADZ93N WHZ93N
I ADZ93T WHZ93T
I ADCANB WHCANB
I ADZ08D WHZ08D
I ADZ08F WHZ08F
I ADAFVL WHAFVL
I ADAF79 WHAF79
I ADAF70 WHAF70
I ADAITX WHAITX
I ADALTX WHALTX
I ADCQCD WHCQCD
I ADA4NB WHA4NB
I ADA5NB WHA5NB
I ADBUCD WHBUCD
I ADK0NB WHK0NB
I ADA3CD WHA3CD
I ADCKTX WHCKTX
I ADALDT WHALDT
I ADABTM WHABTM
I ADAFVN WHAFVN
I ADAGVN WHAGVN
I ADAMDT WHAMDT
I ADACTM WHACTM
I ADAHVN WHAHVN
I ADAIVN WHAIVN
IFGACPWJ
* History Comment Shipment hdr/release/lan
* Renamed input format fields
I GAAENB WIAENB
I GAGGNB WIGGNB
I GAHYNB WIHYNB
I GAKBNB WIKBNB
I GAAKCD WIAKCD
I GAAAD9 WIAAD9
I GAHDTX WIHDTX
I GAHXCD WIHXCD
I GADCCD WIDCCD
I GACVNB WICVNB
I GAK4NB WIK4NB
I GAAFAD WIAFAD
I GALCNB WILCNB
I GAAASZ WIAASZ
I GAAAD2 WIAAD2
I GAAD1N WIAD1N
I GAALDT WIALDT
I GAABTM WIABTM
I GAAFVN WIAFVN
I GAAGVN WIAGVN
IFF9CPYI
* History Special Charge Retrieval index
* Renamed input format fields
I F9AENB WMAENB
I F9GGNB WMGGNB
I F9HYNB WMHYNB
I F9AAD2 WMAAD2
I F9GTCD WMGTCD
I F9BLST WMBLST
I F9BXTX WMBXTX
I F9AA73 WMAA73
I F9DDVA WMDDVA
I F9AAD4 WMAAD4
I F9DEVA WMDEVA
I F9AAD6 WMAAD6
I F9AAD7 WMAAD7
I F9AAD5 WMAAD5
I F9AAD8 WMAAD8
I F9AABT WMAABT
I F9AD0R WMAD0R
I F9Z9H5 WMZ9H5
I F9Z9JD WMZ9JD
I F9Z9QD WMZ9QD
I F9Z9QF WMZ9QF
I F9DCCD WMDCCD
I F9CVNB WMCVNB
I F9K4NB WMK4NB
I F9AFAD WMAFAD
I F9LCNB WMLCNB
I F9AASZ WMAASZ
I F9ALDT WMALDT
I F9ABTM WMABTM
I F9AFVN WMAFVN
I F9AGVN WMAGVN
IFGACPUT
* History Comment by Co/Inv./Seq/Lang/Seq
* Renamed input format fields
I GAAENB WOAENB
I GAGGNB WOGGNB
I GAHYNB WOHYNB
I GAKBNB WOKBNB
I GAAKCD WOAKCD
I GAAAD9 WOAAD9
I GAHDTX WOHDTX
I GAHXCD WOHXCD
I GADCCD WODCCD
I GACVNB WOCVNB
I GAK4NB WOK4NB
I GAAFAD WOAFAD
I GALCNB WOLCNB
I GAAASZ WOAASZ
I GAAAD2 WOAAD2
I GAAD1N WOAD1N
I GAALDT WOALDT
I GAABTM WOABTM
I GAAFVN WOAFVN
I GAAGVN WOAGVN
IFGFCPWL
* Historical Tax By Special charge
* Renamed input format fields
I GFAENB WRAENB
I GFGGNB WRGGNB
I GFHYNB WRHYNB
I GFACHG WRACHG
I GFAAG2 WRAAG2
I GFG0ST WRG0ST
I GFAAG1 WRAAG1
I GFJUNB WRJUNB
I GFJTNB WRJTNB
I GFG3ST WRG3ST
I GFZ0D6 WRZ0D6
I GFG2ST WRG2ST
I GFG1ST WRG1ST
I GFG1VA WRG1VA
I GFGZVA WRGZVA
I GFG0VA WRG0VA
I GFGYVA WRGYVA
I GFJ3VA WRJ3VA
I GFACHH WRACHH
I GFJSNB WRJSNB
I GFAAG3 WRAAG3
I GFACHJ WRACHJ
I GFZ9T1 WRZ9T1
I GFZ9VA WRZ9VA
I GFZ9T2 WRZ9T2
I GFZ9T3 WRZ9T3
I GFZ9T4 WRZ9T4
I GFZ9T5 WRZ9T5
I GFZ9VB WRZ9VB
I GFZ9T6 WRZ9T6
I GFZ9T7 WRZ9T7
I GFZ9VC WRZ9VC
I GFZ9VD WRZ9VD
I GFZ9VF WRZ9VF
I GFZ9T8 WRZ9T8
I GFZ9T9 WRZ9T9
I GFZ9T0 WRZ9T0
I GFZ9VH WRZ9VH
I GFZ9VJ WRZ9VJ
I GFZ9VK WRZ9VK
I GFZ9VL WRZ9VL
I GFZ9VR WRZ9VR
I GFZ9VS WRZ9VS
I GFZ9VT WRZ9VT
I GFZ9VV WRZ9VV
I GFZ9VW WRZ9VW
I GFZ9VX WRZ9VX
I GFZ9VM WRZ9VM
I GFZ9VN WRZ9VN
I GFZ9VP WRZ9VP
I GFZ9VQ WRZ9VQ
I GFZ9VY WRZ9VY
I GFZ9VZ WRZ9VZ
I GFZ9V1 WRZ9V1
I GFCHGU WRCHGU
I GFCHGN WRCHGN
I GFOFFU WROFFU
I GFOFFN WROFFN
I GFAJCD WRAJCD
I GFZ9H5 WRZ9H5
I GFZ9WV WRZ9WV
I GFB9CD WRB9CD
I GFZ9WW WRZ9WW
I GFAITX WRAITX
I GFZ9N0 WRZ9N0
I GFGTCD WRGTCD
I GFA3CD WRA3CD
I GFZ9WX WRZ9WX
I GFANCD WRANCD
I GFZ9WY WRZ9WY
I GFZ9WZ WRZ9WZ
I GFDCCD WRDCCD
I GFCVNB WRCVNB
I GFK4NB WRK4NB
I GFLCNB WRLCNB
I GFAASZ WRAASZ
I GFAFAD WRAFAD
I GFAAD2 WRAAD2
I GFZ9WH WRZ9WH
I GFZ9ZY WRZ9ZY
I GFAHPC WRAHPC
I GFZ9ZZ WRZ9ZZ
I GFALDT WRALDT
I GFABTM WRABTM
I GFAFVN WRAFVN
I GFAGVN WRAGVN
IFGFCPYL
* Historical Tax Retrieval index
* Renamed input format fields
I GFAENB WTAENB
I GFGGNB WTGGNB
I GFHYNB WTHYNB
I GFACHG WTACHG
I GFAAG2 WTAAG2
I GFG0ST WTG0ST
I GFAAG1 WTAAG1
I GFJUNB WTJUNB
I GFJTNB WTJTNB
I GFG3ST WTG3ST
I GFZ0D6 WTZ0D6
I GFG2ST WTG2ST
I GFG1ST WTG1ST
I GFG1VA WTG1VA
I GFGZVA WTGZVA
I GFG0VA WTG0VA
I GFGYVA WTGYVA
I GFJ3VA WTJ3VA
I GFACHH WTACHH
I GFJSNB WTJSNB
I GFAAG3 WTAAG3
I GFACHJ WTACHJ
I GFZ9T1 WTZ9T1
I GFZ9VA WTZ9VA
I GFZ9T2 WTZ9T2
I GFZ9T3 WTZ9T3
I GFZ9T4 WTZ9T4
I GFZ9T5 WTZ9T5
I GFZ9VB WTZ9VB
I GFZ9T6 WTZ9T6
I GFZ9T7 WTZ9T7
I GFZ9VC WTZ9VC
I GFZ9VD WTZ9VD
I GFZ9VF WTZ9VF
I GFZ9T8 WTZ9T8
I GFZ9T9 WTZ9T9
I GFZ9T0 WTZ9T0
I GFZ9VH WTZ9VH
I GFZ9VJ WTZ9VJ
I GFZ9VK WTZ9VK
I GFZ9VL WTZ9VL
I GFZ9VR WTZ9VR
I GFZ9VS WTZ9VS
I GFZ9VT WTZ9VT
I GFZ9VV WTZ9VV
I GFZ9VW WTZ9VW
I GFZ9VX WTZ9VX
I GFZ9VM WTZ9VM
I GFZ9VN WTZ9VN
I GFZ9VP WTZ9VP
I GFZ9VQ WTZ9VQ
I GFZ9VY WTZ9VY
I GFZ9VZ WTZ9VZ
I GFZ9V1 WTZ9V1
I GFCHGU WTCHGU
I GFCHGN WTCHGN
I GFOFFU WTOFFU
I GFOFFN WTOFFN
I GFAJCD WTAJCD
I GFZ9H5 WTZ9H5
I GFZ9WV WTZ9WV
I GFB9CD WTB9CD
I GFZ9WW WTZ9WW
I GFAITX WTAITX
I GFZ9N0 WTZ9N0
I GFGTCD WTGTCD
I GFA3CD WTA3CD
I GFZ9WX WTZ9WX
I GFANCD WTANCD
I GFZ9WY WTZ9WY
I GFZ9WZ WTZ9WZ
I GFDCCD WTDCCD
I GFCVNB WTCVNB
I GFK4NB WTK4NB
I GFLCNB WTLCNB
I GFAASZ WTAASZ
I GFAFAD WTAFAD
I GFAAD2 WTAAD2
I GFZ9WH WTZ9WH
I GFZ9ZY WTZ9ZY
I GFAHPC WTAHPC
I GFZ9ZZ WTZ9ZZ
I GFALDT WTALDT
I GFABTM WTABTM
I GFAFVN WTAFVN
I GFAGVN WTAGVN
IFGFCPPL
* Historical Tax By Co/Invoice/Sequence
* Renamed input format fields
I GFAENB WVAENB
I GFGGNB WVGGNB
I GFHYNB WVHYNB
I GFACHG WVACHG
I GFAAG2 WVAAG2
I GFG0ST WVG0ST
I GFAAG1 WVAAG1
I GFJUNB WVJUNB
I GFJTNB WVJTNB
I GFG3ST WVG3ST
I GFZ0D6 WVZ0D6
I GFG2ST WVG2ST
I GFG1ST WVG1ST
I GFG1VA WVG1VA
I GFGZVA WVGZVA
I GFG0VA WVG0VA
I GFGYVA WVGYVA
I GFJ3VA WVJ3VA
I GFACHH WVACHH
I GFJSNB WVJSNB
I GFAAG3 WVAAG3
I GFACHJ WVACHJ
I GFZ9T1 WVZ9T1
I GFZ9VA WVZ9VA
I GFZ9T2 WVZ9T2
I GFZ9T3 WVZ9T3
I GFZ9T4 WVZ9T4
I GFZ9T5 WVZ9T5
I GFZ9VB WVZ9VB
I GFZ9T6 WVZ9T6
I GFZ9T7 WVZ9T7
I GFZ9VC WVZ9VC
I GFZ9VD WVZ9VD
I GFZ9VF WVZ9VF
I GFZ9T8 WVZ9T8
I GFZ9T9 WVZ9T9
I GFZ9T0 WVZ9T0
I GFZ9VH WVZ9VH
I GFZ9VJ WVZ9VJ
I GFZ9VK WVZ9VK
I GFZ9VL WVZ9VL
I GFZ9VR WVZ9VR
I GFZ9VS WVZ9VS
I GFZ9VT WVZ9VT
I GFZ9VV WVZ9VV
I GFZ9VW WVZ9VW
I GFZ9VX WVZ9VX
I GFZ9VM WVZ9VM
I GFZ9VN WVZ9VN
I GFZ9VP WVZ9VP
I GFZ9VQ WVZ9VQ
I GFZ9VY WVZ9VY
I GFZ9VZ WVZ9VZ
I GFZ9V1 WVZ9V1
I GFCHGU WVCHGU
I GFCHGN WVCHGN
I GFOFFU WVOFFU
I GFOFFN WVOFFN
I GFAJCD WVAJCD
I GFZ9H5 WVZ9H5
I GFZ9WV WVZ9WV
I GFB9CD WVB9CD
I GFZ9WW WVZ9WW
I GFAITX WVAITX
I GFZ9N0 WVZ9N0
I GFGTCD WVGTCD
I GFA3CD WVA3CD
I GFZ9WX WVZ9WX
I GFANCD WVANCD
I GFZ9WY WVZ9WY
I GFZ9WZ WVZ9WZ
I GFDCCD WVDCCD
I GFCVNB WVCVNB
I GFK4NB WVK4NB
I GFLCNB WVLCNB
I GFAASZ WVAASZ
I GFAFAD WVAFAD
I GFAAD2 WVAAD2
I GFZ9WH WVZ9WH
I GFZ9ZY WVZ9ZY
I GFAHPC WVAHPC
I GFZ9ZZ WVZ9ZZ
I GFALDT WVALDT
I GFABTM WVABTM
I GFAFVN WVAFVN
I GFAGVN WVAGVN
/EJECT
* Data structures:
IPGMDS ESDSY2PGDSPK
* Modified Program data structure
IJBDTTM DS
* Job date/time
I 1 70ZZJDT
I 1 10ZZJCC
I 2 30ZZJYY
I 4 50ZZJMM
I 6 70ZZJDD
I 8 130ZZJTM
I 8 90ZZJHH
I 10 110ZZJNN
I 12 130ZZJSS
* Outward parameters
IPARC DS 86
* RCD : SYSCTL API non-OEI rcds Retrieval index
* O : SYSCTL key error
I 1 6 PAZ80O
* O : *Return code
I 7 13 PARTN
* O : Address format
I 14 14 PAHYST
* O : More than one warehouse
I 15 15 PAZ80P
* O : Central warehouse
I 16 18 PAZ80Q
* O : Feature/option template
I 19 38 PAZ80R
* O : Feature/options
I 39 39 PAZ80S
* O : Sysctl user sequence
I 40 40 PAZ80T
* O : Seq for product structure
I 41 41 PAZ80U
* O : Cost cal method for acc
I 42 42 PAZ80V
* O : Inventory trans history
I 43 43 PAZ80W
* O : Quality control indicator
I 44 44 PAZ80X
* O : Batch lot indicator
I 45 45 PAZ80Y
* O : Goods received note ind
I 46 46 PAZ80Z
* O : FIFO control record
I 47 47 PAZ801
* O : Subdivision flag
I 48 48 PAZ802
* O : Allow negative loc qnty
I 49 49 PAZ803
* O : MPS start date
I P 50 530PAZ804
* O : Aggregation date
I P 54 570PAZ805
* O : Future aging
I 58 58 PAZ806
* O : taxing body
I 59 60 PAZ807
* O : IM installed
I 61 61 PAZ808
* O : PDM installed
I 62 62 PAZ809
* O : MRP installed
I 63 63 PAZ800
* O : MPSP installed
I 64 64 PAZ9AA
* O : FCST installed
I 65 65 PAZ9AB
* O : REP installed
I 66 66 PAZ9AC
* O : Multi-company indicator
I 67 67 PAZ9AD
* O : Fiscal period indicator
I 68 68 PAZ9AE
* O : Monthly periods defined
I 69 69 PAZ9AJ
* O : Before/after print
I 70 70 PAZ9AK
* O : Multi-currency support
I 71 71 PAZ9AL
* O : OEI GLI interface
I 72 72 PAZ9AM
* O : Billing & inventory inter
I 73 73 PAZ9AN
* O : Sales interface
I 74 74 PAZ9AO
* O : AR interface
I 75 75 PAZ9AP
* O : Delinquent period desig
I 76 76 PAAAT9
* O : Margin calculation method
I 77 77 PAAAZ3
* O : Order Entry Installed
I 78 78 PAABDV
* O : Entry time pricing
I 79 79 PAABYH
* O : Crossfoot quantities
I 80 80 PAABYJ
* O : Special charge 3 to SA
I 81 81 PAABYK
* O : Booking record option
I 82 82 PAABYL
* O : Generated demand in ATP
I 83 83 PAABYM
* O : Commission worksheet
I 84 84 PAABYN
* O : General ledger worksheet
I 85 85 PAABYP
* O : Shipped order history
I 86 86 PAABYQ
IINFDS$ E DSY2I$DSP
* Printer file information data structure
/EJECT
IXDINT DS
* Internal date
I 1 70XDINDT
I 1 30XDINYY
I 4 50XDINMM
I 6 70XDINDD
/EJECT
IXDEX DS
* External date
I 1 80XDEXDT
I 1 40XDEY01
I 1 20XDEX01
I 3 40XDEX02
I 5 80XDEY02
I 5 60XDEX03
I 7 80XDEX04
IYD01 DS
I 1 1 YI0101
I 2 30YI0102
I 4 6 YI0103
I 7 110YI01
IYM01 DS 5
I 1 1 WFACVX
I 2 30WFAENB
I 4 6 WFBRCD
I 7 21 WFA3TX
I 22 220WFAJNB
I 23 230WFAKNB
I 24 38 WFALNB
I 39 53 WFAMNB
I 54 582WFABVA
I 59 61 WFAALP
IYW01 DS
I 1 1 XAACVX
I 2 30XAAENB
I 4 6 XABRCD
I 7 21 XAA3TX
I 22 220XAAJNB
I 23 230XAAKNB
I 24 38 XAALNB
I 39 53 XAAMNB
I 54 582XAABVA
I 59 61 XAAALP
IYD02 DS
I 1 1 YI0201
I 2 60YI02
IYM02 DS 1
I 1 1 WJACVX
I 2 7 WJZ80O
I 8 8 WJADHJ
I 9 9 WJADHK
I 10 10 WJADHL
I 11 11 WJADHM
I 12 12 WJADHN
I 13 13 WJADHP
I 14 14 WJADHQ
I 15 15 WJADHR
I 16 16 WJADHS
I 17 17 WJADHT
I 18 18 WJADHV
I 19 19 WJADHW
I 20 20 WJADHY
I 21 21 WJADHZ
I 22 22 WJADH1
I 23 23 WJADH2
I 24 24 WJADH3
I 25 25 WJABW2
I 26 26 WJADH4
I 27 29 WJADH5
I 30 30 WJADH6
I 31 31 WJZ9AD
I 32 32 WJADH7
I 33 33 WJADH8
I 34 34 WJADH9
I 35 35 WJADH0
I 36 38 WJADJA
I 39 39 WJADJB
I 40 40 WJADJC
I 41 41 WJADJD
I 42 42 WJADJF
I 43 43 WJADJG
I 44 44 WJADJH
I 45 45 WJADJJ
I 46 46 WJADJK
I 47 47 WJADJL
I 48 48 WJADJM
I 49 49 WJADJN
I 50 50 WJADJP
I 51 51 WJADJQ
I 52 52 WJADJR
I 53 53 WJADJS
I 54 54 WJADJT
I 55 55 WJADJV
I 56 56 WJADJW
I 57 57 WJADJY
I 58 58 WJADJZ
I 59 59 WJADJ1
I 60 60 WJADJ2
I 61 61 WJADJ3
I 62 62 WJADJ4
I 63 63 WJADJ5
I 64 64 WJADJ6
I 65 65 WJADJ7
I 66 66 WJADJ8
I 67 67 WJADJ9
I 68 68 WJADJ0
I 69 69 WJADKA
I 70 70 WJADKB
I 71 71 WJADKC
I 72 72 WJACV5
I 73 73 WJADKD
I 74 85 WJADKF
I 86 86 WJADKG
I 87 92 WJADKH
I 93 98 WJADKJ
I 99 99 WJADKK
I 100 100 WJADKM
I 101 101 WJADKN
I 102 102 WJADKP
IYW02 DS
I 1 1 XBACVX
I 2 7 XBZ80O
I 8 8 XBADHJ
I 9 9 XBADHK
I 10 10 XBADHL
I 11 11 XBADHM
I 12 12 XBADHN
I 13 13 XBADHP
I 14 14 XBADHQ
I 15 15 XBADHR
I 16 16 XBADHS
I 17 17 XBADHT
I 18 18 XBADHV
I 19 19 XBADHW
I 20 20 XBADHY
I 21 21 XBADHZ
I 22 22 XBADH1
I 23 23 XBADH2
I 24 24 XBADH3
I 25 25 XBABW2
I 26 26 XBADH4
I 27 29 XBADH5
I 30 30 XBADH6
I 31 31 XBZ9AD
I 32 32 XBADH7
I 33 33 XBADH8
I 34 34 XBADH9
I 35 35 XBADH0
I 36 38 XBADJA
I 39 39 XBADJB
I 40 40 XBADJC
I 41 41 XBADJD
I 42 42 XBADJF
I 43 43 XBADJG
I 44 44 XBADJH
I 45 45 XBADJJ
I 46 46 XBADJK
I 47 47 XBADJL
I 48 48 XBADJM
I 49 49 XBADJN
I 50 50 XBADJP
I 51 51 XBADJQ
I 52 52 XBADJR
I 53 53 XBADJS
I 54 54 XBADJT
I 55 55 XBADJV
I 56 56 XBADJW
I 57 57 XBADJY
I 58 58 XBADJZ
I 59 59 XBADJ1
I 60 60 XBADJ2
I 61 61 XBADJ3
I 62 62 XBADJ4
I 63 63 XBADJ5
I 64 64 XBADJ6
I 65 65 XBADJ7
I 66 66 XBADJ8
I 67 67 XBADJ9
I 68 68 XBADJ0
I 69 69 XBADKA
I 70 70 XBADKB
I 71 71 XBADKC
I 72 72 XBACV5
I 73 73 XBADKD
I 74 85 XBADKF
I 86 86 XBADKG
I 87 92 XBADKH
I 93 98 XBADKJ
I 99 99 XBADKK
I 100 100 XBADKM
I 101 101 XBADKN
I 102 102 XBADKP
IYD03 DS
I 1 70YI0301
I 8 120YI03
IYM03 DS 9999
I 1 70WKAAD2
IYW03 DS
I 1 70XCAAD2
IYD04 DS
I 1 3 YI0401
I 4 80YI04
IYM04 DS 9999
I 1 3 WLAAD8
IYW04 DS
I 1 3 XDAAD8
IYD05 DS
I 1 3 YI0501
I 4 80YI05
IYM05 DS 9999
I 1 3 WSACHG
IYW05 DS
I 1 3 XEACHG
/EJECT
* Parameter declarations
IP1PARM DS
* FLD: Quote/Order Header
* I : RST Company number
I 1 20P1AENB
* I : RST Internal header type
I 3 3 P1DCCD
* I : RST Quote/order number
I 4 10 P1CVNB
* N : Currency ID
I 11 13 P1BRCD
* N : Terms code
I 14 15 P1BLCD
* I : Customer number
I 16 230P1CANB
* I : Ship to number
I 24 31 P1B9CD
IP2PARM DS
* FLD: Address
* N : Address line 1
I 1 35 P2CMTX
* N : Address line 2
I 36 70 P2CNTX
* N : Address line 3
I 71 105 P2COTX
* N : Postal code
I 106 115 P2CVCD
* N : City
I 116 150 P2CPTX
* N : Country code
I 151 153 P2COCD
* N : State code (key)
I 154 155 P2BYCD
IP3PARM DS
* I : Invoice sequence
I P 1 40P3HYNB
IP4PARM DS
* N : Billing & inventory inter
I 1 1 P4Z9AN
IP5PARM DS
* N : Tax in price flag
I 1 1 P5Z9JB
IP6PARM DS
* N : Total tax amt for trm dsc
I P 1 72P6Z9Z0
I DS
I 1 132 ZAMSDA
* Message data for 'BACKUP COPY OF DOCUMENT'
* Message data for 'BACKUP COPY OF DOCUMENT'
* Message data for 'Pay by Installments'
* Message data for 'U/M cnv undefn for item'
* Item number
I 1 15 ZA0001
* Dimension U/M
I 16 17 ZA0002
* To unit of measure 3
I 18 19 ZA0003
* Message data for 'U/M cnv undefn for item I'
* Item number
I 1 15 ZA0004
* Dimension U/M
I 16 17 ZA0005
* To unit of measure 3
I 18 19 ZA0006
* Message data for 'U/M cnv undefn for item'
* Item number
I 1 15 ZA0007
* Dimension U/M
I 16 17 ZA0008
* To unit of measure 3
I 18 19 ZA0009
* Message data for 'U/M cnv undefn for item I'
* Item number
I 1 15 ZA0010
* Dimension U/M
I 16 17 ZA0011
* To unit of measure 3
I 18 19 ZA0012
* Message data for 'U/M cnv undefn for item'
* Item number
I 1 15 ZA0013
* Dimension U/M
I 16 17 ZA0014
* To unit of measure 3
I 18 19 ZA0015
* Message data for 'U/M cnv undefn for item I'
* Item number
I 1 15 ZA0016
* Dimension U/M
I 16 17 ZA0017
* To unit of measure 3
I 18 19 ZA0018
/EJECT
*****************************************************************
* Entry parameters
C *ENTRY PLIST
C PARM P0RTN 7
C P1AENB PARM WP0001 20 Company number
C P1DCCD PARM WP0002 1 Internal header
C P1CVNB PARM WP0003 7 Quote/order num
C P1CANB PARM WP0004 80 Customer number
C P1B9CD PARM WP0005 8 Ship to number
C P3HYNB PARM WP0006 70 Invoice sequenc
*****************************************************************
* Initialize
C EXSR ZZINIT
* PRT:Acknowledgement: Mainline
C EXSR A0MAIN
* Print headers then End of report format
C EXSR Q0PRNT
C WRITEYBENDRPT
* Exit program
C EXSR ZXEXPG
* ------------------------------------------------------
/EJECT
CSR A0MAIN BEGSR
*================================================================
* PRT:Acknowledgement: Mainline
*================================================================
* Declare restrictor key work fields
C *LIKE DEFN C6AENB WQKA01 Company number
C *LIKE DEFN C6DCCD WQKA02 Internal header
C *LIKE DEFN C6CVNB WQKA03 Quote/order num
* Define keylist
C KRSA KLIST
C KFLD WQKA01 Company number
C KFLD WQKA02 Internal header
C KFLD WQKA03 Quote/order num
* Setup key
C Z-ADDP1AENB WQKA01 Company number
C MOVELP1DCCD WQKA02 Internal header
C MOVELP1CVNB WQKA03 Quote/order num
* Establish starting position
C KRSA SETLLFAVREG4 *
* Read first record with user selection
C EXSR A3READ
C W0EOFA IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0AL1P 1 First page
C MOVEL'Y' W0AL00 1 Company number
C MOVEL'Y' W0AL01 1 Internal header
* Set column headings flag
C MOVE 'Y' W0ACDT
* Print report body
C W0EOFA DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR A1PHDR
* Print report detail line
C EXSR A2PDTL
* Read next record with user selection
C EXSR A3READ
* Print totals
C EXSR A4PTOT
C END WOD
C END FI
*================================================================
CSR A0EXIT ENDSR
/EJECT
CSR A1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0AL1P IFEQ 'Y'
* Load related totals format
C Z-ADD*ZERO YAAB1X Net sales amoun
C Z-ADD*ZERO YAAB1Y Trade discount
C Z-ADD*ZERO YAAB11 Total misc 15.2
C Z-ADD*ZERO YAAB13 Discount allowe
C Z-ADD*ZERO YAAB12 Total freight 1
C MOVEL*BLANK YAAAM5 Currency ID (us
C Z-ADD*ZERO YAZ04L Alternate total
C Z-ADD*ZERO YAAB1Z Total taxes 15.
C Z-ADD*ZERO YAAB14 Pay this amount
* Signal that format is now ready to print
C MOVE 'Y' W0AP1P 1
C END
C W0AL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0AP00 1
C END
C W0AL01 IFEQ 'Y'
* Load key header format
C MOVEL*BLANK ZBABY1 Invoice title l
C Z-ADD*ZERO ZBAA7C Date (USR)
C Z-ADD*ZERO ZBABC5 Page number for
C MOVEL*BLANK ZBZ9KP Ship to alpha n
C MOVEL*BLANK ZBZ9KR ship to address
C MOVEL*BLANK ZBACFD Ship to Address
C MOVEL*BLANK ZBACKD Ship to address
C MOVEL*BLANK ZBACKF Ship to address
C MOVEL*BLANK ZBZ9KS Ship to address
C MOVELC6BNST ZBBNST Export designat
C MOVELC6BRCD ZBBRCD Currency ID
C MOVEL*BLANK ZBAAAR Currency desc D
C MOVELC6HITX ZBHITX Alpha sort name
C MOVEL*BLANK ZBZ9KQ Alpha sort name
C MOVEL*BLANK ZBZ9KT sold to address
C MOVEL*BLANK ZBACFG Sold to Address
C MOVEL*BLANK ZBACKH Sold to address
C MOVEL*BLANK ZBAAN2 Terms Descripti
C MOVEL*BLANK ZBACKJ Sold to address
C MOVEL*BLANK ZBZ9KV sold to address
C Z-ADDC6AENB ZBAENB Company number
C Z-ADDC6CANB ZBCANB Customer number
C MOVEL*BLANK ZBAA9V Quote/Order num
C Z-ADDC6CHNB ZBCHNB Salesrep number
C MOVELC6CBTX ZBCBTX Purchase order
C MOVELC6CHTX ZBCHTX Purchase order
C MOVELC6CDTX ZBCDTX Shipping instru
C MOVEL*BLANK ZBACG2 Blank Report fi
C MOVEL*BLANK ZBAFJ0 Carrier descrip
C MOVELC6DCCD ZBDCCD Internal header
C MOVELC6CVNB ZBCVNB Quote/order num
C Z-ADDC6ACDT ZBACDT Quote/order dat
C MOVELC6ICST ZBICST Manuf due date
C Z-ADDC6DAVA ZBDAVA Header order va
C Z-ADDC6DMVA ZBDMVA Discount percen
C Z-ADDC6D0NB ZBD0NB Request date
C MOVELC6D9NB ZBD9NB Ship to overrid
C MOVELC6D8NB ZBD8NB Sold to overrid
C Z-ADDC6DCVA ZBDCVA LC order value
C MOVELC6ETST ZBETST Pro forma invoi
C Z-ADDC6EFNB ZBEFNB Current SA mont
C Z-ADDC6CNNB ZBCNNB Invoice procedu
C Z-ADDC6EENB ZBEENB Ship lead time
C Z-ADDC6CENB ZBCENB Unit price disc
C Z-ADDC6DBVA ZBDBVA Current order c
C Z-ADDC6F8VA ZBF8VA Override exchan
C Z-ADDC6EHNB ZBEHNB Tax override da
C Z-ADDC6ARDT ZBARDT Override exch r
C Z-ADDC6AOQT ZBAOQT Order total vol
C Z-ADDC6AAQT ZBAAQT Order total wei
C MOVELC6BTCD ZBBTCD Sales code
C MOVELC6FNST ZBFNST Header status
C MOVELC6IDST ZBIDST Quote/acknowled
C Z-ADDC6AABS ZBAABS Completion date
C MOVELC6BFST ZBBFST Print item tax
C MOVELC6BGST ZBBGST Print tax summa
C MOVELC6AAJ1 ZBAAJ1 Page 5 Pricing?
C MOVELC6AAYC ZBAAYC Order number re
C Z-ADDC6AAYF ZBAAYF Source company
C MOVELC6AAYH ZBAAYH Source order ty
C MOVELC6AAYG ZBAAYG Source order nu
C Z-ADDC6ABAH ZBABAH Manual invoice
C MOVELC6AKCD ZBAKCD Language code
C Z-ADDC6C0CD ZBC0CD Territory ID
C Z-ADDC6D1NB ZBD1NB Contract number
C MOVELC6HQST ZBHQST Contract/promo
C MOVELC6F5CD ZBF5CD Customer price
C MOVELC6GQCD ZBGQCD Priority ID
C MOVELC6F7CD ZBF7CD Trade discount
C MOVELC6BLCD ZBBLCD Terms code
C MOVELC6GZCD ZBGZCD Surcharge code
C MOVELC6CCNB ZBCCNB Backorders?
C MOVELC6CDNB ZBCDNB Partial ship
C Z-ADDC6CPNB ZBCPNB Shipment lead t
C MOVELC6BDST ZBBDST Invoice languag
C MOVELC6BEST ZBBEST Print backorder
C MOVELC6AAZX ZBAAZX Print item tax
C MOVELC6HUST ZBHUST Accept substitu
C MOVELC6FJST ZBFJST Credit check re
C MOVELC6HYST ZBHYST Address format
C Z-ADDC6APPC ZBAPPC Commissionable
C MOVELC6HZST ZBHZST Purchase order
C MOVELC6H0ST ZBH0ST Automatic credi
C MOVELC6C7CD ZBC7CD Customer class
C MOVELC6AAZY ZBAAZY Trade discount
C MOVELC6AAZZ ZBAAZZ Customer price
C Z-ADDC6KQNB ZBKQNB Parent customer
C MOVELC6AAZ1 ZBAAZ1 Language code
C MOVELC6G0CD ZBG0CD Secondary langu
C MOVELC6B9CD ZBB9CD Ship to number
C MOVELC6ABAL ZBABAL Alpha sort name
C MOVELC6AA9L ZBAA9L Default ship to
C Z-ADDC6CUCD ZBCUCD Address code
C Z-ADDC6F2CD ZBF2CD Commission head
C MOVELC6GPCD ZBGPCD Price book ID
C Z-ADDC6FGVA ZBFGVA Invoice amount
C Z-ADDC6HECD ZBHECD Sold to overrid
C MOVELC6A3CD ZBA3CD Warehouse
C MOVELC6AAB6 ZBAAB6 Delivery terms
C Z-ADDC6ABAJ ZBABAJ Bill to Company
C Z-ADDC6ABAK ZBABAK Bill to Custome
C MOVELC6ESST ZBESST Credit memo cod
C MOVELC6F4CD ZBF4CD Credit/debit re
C Z-ADDC6GGNB ZBGGNB Invoice number
C Z-ADDC6HYNB ZBHYNB Invoice sequenc
C Z-ADDC6D6NB ZBD6NB Future age mont
C Z-ADDC6D9VA ZBD9VA Total dollars i
C Z-ADDC6AEDT ZBAEDT Age date
C Z-ADDC6ECVA ZBECVA LC - total invo
C Z-ADDC6ALDT ZBALDT Create date
C Z-ADDC6ABTM ZBABTM Create time
C MOVELC6AFVN ZBAFVN Created by user
C MOVELC6AGVN ZBAGVN Created by prog
C Z-ADDC6AMDT ZBAMDT Change date
C Z-ADDC6ACTM ZBACTM Change time
C MOVELC6AHVN ZBAHVN Changed by user
C MOVELC6AIVN ZBAIVN Changed by prog
* Signal that format is now ready to print
C MOVE 'Y' W0AP01 1
C END
*================================================================
CSR A1EXIT ENDSR
/EJECT
CSR A2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C MOVELC6A3CD ZCA3CD Warehouse
C MOVELC6DCCD ZCDCCD Internal header
C MOVELC6ABAL ZCABAL Alpha sort name
C MOVELC6CVNB ZCCVNB Quote/order num
C MOVELC6ACR2 ZCACR2 Proforma pack l
C Z-ADDC6AMPC ZCAMPC Variable trade
C MOVELC6AD0W ZCAD0W Order origin
C Z-ADDC6AD0X ZCAD0X Cancel after da
C Z-ADDC6AA74 ZCAA74 Offline order t
C Z-ADDC6AFAW ZCAFAW Do not ship bef
C MOVELC6Z9H4 ZCZ9H4 Installment met
C MOVELC6Z9H5 ZCZ9H5 Tax transaction
C MOVELC6Z9H6 ZCZ9H6 Note method id
C MOVELC6Z9H9 ZCZ9H9 Interbranch tra
C Z-ADDC6Z9H0 ZCZ9H0 Interbranch tra
C MOVELC6Z9JA ZCZ9JA Amount invoice
C MOVELC6Z9JF ZCZ9JF Invoice series
C Z-ADDC6Z0S1 ZCZ0S1 Complementary r
C MOVELC6BLCD ZCBLCD Terms code
C MOVELC6B9CD ZCB9CD Ship to number
C Z-ADDC6HECD ZCHECD Sold to overrid
C MOVELC6BXCD ZCBXCD Tax suffix (key
C MOVELC6F1CD ZCF1CD Carrier ID
C MOVELC6BHST ZCBHST Sale code
* USER: Process before print of detail format
C MOVELC6BRCD P1BRCD Currency ID
C MOVELC6BLCD P1BLCD Terms code
* Signal that format is now ready to print
C MOVE 'Y' W0APDT 1
* Call print routine
C EXSR Q0PRNT
* PRTOBJ calls after print of detail format
* Embedded PRTOBJ : PRO:Invoice Hdr comments
C EXSR UCSUBR Embedded PRTOBJ
* Embedded PRTOBJ : PRO:Acknowledgement Lines
C EXSR UDSUBR Embedded PRTOBJ
* Embedded PRTOBJ : PRO:Invoice special charg
C EXSR UKSUBR Embedded PRTOBJ
* Embedded PRTOBJ : PRO:Invoice spc chg tax
C EXSR UOSUBR Embedded PRTOBJ
*================================================================
CSR A2EXIT ENDSR
/EJECT
CSR A3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN C6AENB WZA001 Company number
C Z-ADDC6AENB WZA001
C *LIKE DEFN C6DCCD WZA002 Internal header
C MOVELC6DCCD WZA002
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFA OREQ '1'
C KRSA READEFAVREG4 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFA 1
* Quit if no record read
C W0EOFA IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* Turn off New Page - Z-Generic Programs *
C MOVE 'N' W0NEWP
C MOVELC6Z9H4 WUZ9H4 Installment met
* Printed in alternate currency?
* CASE: *OTHERWISE
C MOVEL'N' WUZ04D Prtd in alterna
* RTV:ledger/alt cur/flag - Quote/Order Euro Xref *
C EXSR OWRVGN
* (WRK)Alternate currency ID tells AXZ41 what the 'to' currency is.
* Don't change after this point. Used as global by PRTOBJs.
* Determine amounts to be printed in alternate currency
* CASE: WRK.Alternate currency ID NE DB1.Currency ID
C WUZ0YH IFNE C6BRCD *IF
* Print alternate currency at total or line and total?
* CASE: WRK.Print Alternate currency is No
C WUZ0YN IFEQ '0' *IF
C MOVEL'S' WUZ04D Prtd in alterna
C ELSE
* CASE: WRK.Print Alternate currency is Yes
C WUZ0YN IFEQ '1' *IF
C MOVEL'D' WUZ04D Prtd in alterna
C END *FI
C END *FI
C ELSE
* CASE: *OTHERWISE
* EXT:Get cust curid flag - Euro currency *
C CALL 'AMVCOXFR' 90 EXT:Get cust cu
C PARM *BLANK W0RTN 7
C PARM C6BRCD WQ0540 3 Currency ID
C PARM ZZJDT WQ0541 70 Euro currency e
C WUZ0Y2 PARM *BLANK WQ0542 1 Euro currency f
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMVCOXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* If order currency is Euro-participating, print EURO amount
* CASE: WRK.Euro currency flag-ord is Euro participating
C WUZ0Y2 IFEQ '1' *IF
C WUZ0Y2 OREQ '4'
C MOVEL'E' WUZ04D Prtd in alterna
C END *FI
C END *FI
C MOVELC6BRCD WUAAM5 Currency ID (us
* (WRK)Currency ID (usr) tells AXZ41 what the 'from' currency is.
* Check for Multi-currency support.
* CASE: WRK.Multi-currency support is Yes
C WUZ9AL IFEQ '1' *IF
C ELSE
* CASE: *OTHERWISE
C MOVEL'N' WUZ04D Prtd in alterna
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0AL00 1 Company number
C MOVEL*BLANK W0AL01 1 Internal header
C W0EOFA IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0AL00 1 Company number
C MOVEL'Y' W0AL01 1 Internal header
C ELSE
* Next record - Detect level breaks
C C6AENB IFNE WZA001 Company number
* Set on level break indicator
C MOVEL'Y' W0AL00
C END
C C6DCCD IFNE WZA002 Internal header
C W0AL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0AL01
C END
C END
*================================================================
CSR A3EXIT ENDSR
/EJECT
CSR A4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0AL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0AP01
C END
C W0AL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0AP00
C END
C W0EOFA IFEQ '1'
C MOVEL'Y' W0PFM
* USER: On print of final totals format
* Calculate totals
C EXSR UPSUBR Calculate total
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
C MOVELWUAAM5 YAAAM5 Currency ID (us
* Is currency id blank?
* CASE: CUR.Currency ID (usr) is Blank
C YAAAM5 IFEQ *BLANK *IF
* EXT:Get local currency - CURRENCY *
C CALL 'AMVUAXFR' 90 EXT:Get local c
C PARM *BLANK W0RTN 7
C YAAAM5 PARM YAAAM5 WQ0588 3 Local currency
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMVUAXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* (CUR)Currency id (usr) is the label for the secondary total.
C END *FI
C Z-ADDWUZ04P YAAB1X Net sales amoun
* EXT:Cnvt to alt (15.2) - Z-Generic Programs *Total misc 15.2 US
C CALL 'AMBU2XFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM P1AENB WQ0589 20 Company number
C PARM WUAAM5 WQ0590 3 Currency ID
C YAAB11 PARM YAAB11 WQ0591 152 &Amount 15.2
C PARM WUZ0YH WQ0592 3 Alternate curre
C WUAAKC PARM *BLANK WQ0593 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBU2XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* EXT:Cnvt to alt (15.2) - Z-Generic Programs *Total freight 15.2
C CALL 'AMBU2XFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM P1AENB WQ0594 20 Company number
C PARM WUAAM5 WQ0595 3 Currency ID
C YAAB12 PARM YAAB12 WQ0596 152 &Amount 15.2
C PARM WUZ0YH WQ0597 3 Alternate curre
C WUAAKC PARM *BLANK WQ0598 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBU2XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* EXT:Cnvt to alt (15.2) - Z-Generic Programs *Total taxes 15.2 U
C CALL 'AMBU2XFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM P1AENB WQ0599 20 Company number
C PARM WUAAM5 WQ0600 3 Currency ID
C YAAB1Z PARM YAAB1Z WQ0601 152 &Amount 15.2
C PARM WUZ0YH WQ0602 3 Alternate curre
C WUAAKC PARM *BLANK WQ0603 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBU2XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* EXT:Cnvt to alt (15.2) - Z-Generic Programs *Trade discount 15.
C CALL 'AMBU2XFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM P1AENB WQ0604 20 Company number
C PARM WUAAM5 WQ0605 3 Currency ID
C YAAB1Y PARM YAAB1Y WQ0606 152 &Amount 15.2
C PARM WUZ0YH WQ0607 3 Alternate curre
C WUAAKC PARM *BLANK WQ0608 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBU2XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* EXT:Cnvt to alt (15.2) - Z-Generic Programs *Discount allowed 1
C CALL 'AMBU2XFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM P1AENB WQ0609 20 Company number
C PARM WUAAM5 WQ0610 3 Currency ID
C YAAB13 PARM YAAB13 WQ0611 152 &Amount 15.2
C PARM WUZ0YH WQ0612 3 Alternate curre
C WUAAKC PARM *BLANK WQ0613 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBU2XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C YAAB12 ADD YAAB11 WUABXA Total for charg
* Compute Invoice Amount
* CUR.Pay this amount 15.2 USR =
* *COMPUTE (x1 + x4 + x2 - x3 + x5)
* x1 : CUR.Net sales amount 15.2 USR
* + : WRK.&Number 16.2
* x4 : WRK.Total for charges
* + : WRK.&Number 16.2
* x2 : CUR.Total taxes 15.2 USR
* - : WRK.&Number 16.2
* x3 : CUR.Trade discount 15.2 USR
* + : WRK.&Number 16.2
* x5 : WRK.Total surcharge amount
C YAAB1X ADD WUABXA WUSANB &Number 16.2
C ADD YAAB1Z WUSANB &Number 16.2
C SUB YAAB1Y WUSANB &Number 16.2
C ADD WUAACB WUSANB &Number 16.2
C Z-ADDWUSANB YAAB14 Pay this amount
* Get secondary total by converting Invoice Amount.
* CASE: *OTHERWISE
C Z-ADDYAAB14 YAZ04L Alternate total
* EXT:Cnvt to alt (15.2) - Z-Generic Programs *Alternate total US
C CALL 'AMBU2XFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM P1AENB WQ0614 20 Company number
C PARM WUZ0YH WQ0615 3 Currency ID
C YAZ04L PARM YAZ04L WQ0616 152 &Amount 15.2
C PARM WUAAM5 WQ0617 3 Alternate curre
C WUAAKC PARM *BLANK WQ0618 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBU2XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C ELSE
* CASE: WRK.Prtd in alternate ccy USR is Secondary total
C WUZ04D IFEQ 'S' *IF
C MOVELWUZ0YH YAAAM5 Currency ID (us
* Is currency id blank?
* CASE: CUR.Currency ID (usr) is Blank
C YAAAM5 IFEQ *BLANK *IF
* EXT:Get local currency - CURRENCY *
C CALL 'AMVUAXFR' 90 EXT:Get local c
C PARM *BLANK W0RTN 7
C YAAAM5 PARM YAAAM5 WQ0619 3 Local currency
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMVUAXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* (CUR)Currency id (usr) is the label for the secondary total.
C END *FI
C Z-ADDYAAB14 YAZ04L Alternate total
* EXT:Cnvt to alt (15.2) - Z-Generic Programs *Alternate total US
C CALL 'AMBU2XFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM P1AENB WQ0620 20 Company number
C PARM WUAAM5 WQ0621 3 Currency ID
C YAZ04L PARM YAZ04L WQ0622 152 &Amount 15.2
C PARM WUZ0YH WQ0623 3 Alternate curre
C WUAAKC PARM *BLANK WQ0624 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBU2XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C ELSE
* CASE: WRK.Prtd in alternate ccy USR is Force Euro Total
C WUZ04D IFEQ 'E' *IF
* EXT:Get Euro currency ID - Euro currency *
C CALL 'AMVCPXFR' 90 EXT:Get Euro cu
C PARM *BLANK W0RTN 7
C PARM ZZJDT WQ0625 70 Euro currency e
C YAAAM5 PARM *BLANK WQ0626 3 Euro currency I
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMVCPXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C Z-ADDYAAB14 YAZ04L Alternate total
* EXT:Cnvt to alt (15.2) - Z-Generic Programs *Alternate total US
C CALL 'AMBU2XFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM P1AENB WQ0627 20 Company number
C PARM WUAAM5 WQ0628 3 Currency ID
C YAZ04L PARM YAZ04L WQ0629 152 &Amount 15.2
C PARM YAAAM5 WQ0630 3 Alternate curre
C WUAAKC PARM *BLANK WQ0631 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBU2XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C END *FI
C END *FI
C END *FI
C W0PFM IFEQ 'Y'
* If we are already passed the nominated
* Start line for this format
C @$CLN IFGE 62
* Signal new page required
C MOVE 'Y' W0NEWP
* Start new page
C EXSR Q0PRNT
C END
C MOVEL'0' *IN79
C WUZ04D IFEQ 'N' *IF
C MOVEL'1' *IN79
C END *FI
* Print format
C WRITEYAFINTTL
C END
C END
*================================================================
CSR A4EXIT ENDSR
/EJECT
CSR B0MAIN BEGSR
*================================================================
* PRO:Invoice Hdr comments: Mainline
*================================================================
* Declare restrictor key work fields
C *LIKE DEFN WBAENB WQKB01 Company number
C *LIKE DEFN WBGGNB WQKB02 Invoice number
C *LIKE DEFN WBHYNB WQKB03 Invoice sequenc
* Define keylist
C KRSB KLIST
C KFLD WQKB01 Company number
C KFLD WQKB02 Invoice number
C KFLD WQKB03 Invoice sequenc
* Setup key
C Z-ADDP1AENB WQKB01 Company number
C Z-ADD*ZERO WQKB02 Invoice number
C Z-ADDP3HYNB WQKB03 Invoice sequenc
* Establish starting position
C KRSB SETLLFGACPLS *
* Read first record with user selection
C EXSR B3READ
C W0EOFB IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0BL1P 1 First page
C MOVEL'Y' W0BL00 1 Company number
C MOVEL'Y' W0BL01 1 Invoice number
C MOVEL'Y' W0BL02 1 Invoice sequenc
C MOVEL'Y' W0BL03 1 Internal header
C MOVEL'Y' W0BL04 1 Quote/order num
C MOVEL'Y' W0BL05 1 Comment user re
C MOVEL'Y' W0BL06 1 Comment line se
* Set column headings flag
C MOVE 'Y' W0BCDT
* Print report body
C W0EOFB DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR B1PHDR
* Print report detail line
C EXSR B2PDTL
* Read next record with user selection
C EXSR B3READ
* Print totals
C EXSR B4PTOT
C END WOD
C END FI
*================================================================
CSR B0EXIT ENDSR
/EJECT
CSR B1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0BL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0BP1P 1
C END
C W0BL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0BP00 1
C END
C W0BL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0BP01 1
C END
C W0BL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0BP02 1
C END
C W0BL03 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0BP03 1
C END
C W0BL04 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0BP04 1
C END
C W0BL05 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0BP05 1
C END
C W0BL06 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0BP06 1
C END
*================================================================
CSR B1EXIT ENDSR
/EJECT
CSR B2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C Z-ADDWBAENB ZDAENB Company number
C Z-ADDWBGGNB ZDGGNB Invoice number
C Z-ADDWBHYNB ZDHYNB Invoice sequenc
C Z-ADDWBKBNB ZDKBNB Comment line se
C MOVELWBAKCD ZDAKCD Language code
C MOVELWBAAD9 ZDAAD9 Internal print
C MOVELWBHDTX ZDHDTX Comment line te
C MOVEL*BLANK ZDAFD5 Text Line Descr
C Z-ADD*ZERO ZDACCS Date Effective
C Z-ADD*ZERO ZDAC87 Total Invoice A
C MOVEL*BLANK ZDABHW Work (Alpha 2)
C MOVELWBHXCD ZDHXCD Comment user re
C MOVELWBDCCD ZDDCCD Internal header
C MOVELWBCVNB ZDCVNB Quote/order num
C Z-ADDWBK4NB ZDK4NB Shipment header
C Z-ADDWBAFAD ZDAFAD Shipment consol
C Z-ADDWBLCNB ZDLCNB Ship release se
C Z-ADDWBAASZ ZDAASZ Kit release seq
C Z-ADDWBAAD2 ZDAAD2 Special charge
C MOVELWBAD1N ZDAD1N Text line print
C Z-ADDWBALDT ZDALDT Create date
C Z-ADDWBABTM ZDABTM Create time
C MOVELWBAFVN ZDAFVN Created by user
C MOVELWBAGVN ZDAGVN Created by prog
* Signal that format is now ready to print
C MOVE 'Y' W0BPDT 1
* Call print routine
C EXSR Q0PRNT
*================================================================
CSR B2EXIT ENDSR
/EJECT
CSR B3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN WBAENB WZB001 Company number
C Z-ADDWBAENB WZB001
C *LIKE DEFN WBGGNB WZB002 Invoice number
C Z-ADDWBGGNB WZB002
C *LIKE DEFN WBHYNB WZB003 Invoice sequenc
C Z-ADDWBHYNB WZB003
C *LIKE DEFN WBDCCD WZB004 Internal header
C MOVELWBDCCD WZB004
C *LIKE DEFN WBCVNB WZB005 Quote/order num
C MOVELWBCVNB WZB005
C *LIKE DEFN WBHXCD WZB006 Comment user re
C MOVELWBHXCD WZB006
C *LIKE DEFN WBKBNB WZB007 Comment line se
C Z-ADDWBKBNB WZB007
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFB OREQ '1'
C KRSB READEFGACPLS 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFB 1
* Quit if no record read
C W0EOFB IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* Make sure this is not a line item comment and it is supposed to p
* CASE: DB1.Internal print only? is Yes
C WBAAD9 IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C ELSE
* CASE: DB1.Ship release sequence is Not Zero
C WBLCNB IFNE *ZERO *IF
* Do not print comments for line items
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END *FI
* Par special charge seq NE DB1 special charge seq, then print=no
* CASE: PAR.Special charge sequence # NE DB1.Special charge sequenc
C *ZERO IFNE WBAAD2 *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
* Print foreign comments only if set up for that and still OK
* CASE: If foreign text only & language OK & record select
* - c1 AND c2 AND c3
* |- c1 : PAR.Document language format is Foreign text only
* |- c2 : DB1.Language code NE PAR.Language code
* |- c3 : PGM.*Record selected is *YES
* '-
C MOVEL'0' Y0CX01 1
C C6BDST IFEQ '1' *IF
C WBAKCD IFNE C6AKCD *IF
C W0RSL IFEQ 'Y' *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0BL00 1 Company number
C MOVEL*BLANK W0BL01 1 Invoice number
C MOVEL*BLANK W0BL02 1 Invoice sequenc
C MOVEL*BLANK W0BL03 1 Internal header
C MOVEL*BLANK W0BL04 1 Quote/order num
C MOVEL*BLANK W0BL05 1 Comment user re
C MOVEL*BLANK W0BL06 1 Comment line se
C W0EOFB IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0BL00 1 Company number
C MOVEL'Y' W0BL01 1 Invoice number
C MOVEL'Y' W0BL02 1 Invoice sequenc
C MOVEL'Y' W0BL03 1 Internal header
C MOVEL'Y' W0BL04 1 Quote/order num
C MOVEL'Y' W0BL05 1 Comment user re
C MOVEL'Y' W0BL06 1 Comment line se
C ELSE
* Next record - Detect level breaks
C WBAENB IFNE WZB001 Company number
* Set on level break indicator
C MOVEL'Y' W0BL00
C END
C WBGGNB IFNE WZB002 Invoice number
C W0BL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0BL01
C END
C WBHYNB IFNE WZB003 Invoice sequenc
C W0BL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0BL02
C END
C WBDCCD IFNE WZB004 Internal header
C W0BL02 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0BL03
C END
C WBCVNB IFNE WZB005 Quote/order num
C W0BL03 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0BL04
C END
C WBHXCD IFNE WZB006 Comment user re
C W0BL04 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0BL05
C END
C WBKBNB IFNE WZB007 Comment line se
C W0BL05 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0BL06
C END
C END
*================================================================
CSR B3EXIT ENDSR
/EJECT
CSR B4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0BL06 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0BP06
C END
C W0BL05 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0BP05
C END
C W0BL04 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0BP04
C END
C W0BL03 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0BP03
C END
C W0BL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0BP02
C END
C W0BL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0BP01
C END
C W0BL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0BP00
C END
C W0EOFB IFEQ '1'
* If there is not enough space on the
* physical page for this format:
C @$PGL SUB @$CLN @$WRK
C @$WRK IFLE 1
* Signal new page required
C MOVE 'Y' W0NEWP
* Start new page
C EXSR Q0PRNT
C END
* Print format
C WRITEZEFINTTL
C END
*================================================================
CSR B4EXIT ENDSR
/EJECT
CSR C0MAIN BEGSR
*================================================================
* PRO:Acknowledgement Lines: Mainline
*================================================================
* PRO:Acknowledgement Lines: Initialise
C EXSR ZCINIT
* Declare restrictor key work fields
C *LIKE DEFN CDAENB WQKC01 Company number
C *LIKE DEFN CDDCCD WQKC02 Internal header
C *LIKE DEFN CDCVNB WQKC03 Quote/order num
* Define keylist
C KRSC KLIST
C KFLD WQKC01 Company number
C KFLD WQKC02 Internal header
C KFLD WQKC03 Quote/order num
* Setup key
C Z-ADDC6AENB WQKC01 Company number
C MOVELZCDCCD WQKC02 Internal header
C MOVELZCCVNB WQKC03 Quote/order num
* Establish starting position
C KRSC SETLLFCDREZF *
* Read first record with user selection
C EXSR C3READ
C W0EOFC IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0CL1P 1 First page
C MOVEL'Y' W0CL00 1 Company number
C MOVEL'Y' W0CL01 1 Internal header
C MOVEL'Y' W0CL02 1 Quote/order num
C MOVEL'Y' W0CL03 1 User entered se
C MOVEL'Y' W0CL04 1 System sequence
* Set column headings flag
C MOVE 'Y' W0CCDT
* Print report body
C W0EOFC DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR C1PHDR
* Print report detail line
C EXSR C2PDTL
* Read next record with user selection
C EXSR C3READ
* Print totals
C EXSR C4PTOT
C END WOD
C END FI
*================================================================
CSR C0EXIT ENDSR
/EJECT
CSR C1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0CL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0CP1P 1
C END
C W0CL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0CP00 1
C END
C W0CL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0CP01 1
C END
C W0CL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0CP02 1
C END
C W0CL03 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0CP03 1
C END
C W0CL04 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0CP04 1
C END
*================================================================
CSR C1EXIT ENDSR
/EJECT
CSR C2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C Z-ADDCDAENB ZFAENB Company number
C MOVELCDDCCD ZFDCCD Internal header
C MOVELCDCVNB ZFCVNB Quote/order num
C Z-ADDCDCANB ZFCANB Customer number
C MOVELCDB9CD ZFB9CD Ship to number
C MOVELCDZ9Q7 ZFZ9Q7 Tax transaction
C MOVELCDBXCD ZFBXCD Tax suffix (key
C Z-ADDCDFCNB ZFFCNB Line item seque
C MOVELCDH2ST ZFH2ST Kit item
C MOVELCDH3ST ZFH3ST Line item statu
C Z-ADDCDFXVA ZFFXVA Stocking quanti
C MOVELCDESST ZFESST Credit memo cod
C Z-ADDCDAA9M ZFAA9M Ship to overrid
C MOVELCDABAZ ZFABAZ Ship to number
C MOVELCDKTNB ZFKTNB User entered se
C MOVELCDAITX ZFAITX Item number
C MOVELCDCQCD ZFCQCD Dimension U/M
C Z-ADDCDACQT ZFACQT Order qty in or
C MOVEL*BLANK ZFABZW Foreign descrip
C Z-ADD*ZERO ZFACK0 Sel-prc ord u/m
C Z-ADD*ZERO ZFACRN Net sales amoun
C MOVELCDALTX ZFALTX Item descriptio
C MOVELCDUUSA ZFUUSA User Field - Sw
C MOVELCDUUCA ZFUUCA User Field - Co
C MOVELCDUUCB ZFUUCB User Field - Co
C MOVELCDUUCC ZFUUCC User Field - Co
C Z-ADDCDUUQ1 ZFUUQ1 User Field - Qu
C Z-ADDCDUUA1 ZFUUA1 User Field - Am
C Z-ADDCDUUD1 ZFUUD1 User Field - Da
C Z-ADDCDAFFG ZFAFFG User Field - Da
C MOVELCDAFFC ZFAFFC Carrier - SP Re
C MOVELCDA0CD ZFA0CD Item accounting
C MOVELCDZ9H5 ZFZ9H5 Tax transaction
C MOVELCDZ9JD ZFZ9JD Tax class
C Z-ADDCDZ9QG ZFZ9QG Tax include net
C Z-ADDCDZ9QH ZFZ9QH Tax include net
C Z-ADDCDZ9QJ ZFZ9QJ Tax include sel
C Z-ADDCDZ9QK ZFZ9QK Tax include sel
C Z-ADDCDZ901 ZFZ901 Total shipped q
C Z-ADDCDZ902 ZFZ902 Total backorder
C MOVELCDZ903 ZFZ903 Blanket item in
C MOVELCDZ904 ZFZ904 Line item type
C Z-ADDCDAFVL ZFAFVL System sequence
C Z-ADDCDAFVM ZFAFVM Stk to ord u/m
C MOVELCDFEST ZFFEST Rounding option
C Z-ADDCDAFVP ZFAFVP Blanket release
C Z-ADDCDAFVS ZFAFVS Open release nu
C Z-ADDCDDOVA ZFDOVA Selling price i
C Z-ADDCDDPVA ZFDPVA Net sales amoun
C MOVEL*BLANK ZFAA66 Ship to name US
C MOVELCDHJTX ZFHJTX Customer item n
C MOVEL*BLANK ZFAAWM Customer/item d
C Z-ADD*ZERO ZFAA35 Request date (u
C Z-ADD*ZERO ZFAAT0 Promise date (u
C MOVELCDA3CD ZFA3CD Warehouse
C MOVEL*BLANK ZFABA5 Location in war
C Z-ADDCDKHVA ZFKHVA Selling price i
C Z-ADD*ZERO ZFACRM Selling price p
C MOVELCDDGCD ZFDGCD Pricing unit of
C MOVEL*BLANK ZFABYZ Conversion desc
C MOVELCDAALM ZFAALM Original item n
C MOVELCDADM1 ZFADM1 KBC item indica
C MOVELCDZ0ZB ZFZ0ZB User field-curr
C MOVELCDAFYT ZFAFYT APC Configurati
C MOVELCDAFYV ZFAFYV APC Global ID
C MOVELCDAFYX ZFAFYX APC Item Code
C MOVELCDAFYW ZFAFYW APC Short Descr
C MOVELCDAF32 ZFAF32 Presentation It
C MOVELCDAF31 ZFAF31 Presentation It
C MOVELCDCCNB ZFCCNB Backorders?
C MOVELCDCDNB ZFCDNB Partial ship
C Z-ADDCDAF78 ZFAF78 Total release q
C Z-ADDCDAF79 ZFAF79 Allocated qty -
* Signal that format is now ready to print
C MOVE 'Y' W0CPDT 1
* Call print routine
C EXSR Q0PRNT
* PRTOBJ calls after print of detail format
* Embedded PRTOBJ : PRO:ACK/QTE item F/O
C EXSR UFSUBR Embedded PRTOBJ
* Embedded PRTOBJ : PRO:Kit Components
C EXSR UGSUBR Embedded PRTOBJ
* Embedded PRTOBJ : PRO:Quote/Order Releases
C EXSR UHSUBR Embedded PRTOBJ
* Embedded PRTOBJ : PRO:Invoice Item comments
C EXSR UISUBR Embedded PRTOBJ
* Embedded PRTOBJ : PRO:Invoice item tax
C EXSR UJSUBR Embedded PRTOBJ
*================================================================
CSR C2EXIT ENDSR
/EJECT
CSR C3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN CDAENB WZC001 Company number
C Z-ADDCDAENB WZC001
C *LIKE DEFN CDDCCD WZC002 Internal header
C MOVELCDDCCD WZC002
C *LIKE DEFN CDCVNB WZC003 Quote/order num
C MOVELCDCVNB WZC003
C *LIKE DEFN CDKTNB WZC004 User entered se
C MOVELCDKTNB WZC004
C *LIKE DEFN CDAFVL WZC005 System sequence
C Z-ADDCDAFVL WZC005
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFC OREQ '1'
C KRSC READEFCDREZF 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFC 1
* Quit if no record read
C W0EOFC IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* If line item is complete - don't print on acknowledgement
* CASE: DB1.Line item status is Complete
C CDH3ST IFEQ '50' *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
* Now select all ship tos
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0CL00 1 Company number
C MOVEL*BLANK W0CL01 1 Internal header
C MOVEL*BLANK W0CL02 1 Quote/order num
C MOVEL*BLANK W0CL03 1 User entered se
C MOVEL*BLANK W0CL04 1 System sequence
C W0EOFC IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0CL00 1 Company number
C MOVEL'Y' W0CL01 1 Internal header
C MOVEL'Y' W0CL02 1 Quote/order num
C MOVEL'Y' W0CL03 1 User entered se
C MOVEL'Y' W0CL04 1 System sequence
C ELSE
* Next record - Detect level breaks
C CDAENB IFNE WZC001 Company number
* Set on level break indicator
C MOVEL'Y' W0CL00
C END
C CDDCCD IFNE WZC002 Internal header
C W0CL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0CL01
C END
C CDCVNB IFNE WZC003 Quote/order num
C W0CL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0CL02
C END
C CDKTNB IFNE WZC004 User entered se
C W0CL02 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0CL03
C END
C CDAFVL IFNE WZC005 System sequence
C W0CL03 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0CL04
C END
C END
*================================================================
CSR C3EXIT ENDSR
/EJECT
CSR C4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0CL04 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0CP04
C END
C W0CL03 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0CP03
C END
C W0CL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0CP02
C END
C W0CL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0CP01
C END
C W0CL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0CP00
C END
C W0EOFC IFEQ '1'
C END
*================================================================
CSR C4EXIT ENDSR
/EJECT
CSR D0MAIN BEGSR
*================================================================
* PRO:ACK/QTE item F/O: Mainline
*================================================================
* Declare restrictor key work fields
C *LIKE DEFN ACAENB WQKD01 Company number
C *LIKE DEFN ACDCCD WQKD02 Internal header
C *LIKE DEFN ACCVNB WQKD03 Quote/order num
C *LIKE DEFN ACFCNB WQKD04 Line item seque
* Define keylist
C KRSD KLIST
C KFLD WQKD01 Company number
C KFLD WQKD02 Internal header
C KFLD WQKD03 Quote/order num
C KFLD WQKD04 Line item seque
* Setup key
C Z-ADDZFAENB WQKD01 Company number
C MOVELZFDCCD WQKD02 Internal header
C MOVELZFCVNB WQKD03 Quote/order num
C Z-ADDZFFCNB WQKD04 Line item seque
* Establish starting position
C KRSD SETLLMBACRE1 *
* Read first record with user selection
C EXSR D3READ
C W0EOFD IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0DL1P 1 First page
C MOVEL'Y' W0DL00 1 Company number
C MOVEL'Y' W0DL01 1 Internal header
C MOVEL'Y' W0DL02 1 Quote/order num
C MOVEL'Y' W0DL03 1 Line item seque
* Set column headings flag
C MOVE 'Y' W0DCDT
* Print report body
C W0EOFD DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR D1PHDR
* Print report detail line
C EXSR D2PDTL
* Read next record with user selection
C EXSR D3READ
* Print totals
C EXSR D4PTOT
C END WOD
C END FI
*================================================================
CSR D0EXIT ENDSR
/EJECT
CSR D1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0DL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0DP1P 1
C END
C W0DL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0DP00 1
C END
C W0DL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0DP01 1
C END
C W0DL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0DP02 1
C END
C W0DL03 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0DP03 1
C END
*================================================================
CSR D1EXIT ENDSR
/EJECT
CSR D2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C Z-ADDACAENB ZGAENB Company number
C MOVELACDCCD ZGDCCD Internal header
C MOVELACCVNB ZGCVNB Quote/order num
C Z-ADDACFCNB ZGFCNB Line item seque
C Z-ADDACKXNB ZGKXNB Feat/opt sequen
C MOVELACB4CD ZGB4CD Record code
C MOVELACEHST ZGEHST Last program to
C MOVELACB6TX ZGB6TX S-number
C MOVELACCCCD ZGCCCD Option number
C MOVELACB7TX ZGB7TX End item number
C MOVELACCDCD ZGCDCD Operation seq (
C Z-ADDACDXVA ZGDXVA Component lead
C Z-ADDACDMNB ZGDMNB Feature number
C MOVELACELST ZGELST Phantom option
C MOVELACCECD ZGCECD User sequence
C MOVELACCFCD ZGCFCD Field A27
C MOVELACENST ZGENST Last prog to ma
C Z-ADDACDYVA ZGDYVA Qty per unit -
C MOVELACA3CD ZGA3CD Warehouse
C MOVELACAITX ZGAITX Item number
C MOVELACHQTX ZGHQTX Option item num
C MOVELACB5TX ZGB5TX Invoice languag
C MOVELACALTX ZGALTX Item descriptio
* Signal that format is now ready to print
C MOVE 'Y' W0DPDT 1
* Call print routine
C EXSR Q0PRNT
*================================================================
CSR D2EXIT ENDSR
/EJECT
CSR D3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN ACAENB WZD001 Company number
C Z-ADDACAENB WZD001
C *LIKE DEFN ACDCCD WZD002 Internal header
C MOVELACDCCD WZD002
C *LIKE DEFN ACCVNB WZD003 Quote/order num
C MOVELACCVNB WZD003
C *LIKE DEFN ACFCNB WZD004 Line item seque
C Z-ADDACFCNB WZD004
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFD OREQ '1'
C KRSD READEMBACRE1 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFD 1
* Quit if no record read
C W0EOFD IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
C MOVEL'N' W0RSL *Record selecte
* Only select the options of the features
* CASE: DB1.Feature number is Not a component
C ACDMNB IFGE 1 *IF
C ACDMNB ANDLE20
C MOVEL'Y' W0RSL *Record selecte
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0DL00 1 Company number
C MOVEL*BLANK W0DL01 1 Internal header
C MOVEL*BLANK W0DL02 1 Quote/order num
C MOVEL*BLANK W0DL03 1 Line item seque
C W0EOFD IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0DL00 1 Company number
C MOVEL'Y' W0DL01 1 Internal header
C MOVEL'Y' W0DL02 1 Quote/order num
C MOVEL'Y' W0DL03 1 Line item seque
C ELSE
* Next record - Detect level breaks
C ACAENB IFNE WZD001 Company number
* Set on level break indicator
C MOVEL'Y' W0DL00
C END
C ACDCCD IFNE WZD002 Internal header
C W0DL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0DL01
C END
C ACCVNB IFNE WZD003 Quote/order num
C W0DL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0DL02
C END
C ACFCNB IFNE WZD004 Line item seque
C W0DL02 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0DL03
C END
C END
*================================================================
CSR D3EXIT ENDSR
/EJECT
CSR D4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0DL03 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0DP03
C END
C W0DL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0DP02
C END
C W0DL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0DP01
C END
C W0DL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0DP00
C END
C W0EOFD IFEQ '1'
* If there is not enough space on the
* physical page for this format:
C @$PGL SUB @$CLN @$WRK
C @$WRK IFLE 1
* Signal new page required
C MOVE 'Y' W0NEWP
* Start new page
C EXSR Q0PRNT
C END
* Print format
C WRITEZHFINTTL
C END
*================================================================
CSR D4EXIT ENDSR
/EJECT
CSR E0MAIN BEGSR
*================================================================
* PRO:Kit Components: Mainline
*================================================================
* Declare restrictor key work fields
C *LIKE DEFN CAAITX WQKE01 Item number
* Define keylist
C KRSE KLIST
C KFLD WQKE01 Item number
* Setup key
C MOVELZFAITX WQKE01 Item number
* Establish starting position
C KRSE SETLLFEVREJU *
* Read first record with user selection
C EXSR E3READ
C W0EOFE IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0EL1P 1 First page
C MOVEL'Y' W0EL00 1 Item number
* Set column headings flag
C MOVE 'Y' W0ECDT
* Print report body
C W0EOFE DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR E1PHDR
* Print report detail line
C EXSR E2PDTL
* Read next record with user selection
C EXSR E3READ
* Print totals
C EXSR E4PTOT
C END WOD
C END FI
*================================================================
CSR E0EXIT ENDSR
/EJECT
CSR E1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0EL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0EP1P 1
C END
C W0EL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0EP00 1
C END
*================================================================
CSR E1EXIT ENDSR
/EJECT
CSR E2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C MOVELCAAITX ZJAITX Item number
C MOVELCAGYTX ZJGYTX Component item
C MOVEL*BLANK ZJAC1T Unit of measure
C Z-ADD*ZERO ZJABD2 Shipped quantit
C MOVEL*BLANK ZJACLQ Item Descriptio
C MOVEL*BLANK ZJAAR1 Item descriptio
C Z-ADDCAJ6NB ZJJ6NB Quantity per
C Z-ADDCAJ4NB ZJJ4NB User sequence n
C Z-ADDCAJ5NB ZJJ5NB Component cost
C MOVELCAUUSA ZJUUSA User Field - Sw
C MOVELCAUUCA ZJUUCA User Field - Co
C MOVELCAUUCB ZJUUCB User Field - Co
C MOVELCAUUCC ZJUUCC User Field - Co
C Z-ADDCAUUD1 ZJUUD1 User Field - Da
C Z-ADDCAALDT ZJALDT Create date
C Z-ADDCAABTM ZJABTM Create time
C MOVELCAAFVN ZJAFVN Created by user
C MOVELCAAGVN ZJAGVN Created by prog
C Z-ADDCAAMDT ZJAMDT Change date
C Z-ADDCAACTM ZJACTM Change time
C MOVELCAAHVN ZJAHVN Changed by user
C MOVELCAAIVN ZJAIVN Changed by prog
* Signal that format is now ready to print
C MOVE 'Y' W0EPDT 1
* Call print routine
C EXSR Q0PRNT
*================================================================
CSR E2EXIT ENDSR
/EJECT
CSR E3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN CAAITX WZE001 Item number
C MOVELCAAITX WZE001
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFE OREQ '1'
C KRSE READEFEVREJU 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFE 1
* Quit if no record read
C W0EOFE IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
C MOVEL'N' W0RSL *Record selecte
* RTV:Component Exist? - Release *
C EXSR NJRVGN
* CASE: WRK.Record found? is Yes
C WUACM1 IFEQ '1' *IF
C MOVEL'Y' W0RSL *Record selecte
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0EL00 1 Item number
C W0EOFE IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0EL00 1 Item number
C ELSE
* Next record - Detect level breaks
C CAAITX IFNE WZE001 Item number
* Set on level break indicator
C MOVEL'Y' W0EL00
C END
C END
*================================================================
CSR E3EXIT ENDSR
/EJECT
CSR E4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0EL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0EP00
C END
C W0EOFE IFEQ '1'
* If there is not enough space on the
* physical page for this format:
C @$PGL SUB @$CLN @$WRK
C @$WRK IFLE 1
* Signal new page required
C MOVE 'Y' W0NEWP
* Start new page
C EXSR Q0PRNT
C END
* Print format
C WRITEZKFINTTL
C END
*================================================================
CSR E4EXIT ENDSR
/EJECT
CSR F0MAIN BEGSR
*================================================================
* PRO:Quote/Order Releases: Mainline
*================================================================
* Declare restrictor key work fields
C *LIKE DEFN WHAENB WQKF01 Company number
C *LIKE DEFN WHDCCD WQKF02 Internal header
C *LIKE DEFN WHCVNB WQKF03 Quote/order num
C *LIKE DEFN WHFCNB WQKF04 Line item seque
* Define keylist
C KRSF KLIST
C KFLD WQKF01 Company number
C KFLD WQKF02 Internal header
C KFLD WQKF03 Quote/order num
C KFLD WQKF04 Line item seque
* Setup key
C Z-ADDZFAENB WQKF01 Company number
C MOVELZFDCCD WQKF02 Internal header
C MOVELZFCVNB WQKF03 Quote/order num
C Z-ADDZFFCNB WQKF04 Line item seque
* Establish starting position
C KRSF SETLLFADREMC *
* Read first record with user selection
C EXSR F3READ
C W0EOFF IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0FL1P 1 First page
C MOVEL'Y' W0FL00 1 Company number
C MOVEL'Y' W0FL01 1 Internal header
C MOVEL'Y' W0FL02 1 Quote/order num
C MOVEL'Y' W0FL03 1 Line item seque
C MOVEL'Y' W0FL04 1 Release number
* Set column headings flag
C MOVE 'Y' W0FCDT
* Print report body
C W0EOFF DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR F1PHDR
* Print report detail line
C EXSR F2PDTL
* Read next record with user selection
C EXSR F3READ
* Print totals
C EXSR F4PTOT
C END WOD
C END FI
*================================================================
CSR F0EXIT ENDSR
/EJECT
CSR F1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0FL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0FP1P 1
C END
C W0FL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0FP00 1
C END
C W0FL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0FP01 1
C END
C W0FL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0FP02 1
C END
C W0FL03 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0FP03 1
C END
C W0FL04 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0FP04 1
C END
*================================================================
CSR F1EXIT ENDSR
/EJECT
CSR F2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C Z-ADDWHAENB ZLAENB Company number
C MOVELWHDCCD ZLDCCD Internal header
C MOVELWHCVNB ZLCVNB Quote/order num
C Z-ADDWHFCNB ZLFCNB Line item seque
C MOVELWHAA26 ZLAA26 Item number
C Z-ADDWHDRNB ZLDRNB Release number
C MOVELWHAA27 ZLAA27 Warehouse
C Z-ADDWHDZVA ZLDZVA Release quantit
C MOVELWHHJTX ZLHJTX Customer item n
C Z-ADDWHAASZ ZLAASZ Kit release seq
C MOVELWHH2TX ZLH2TX Industry item n
C Z-ADDWHBJDT ZLBJDT Latest request
C Z-ADDWHBIDT ZLBIDT Latest promise
C Z-ADDWHAKDT ZLAKDT Manufacturing d
C MOVELWHIJST ZLIJST Allocation stat
C Z-ADDWHZ93N ZLZ93N Pick list quant
C Z-ADDWHZ93T ZLZ93T Pick list
C Z-ADDWHCANB ZLCANB Customer number
C MOVELWHZ08D ZLZ08D Promise dte upd
C MOVELWHZ08F ZLZ08F Mfg due dte upd
C Z-ADDWHAFVL ZLAFVL System sequence
C Z-ADDWHAF79 ZLAF79 Allocated qty -
C Z-ADDWHAF70 ZLAF70 Shipped qty - s
* Signal that format is now ready to print
C MOVE 'Y' W0FPDT 1
* Call print routine
C EXSR Q0PRNT
*================================================================
CSR F2EXIT ENDSR
/EJECT
CSR F3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN WHAENB WZF001 Company number
C Z-ADDWHAENB WZF001
C *LIKE DEFN WHDCCD WZF002 Internal header
C MOVELWHDCCD WZF002
C *LIKE DEFN WHCVNB WZF003 Quote/order num
C MOVELWHCVNB WZF003
C *LIKE DEFN WHFCNB WZF004 Line item seque
C Z-ADDWHFCNB WZF004
C *LIKE DEFN WHDRNB WZF005 Release number
C Z-ADDWHDRNB WZF005
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFF OREQ '1'
C KRSF READEFADREMC 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFF 1
* Quit if no record read
C W0EOFF IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* Acknowledgement print selection.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C MOVEL*BLANK WUPGM *PROGRAM
C MOVEL'AMBFMPFR'WUPGM *PROGRAM
* If Release_status is Complete - do not print.
* CASE: RELEASE COMPLETE AND ACKNOWLEDGEMENT
* - c1 AND c2
* |- c1 : DB1.Release status is Complete
* |- c2 : JOB.*PROGRAM EQ WRK.*PROGRAM
* '-
C MOVEL'0' Y0CX01 1
C WHHFCD IFEQ '50' *IF
C ZZPGM IFEQ WUPGM *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
* If kit component release record - do not print.
* CASE:
* - c1 AND c2
* |- c1 : DB1.Kit/component indicator is Kit Component
* |- c2 : PAR.Kit ext doc print option is No
* '-
C MOVEL'0' Y0CX01 1
C WHILST IFEQ '2' *IF
C WUIQST IFEQ '0' *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0FL00 1 Company number
C MOVEL*BLANK W0FL01 1 Internal header
C MOVEL*BLANK W0FL02 1 Quote/order num
C MOVEL*BLANK W0FL03 1 Line item seque
C MOVEL*BLANK W0FL04 1 Release number
C W0EOFF IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0FL00 1 Company number
C MOVEL'Y' W0FL01 1 Internal header
C MOVEL'Y' W0FL02 1 Quote/order num
C MOVEL'Y' W0FL03 1 Line item seque
C MOVEL'Y' W0FL04 1 Release number
C ELSE
* Next record - Detect level breaks
C WHAENB IFNE WZF001 Company number
* Set on level break indicator
C MOVEL'Y' W0FL00
C END
C WHDCCD IFNE WZF002 Internal header
C W0FL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0FL01
C END
C WHCVNB IFNE WZF003 Quote/order num
C W0FL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0FL02
C END
C WHFCNB IFNE WZF004 Line item seque
C W0FL02 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0FL03
C END
C WHDRNB IFNE WZF005 Release number
C W0FL03 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0FL04
C END
C END
*================================================================
CSR F3EXIT ENDSR
/EJECT
CSR F4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0FL04 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0FP04
C END
C W0FL03 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0FP03
C END
C W0FL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0FP02
C END
C W0FL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0FP01
C END
C W0FL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0FP00
C END
C W0EOFF IFEQ '1'
* If there is not enough space on the
* physical page for this format:
C @$PGL SUB @$CLN @$WRK
C @$WRK IFLE 2
* Signal new page required
C MOVE 'Y' W0NEWP
* Start new page
C EXSR Q0PRNT
C END
* Print format
C WRITEZMFINTTL
C END
*================================================================
CSR F4EXIT ENDSR
/EJECT
CSR G0MAIN BEGSR
*================================================================
* PRO:Invoice Item comments: Mainline
*================================================================
* Declare restrictor key work fields
C *LIKE DEFN WCAENB WQKG01 Company number
C *LIKE DEFN WCGGNB WQKG02 Invoice number
C *LIKE DEFN WCHYNB WQKG03 Invoice sequenc
* Define keylist
C KRSG KLIST
C KFLD WQKG01 Company number
C KFLD WQKG02 Invoice number
C KFLD WQKG03 Invoice sequenc
* Setup key
C Z-ADDZFAENB WQKG01 Company number
C Z-ADD*ZERO WQKG02 Invoice number
C Z-ADDP3HYNB WQKG03 Invoice sequenc
* Establish starting position
C KRSG SETLLFGACPYO *
* Read first record with user selection
C EXSR G3READ
C W0EOFG IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0GL1P 1 First page
C MOVEL'Y' W0GL00 1 Company number
C MOVEL'Y' W0GL01 1 Invoice number
C MOVEL'Y' W0GL02 1 Invoice sequenc
C MOVEL'Y' W0GL03 1 Comment line se
* Set column headings flag
C MOVE 'Y' W0GCDT
* Print report body
C W0EOFG DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR G1PHDR
* Print report detail line
C EXSR G2PDTL
* Read next record with user selection
C EXSR G3READ
* Print totals
C EXSR G4PTOT
C END WOD
C END FI
*================================================================
CSR G0EXIT ENDSR
/EJECT
CSR G1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0GL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0GP1P 1
C END
C W0GL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0GP00 1
C END
C W0GL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0GP01 1
C END
C W0GL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0GP02 1
C END
C W0GL03 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0GP03 1
C END
*================================================================
CSR G1EXIT ENDSR
/EJECT
CSR G2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C MOVEL*BLANK ZNAFD5 Text Line Descr
C Z-ADDWCAENB ZNAENB Company number
C Z-ADDWCGGNB ZNGGNB Invoice number
C Z-ADDWCHYNB ZNHYNB Invoice sequenc
C Z-ADDWCKBNB ZNKBNB Comment line se
C MOVELWCAKCD ZNAKCD Language code
C MOVELWCAAD9 ZNAAD9 Internal print
C MOVELWCHDTX ZNHDTX Comment line te
C MOVELWCHXCD ZNHXCD Comment user re
C MOVELWCDCCD ZNDCCD Internal header
C MOVELWCCVNB ZNCVNB Quote/order num
C Z-ADDWCK4NB ZNK4NB Shipment header
C Z-ADDWCAFAD ZNAFAD Shipment consol
C Z-ADDWCLCNB ZNLCNB Ship release se
C Z-ADDWCAASZ ZNAASZ Kit release seq
C Z-ADDWCAAD2 ZNAAD2 Special charge
C MOVELWCAD1N ZNAD1N Text line print
C Z-ADDWCALDT ZNALDT Create date
C Z-ADDWCABTM ZNABTM Create time
C MOVELWCAFVN ZNAFVN Created by user
C MOVELWCAGVN ZNAGVN Created by prog
* Signal that format is now ready to print
C MOVE 'Y' W0GPDT 1
* Call print routine
C EXSR Q0PRNT
*================================================================
CSR G2EXIT ENDSR
/EJECT
CSR G3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN WCAENB WZG001 Company number
C Z-ADDWCAENB WZG001
C *LIKE DEFN WCGGNB WZG002 Invoice number
C Z-ADDWCGGNB WZG002
C *LIKE DEFN WCHYNB WZG003 Invoice sequenc
C Z-ADDWCHYNB WZG003
C *LIKE DEFN WCKBNB WZG004 Comment line se
C Z-ADDWCKBNB WZG004
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFG OREQ '1'
C KRSG READEFGACPYO 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFG 1
* Quit if no record read
C W0EOFG IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* Make sure we are supposed to print this comment and it is line it
* CASE: DB1.Internal print only? is Yes
C WCAAD9 IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C ELSE
* CASE: DB1.Special charge sequence # is Not Zero
C WCAAD2 IFNE *ZERO *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END *FI
* See if this comment is for the line item we want.
* CASE: Make sure this is the comment we want
* - c1 OR c2 OR c3
* |- c1 : PAR.Shipment header number NE DB1.Shipment header nu
* |- c2 : PAR.Ship release sequence NE DB1.Ship release sequen
* |- c3 : PAR.Kit release sequence NE DB1.Kit release sequence
* '-
C 1 IFNE WCK4NB *IF
C ZFFCNB ORNE WCLCNB *OR
C *ZERO ORNE WCAASZ *OR
C MOVEL'N' W0RSL *Record selecte
C END *FI
* Do not print local comments if foreign comment print only.
* CASE: If foreign text only and lang not OK do not select
* - c1 AND c2 AND c3
* |- c1 : PAR.Document language format is Foreign text only
* |- c2 : DB1.Language code NE PAR.Language code
* |- c3 : PGM.*Record selected is *YES
* '-
C MOVEL'0' Y0CX01 1
C C6BDST IFEQ '1' *IF
C WCAKCD IFNE CDAKCD *IF
C W0RSL IFEQ 'Y' *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0GL00 1 Company number
C MOVEL*BLANK W0GL01 1 Invoice number
C MOVEL*BLANK W0GL02 1 Invoice sequenc
C MOVEL*BLANK W0GL03 1 Comment line se
C W0EOFG IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0GL00 1 Company number
C MOVEL'Y' W0GL01 1 Invoice number
C MOVEL'Y' W0GL02 1 Invoice sequenc
C MOVEL'Y' W0GL03 1 Comment line se
C ELSE
* Next record - Detect level breaks
C WCAENB IFNE WZG001 Company number
* Set on level break indicator
C MOVEL'Y' W0GL00
C END
C WCGGNB IFNE WZG002 Invoice number
C W0GL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0GL01
C END
C WCHYNB IFNE WZG003 Invoice sequenc
C W0GL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0GL02
C END
C WCKBNB IFNE WZG004 Comment line se
C W0GL02 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0GL03
C END
C END
*================================================================
CSR G3EXIT ENDSR
/EJECT
CSR G4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0GL03 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0GP03
C END
C W0GL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0GP02
C END
C W0GL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0GP01
C END
C W0GL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0GP00
C END
C W0EOFG IFEQ '1'
* If there is not enough space on the
* physical page for this format:
C @$PGL SUB @$CLN @$WRK
C @$WRK IFLE 1
* Signal new page required
C MOVE 'Y' W0NEWP
* Start new page
C EXSR Q0PRNT
C END
* Print format
C WRITEZOFINTTL
C END
*================================================================
CSR G4EXIT ENDSR
/EJECT
CSR H0MAIN BEGSR
*================================================================
* PRO:Invoice item tax: Mainline
*================================================================
* PRO:Invoice item tax: Initialise
C EXSR ZHINIT
* Declare restrictor key work fields
C *LIKE DEFN GFAENB WQKH01 Company number
C *LIKE DEFN GFDCCD WQKH02 Internal header
C *LIKE DEFN GFCVNB WQKH03 Quote/order num
C *LIKE DEFN GFK4NB WQKH04 Shipment header
C *LIKE DEFN GFLCNB WQKH05 Ship release se
* Define keylist
C KRSH KLIST
C KFLD WQKH01 Company number
C KFLD WQKH02 Internal header
C KFLD WQKH03 Quote/order num
C KFLD WQKH04 Shipment header
C KFLD WQKH05 Ship release se
* Setup key
C Z-ADDZFAENB WQKH01 Company number
C MOVELZFDCCD WQKH02 Internal header
C MOVELZFCVNB WQKH03 Quote/order num
C Z-ADD1 WQKH04 Shipment header
C Z-ADDZFFCNB WQKH05 Ship release se
* Establish starting position
C KRSH SETLLFGFCPO0 *
* Read first record with user selection
C EXSR H3READ
C W0EOFH IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0HL1P 1 First page
C MOVEL'Y' W0HL00 1 Company number
C MOVEL'Y' W0HL01 1 Internal header
C MOVEL'Y' W0HL02 1 Quote/order num
C MOVEL'Y' W0HL03 1 Shipment header
C MOVEL'Y' W0HL04 1 Ship release se
C MOVEL'Y' W0HL05 1 Kit release seq
C MOVEL'Y' W0HL06 1 Tax sequence
* Set column headings flag
C MOVE 'Y' W0HCDT
* Print report body
C W0EOFH DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR H1PHDR
* Print report detail line
C EXSR H2PDTL
* Read next record with user selection
C EXSR H3READ
* Print totals
C EXSR H4PTOT
C END WOD
C END FI
*================================================================
CSR H0EXIT ENDSR
/EJECT
CSR H1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0HL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0HP1P 1
C END
C W0HL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0HP00 1
C END
C W0HL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0HP01 1
C END
C W0HL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0HP02 1
C END
C W0HL03 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0HP03 1
C END
C W0HL04 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0HP04 1
C END
C W0HL05 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0HP05 1
C END
C W0HL06 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0HP06 1
C END
*================================================================
CSR H1EXIT ENDSR
/EJECT
CSR H2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C Z-ADDGFAENB ZPAENB Company number
C Z-ADDGFGGNB ZPGGNB Invoice number
C Z-ADDGFHYNB ZPHYNB Invoice sequenc
C MOVELGFACHG ZPACHG Tax group code
C Z-ADDGFAAG2 ZPAAG2 Tax sequence
C MOVELGFG0ST ZPG0ST Tax base code
C Z-ADDGFZ0D6 ZPZ0D6 Compound tax up
C MOVELGFAAG3 ZPAAG3 Line item type
C MOVELGFACHJ ZPACHJ Inv lang tax in
C MOVELGFZ9T1 ZPZ9T1 Tax code (atr)
C MOVELGFZ9VA ZPZ9VA Tax code result
C MOVELGFZ9T2 ZPZ9T2 Tax adj for cas
C MOVELGFZ9T3 ZPZ9T3 Tax in price -
C MOVELGFZ9T4 ZPZ9T4 Tax in price -
C MOVELGFZ9T5 ZPZ9T5 Compound tax co
C MOVELGFZ9VB ZPZ9VB Compound tax co
C MOVELGFZ9T6 ZPZ9T6 Tax base amt su
C MOVELGFZ9T7 ZPZ9T7 Tax rate substi
C Z-ADDGFZ9VC ZPZ9VC Tax rate
C MOVELGFZ9VD ZPZ9VD Tax rate method
C Z-ADDGFZ9VF ZPZ9VF Tax recovery pe
C MOVELGFZ9T8 ZPZ9T8 Inc tax in cash
C MOVELGFZ9T9 ZPZ9T9 Use tax flag
C MOVELGFZ9T0 ZPZ9T0 EC memo tax fla
C MOVELGFZ9VH ZPZ9VH Tax rate derive
C MOVELGFZ9VJ ZPZ9VJ Information onl
C MOVELGFZ9VK ZPZ9VK Tax is invoiced
C MOVELGFZ9VL ZPZ9VL Tax liab/rec na
C MOVELGFZ9VR ZPZ9VR Discount inc/ex
C MOVELGFZ9VS ZPZ9VS Write-off inc/e
C MOVELGFZ9VT ZPZ9VT Adjustment inc/
C MOVELGFZ9VV ZPZ9VV Use/memo liab/r
C MOVELGFZ9VW ZPZ9VW Use/memo offset
C MOVELGFZ9VX ZPZ9VX Non-recoverable
C Z-ADDGFZ9VM ZPZ9VM Tax exclusive p
C Z-ADDGFZ9VN ZPZ9VN Tax inclusive p
C Z-ADDGFZ9VP ZPZ9VP Original tax ba
C Z-ADDGFZ9VQ ZPZ9VQ Recoverable tax
C Z-ADDGFZ9VY ZPZ9VY Recoverable tax
C Z-ADDGFZ9VZ ZPZ9VZ Effective tax r
C MOVELGFZ9V1 ZPZ9V1 Currency id (at
C MOVELGFCHGU ZPCHGU Charge unit
C MOVELGFCHGN ZPCHGN Charge nature
C MOVELGFOFFU ZPOFFU Offset unit
C MOVELGFOFFN ZPOFFN Offset nature
C MOVELGFAJCD ZPAJCD Tax indicator
C MOVELGFZ9H5 ZPZ9H5 Tax transaction
C MOVELGFZ9WV ZPZ9WV Invoice-to/from
C MOVELGFB9CD ZPB9CD Ship to number
C MOVELGFZ9WW ZPZ9WW Ship-to/buy-fro
C MOVELGFAITX ZPAITX Item number
C MOVELGFZ9N0 ZPZ9N0 Item tax class
C MOVELGFGTCD ZPGTCD Special charge
C MOVELGFA3CD ZPA3CD Warehouse
C Z-ADDGFZ9WX ZPZ9WX Order quantity
C MOVELGFANCD ZPANCD Unit of measure
C Z-ADDGFZ9WY ZPZ9WY Transaction cas
C Z-ADDGFZ9WZ ZPZ9WZ Transaction cas
C Z-ADDGFGYVA ZPGYVA Tax amount
C MOVELGFACHH ZPACHH Tax invoice tex
C MOVELGFDCCD ZPDCCD Internal header
C MOVELGFCVNB ZPCVNB Quote/order num
C Z-ADDGFK4NB ZPK4NB Shipment header
C Z-ADDGFLCNB ZPLCNB Ship release se
C Z-ADDGFAASZ ZPAASZ Kit release seq
C Z-ADDGFAFAD ZPAFAD Shipment consol
C Z-ADDGFAAD2 ZPAAD2 Special charge
C Z-ADDGFZ9WH ZPZ9WH Original charge
C MOVELGFZ9ZY ZPZ9ZY Tax in price ca
C Z-ADDGFAHPC ZPAHPC Trade discount
C Z-ADDGFZ9ZZ ZPZ9ZZ Transaction amo
* Signal that format is now ready to print
C MOVE 'Y' W0HPDT 1
* Call print routine
C EXSR Q0PRNT
*================================================================
CSR H2EXIT ENDSR
/EJECT
CSR H3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN GFAENB WZH001 Company number
C Z-ADDGFAENB WZH001
C *LIKE DEFN GFDCCD WZH002 Internal header
C MOVELGFDCCD WZH002
C *LIKE DEFN GFCVNB WZH003 Quote/order num
C MOVELGFCVNB WZH003
C *LIKE DEFN GFK4NB WZH004 Shipment header
C Z-ADDGFK4NB WZH004
C *LIKE DEFN GFLCNB WZH005 Ship release se
C Z-ADDGFLCNB WZH005
C *LIKE DEFN GFAASZ WZH006 Kit release seq
C Z-ADDGFAASZ WZH006
C *LIKE DEFN GFAAG2 WZH007 Tax sequence
C Z-ADDGFAAG2 WZH007
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFH OREQ '1'
C KRSH READEFGFCPO0 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFH 1
* Quit if no record read
C W0EOFH IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* Do not select line item surcharge taxes.
* CASE: DB1.Special charge sequence # is Not Zero
C GFAAD2 IFNE *ZERO *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
* Do not print tax if amount is zero.
* CASE: DB1.Tax amount is Zero
C GFGYVA IFEQ *ZERO *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
* Do not print tax if: Tax in price, EC memo tax, or not invoiced.
* CASE:
* - c1 OR c2 OR c3 OR c4 OR c5
* |- c1 : DB1.Tax in price - Europe is Yes
* |- c2 : DB1.Tax in price - Brazil is Yes
* |- c3 : DB1.EC memo tax flag is Yes
* |- c4 : DB1.Tax is invoiced flag is No
* |- c5 : DB1.Use tax flag is Yes
* '-
C GFZ9T3 IFEQ '1' *IF
C GFZ9T4 OREQ '1' *OR
C GFZ9T0 OREQ '1' *OR
C GFZ9VK OREQ '0' *OR
C GFZ9T9 OREQ '1' *OR
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0HL00 1 Company number
C MOVEL*BLANK W0HL01 1 Internal header
C MOVEL*BLANK W0HL02 1 Quote/order num
C MOVEL*BLANK W0HL03 1 Shipment header
C MOVEL*BLANK W0HL04 1 Ship release se
C MOVEL*BLANK W0HL05 1 Kit release seq
C MOVEL*BLANK W0HL06 1 Tax sequence
C W0EOFH IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0HL00 1 Company number
C MOVEL'Y' W0HL01 1 Internal header
C MOVEL'Y' W0HL02 1 Quote/order num
C MOVEL'Y' W0HL03 1 Shipment header
C MOVEL'Y' W0HL04 1 Ship release se
C MOVEL'Y' W0HL05 1 Kit release seq
C MOVEL'Y' W0HL06 1 Tax sequence
C ELSE
* Next record - Detect level breaks
C GFAENB IFNE WZH001 Company number
* Set on level break indicator
C MOVEL'Y' W0HL00
C END
C GFDCCD IFNE WZH002 Internal header
C W0HL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0HL01
C END
C GFCVNB IFNE WZH003 Quote/order num
C W0HL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0HL02
C END
C GFK4NB IFNE WZH004 Shipment header
C W0HL02 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0HL03
C END
C GFLCNB IFNE WZH005 Ship release se
C W0HL03 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0HL04
C END
C GFAASZ IFNE WZH006 Kit release seq
C W0HL04 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0HL05
C END
C GFAAG2 IFNE WZH007 Tax sequence
C W0HL05 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0HL06
C END
C END
*================================================================
CSR H3EXIT ENDSR
/EJECT
CSR H4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0HL06 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0HP06
C END
C W0HL05 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0HP05
C END
C W0HL04 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0HP04
C END
C W0HL03 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0HP03
C END
C W0HL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0HP02
C END
C W0HL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0HP01
C END
C W0HL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0HP00
C END
C W0EOFH IFEQ '1'
* If there is not enough space on the
* physical page for this format:
C @$PGL SUB @$CLN @$WRK
C @$WRK IFLE 1
* Signal new page required
C MOVE 'Y' W0NEWP
* Start new page
C EXSR Q0PRNT
C END
* Print format
C WRITEZQFINTTL
C END
*================================================================
CSR H4EXIT ENDSR
/EJECT
CSR I0MAIN BEGSR
*================================================================
* PRO:Invoice special charg: Mainline
*================================================================
* PRO:Invoice special charg: Initialise
C EXSR ZIINIT
* Declare restrictor key work fields
C *LIKE DEFN F9AENB WQKI01 Company number
C *LIKE DEFN F9GGNB WQKI02 Invoice number
C *LIKE DEFN F9HYNB WQKI03 Invoice sequenc
* Define keylist
C KRSI KLIST
C KFLD WQKI01 Company number
C KFLD WQKI02 Invoice number
C KFLD WQKI03 Invoice sequenc
* Setup key
C Z-ADDC6AENB WQKI01 Company number
C Z-ADD*ZERO WQKI02 Invoice number
C Z-ADDP3HYNB WQKI03 Invoice sequenc
* Establish starting position
C KRSI SETLLFF9CPPJ *
* Read first record with user selection
C EXSR I3READ
C W0EOFI IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0IL1P 1 First page
C MOVEL'Y' W0IL00 1 Company number
C MOVEL'Y' W0IL01 1 Invoice number
C MOVEL'Y' W0IL02 1 Invoice sequenc
* Set column headings flag
C MOVE 'Y' W0ICDT
* Print report body
C W0EOFI DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR I1PHDR
* Print report detail line
C EXSR I2PDTL
* Read next record with user selection
C EXSR I3READ
* Print totals
C EXSR I4PTOT
C END WOD
C END FI
*================================================================
CSR I0EXIT ENDSR
/EJECT
CSR I1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0IL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0IP1P 1
C END
C W0IL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0IP00 1
C END
C W0IL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0IP01 1
C END
C W0IL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0IP02 1
C END
*================================================================
CSR I1EXIT ENDSR
/EJECT
CSR I2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C Z-ADDF9AENB ZRAENB Company number
C Z-ADDF9GGNB ZRGGNB Invoice number
C Z-ADDF9HYNB ZRHYNB Invoice sequenc
C Z-ADDF9AAD2 ZRAAD2 Special charge
C MOVELF9GTCD ZRGTCD Special charge
C MOVELF9BLST ZRBLST Special charge
C MOVELF9AA73 ZRAA73 Foreign descrip
C Z-ADDF9DDVA ZRDDVA Special charge
C MOVELF9BXTX ZRBXTX Special charge
C Z-ADDF9AAD4 ZRAAD4 LC special char
C Z-ADDF9DEVA ZRDEVA Special charge
C MOVELF9AAD6 ZRAAD6 Tax indicator 1
C MOVELF9AAD7 ZRAAD7 Surcharge code
C MOVELF9AAD5 ZRAAD5 Terms discount
C MOVELF9AAD8 ZRAAD8 Surcharge detai
C MOVELF9AABT ZRAABT Print before?
C MOVELF9AD0R ZRAD0R Item Reference
C MOVELF9Z9H5 ZRZ9H5 Tax transaction
C MOVELF9Z9JD ZRZ9JD Tax class
C Z-ADDF9Z9QD ZRZ9QD Tax include spe
C Z-ADDF9Z9QF ZRZ9QF Tax include Spe
C MOVELF9DCCD ZRDCCD Internal header
C MOVELF9CVNB ZRCVNB Quote/order num
C Z-ADDF9K4NB ZRK4NB Shipment header
C Z-ADDF9AFAD ZRAFAD Shipment consol
C Z-ADDF9LCNB ZRLCNB Ship release se
C Z-ADDF9AASZ ZRAASZ Kit release seq
* Signal that format is now ready to print
C MOVE 'Y' W0IPDT 1
* Call print routine
C EXSR Q0PRNT
* PRTOBJ calls after print of detail format
* Embedded PRTOBJ : PRO:Invoice Hdr comments
C EXSR UMSUBR Embedded PRTOBJ
* Embedded PRTOBJ : PRO:Invoice spc chg tax
C EXSR UNSUBR Embedded PRTOBJ
*================================================================
CSR I2EXIT ENDSR
/EJECT
CSR I3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN F9AENB WZI001 Company number
C Z-ADDF9AENB WZI001
C *LIKE DEFN F9GGNB WZI002 Invoice number
C Z-ADDF9GGNB WZI002
C *LIKE DEFN F9HYNB WZI003 Invoice sequenc
C Z-ADDF9HYNB WZI003
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFI OREQ '1'
C KRSI READEFF9CPPJ 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFI 1
* Quit if no record read
C W0EOFI IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* CASE: WRK.&No of Special charges is GT 0
C WUAC0B IFGT *ZERO *IF
* Print special charges?
* CASE: PAR.Ord ship not inv flg USR is Yes
C WUZ9DA IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C ELSE
* CASE: *OTHERWISE
* There are still special charges to print
* RTV:Next Special Charge - History Special Charge *
C EXSR OHRVGN
C END *FI
C SUB 1 WUAC0B &No of Special
C ELSE
* CASE: WRK.&No of Surcharges is GT 0
C WUAC0C IFGT *ZERO *IF
* There are still surcharges to print
* Bucket them
* RTV:Next Bucket Surcharge - History Special Charge *
C EXSR OKRVGN
* Do not print if amount is zero
* CASE:
* - (c1 AND (NOT c2)) OR (c3 AND c2)
* |- c1 : WRK.Special charge amount is Zero
* |- c2 : PAR.Tax in price flag is Tax in price - list
* |- c3 : WRK.Tax include Spec chrg is Zero
* '-
C MOVEL'0' Y0CX01 1
C WUDDVA IFEQ *ZERO *IF
C P5Z9JB IFEQ '1' *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFNE '1' *IF
C WUZ9QF IFEQ *ZERO *IF
C P5Z9JB IFEQ '1' *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
C SUB 1 WUAC0C &No of Surcharg
* All surcharges printed?
* CASE: PGM.*Return code is *Record already exists
C W0RTN IFEQ 'Y2U0003' *IF
C MOVEL'N' W0RSL *Record selecte
C Z-ADD*ZERO WUAC0C &No of Surcharg
C END *FI
C ELSE
* CASE: *OTHERWISE
* All surcharges and special charges have been printed
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0IL00 1 Company number
C MOVEL*BLANK W0IL01 1 Invoice number
C MOVEL*BLANK W0IL02 1 Invoice sequenc
C W0EOFI IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0IL00 1 Company number
C MOVEL'Y' W0IL01 1 Invoice number
C MOVEL'Y' W0IL02 1 Invoice sequenc
C ELSE
* Next record - Detect level breaks
C F9AENB IFNE WZI001 Company number
* Set on level break indicator
C MOVEL'Y' W0IL00
C END
C F9GGNB IFNE WZI002 Invoice number
C W0IL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0IL01
C END
C F9HYNB IFNE WZI003 Invoice sequenc
C W0IL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0IL02
C END
C END
*================================================================
CSR I3EXIT ENDSR
/EJECT
CSR I4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0IL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0IP02
C END
C W0IL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0IP01
C END
C W0IL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0IP00
C END
C W0EOFI IFEQ '1'
C END
*================================================================
CSR I4EXIT ENDSR
/EJECT
CSR J0MAIN BEGSR
*================================================================
* PRO:Invoice Hdr comments: Mainline
*================================================================
* Declare restrictor key work fields
C *LIKE DEFN WBAENB WQKJ01 Company number
C *LIKE DEFN WBGGNB WQKJ02 Invoice number
C *LIKE DEFN WBHYNB WQKJ03 Invoice sequenc
* Define keylist
C KRSJ KLIST
C KFLD WQKJ01 Company number
C KFLD WQKJ02 Invoice number
C KFLD WQKJ03 Invoice sequenc
* Setup key
C Z-ADDZRAENB WQKJ01 Company number
C Z-ADDZRGGNB WQKJ02 Invoice number
C Z-ADDZRHYNB WQKJ03 Invoice sequenc
* Establish starting position
C KRSJ SETLLFGACPLS *
* Read first record with user selection
C EXSR J3READ
C W0EOFJ IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0JL1P 1 First page
C MOVEL'Y' W0JL00 1 Company number
C MOVEL'Y' W0JL01 1 Invoice number
C MOVEL'Y' W0JL02 1 Invoice sequenc
C MOVEL'Y' W0JL03 1 Internal header
C MOVEL'Y' W0JL04 1 Quote/order num
C MOVEL'Y' W0JL05 1 Comment user re
C MOVEL'Y' W0JL06 1 Comment line se
* Set column headings flag
C MOVE 'Y' W0JCDT
* Print report body
C W0EOFJ DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR J1PHDR
* Print report detail line
C EXSR J2PDTL
* Read next record with user selection
C EXSR J3READ
* Print totals
C EXSR J4PTOT
C END WOD
C END FI
*================================================================
CSR J0EXIT ENDSR
/EJECT
CSR J1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0JL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0JP1P 1
C END
C W0JL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0JP00 1
C END
C W0JL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0JP01 1
C END
C W0JL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0JP02 1
C END
C W0JL03 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0JP03 1
C END
C W0JL04 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0JP04 1
C END
C W0JL05 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0JP05 1
C END
C W0JL06 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0JP06 1
C END
*================================================================
CSR J1EXIT ENDSR
/EJECT
CSR J2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C Z-ADDWBAENB ZSAENB Company number
C Z-ADDWBGGNB ZSGGNB Invoice number
C Z-ADDWBHYNB ZSHYNB Invoice sequenc
C Z-ADDWBKBNB ZSKBNB Comment line se
C MOVELWBAKCD ZSAKCD Language code
C MOVELWBAAD9 ZSAAD9 Internal print
C MOVELWBHDTX ZSHDTX Comment line te
C MOVEL*BLANK ZSAFD5 Text Line Descr
C Z-ADD*ZERO ZSACCS Date Effective
C Z-ADD*ZERO ZSAC87 Total Invoice A
C MOVEL*BLANK ZSABHW Work (Alpha 2)
C MOVELWBHXCD ZSHXCD Comment user re
C MOVELWBDCCD ZSDCCD Internal header
C MOVELWBCVNB ZSCVNB Quote/order num
C Z-ADDWBK4NB ZSK4NB Shipment header
C Z-ADDWBAFAD ZSAFAD Shipment consol
C Z-ADDWBLCNB ZSLCNB Ship release se
C Z-ADDWBAASZ ZSAASZ Kit release seq
C Z-ADDWBAAD2 ZSAAD2 Special charge
C MOVELWBAD1N ZSAD1N Text line print
C Z-ADDWBALDT ZSALDT Create date
C Z-ADDWBABTM ZSABTM Create time
C MOVELWBAFVN ZSAFVN Created by user
C MOVELWBAGVN ZSAGVN Created by prog
* Signal that format is now ready to print
C MOVE 'Y' W0JPDT 1
* Call print routine
C EXSR Q0PRNT
*================================================================
CSR J2EXIT ENDSR
/EJECT
CSR J3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN WBAENB WZJ001 Company number
C Z-ADDWBAENB WZJ001
C *LIKE DEFN WBGGNB WZJ002 Invoice number
C Z-ADDWBGGNB WZJ002
C *LIKE DEFN WBHYNB WZJ003 Invoice sequenc
C Z-ADDWBHYNB WZJ003
C *LIKE DEFN WBDCCD WZJ004 Internal header
C MOVELWBDCCD WZJ004
C *LIKE DEFN WBCVNB WZJ005 Quote/order num
C MOVELWBCVNB WZJ005
C *LIKE DEFN WBHXCD WZJ006 Comment user re
C MOVELWBHXCD WZJ006
C *LIKE DEFN WBKBNB WZJ007 Comment line se
C Z-ADDWBKBNB WZJ007
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFJ OREQ '1'
C KRSJ READEFGACPLS 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFJ 1
* Quit if no record read
C W0EOFJ IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* Make sure this is not a line item comment and it is supposed to p
* CASE: DB1.Internal print only? is Yes
C WBAAD9 IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C ELSE
* CASE: DB1.Ship release sequence is Not Zero
C WBLCNB IFNE *ZERO *IF
* Do not print comments for line items
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END *FI
* Par special charge seq NE DB1 special charge seq, then print=no
* CASE: PAR.Special charge sequence # NE DB1.Special charge sequenc
C ZRAAD2 IFNE WBAAD2 *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
* Print foreign comments only if set up for that and still OK
* CASE: If foreign text only & language OK & record select
* - c1 AND c2 AND c3
* |- c1 : PAR.Document language format is Foreign text only
* |- c2 : DB1.Language code NE PAR.Language code
* |- c3 : PGM.*Record selected is *YES
* '-
C MOVEL'0' Y0CX01 1
C C6BDST IFEQ '1' *IF
C WBAKCD IFNE C6AKCD *IF
C W0RSL IFEQ 'Y' *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0JL00 1 Company number
C MOVEL*BLANK W0JL01 1 Invoice number
C MOVEL*BLANK W0JL02 1 Invoice sequenc
C MOVEL*BLANK W0JL03 1 Internal header
C MOVEL*BLANK W0JL04 1 Quote/order num
C MOVEL*BLANK W0JL05 1 Comment user re
C MOVEL*BLANK W0JL06 1 Comment line se
C W0EOFJ IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0JL00 1 Company number
C MOVEL'Y' W0JL01 1 Invoice number
C MOVEL'Y' W0JL02 1 Invoice sequenc
C MOVEL'Y' W0JL03 1 Internal header
C MOVEL'Y' W0JL04 1 Quote/order num
C MOVEL'Y' W0JL05 1 Comment user re
C MOVEL'Y' W0JL06 1 Comment line se
C ELSE
* Next record - Detect level breaks
C WBAENB IFNE WZJ001 Company number
* Set on level break indicator
C MOVEL'Y' W0JL00
C END
C WBGGNB IFNE WZJ002 Invoice number
C W0JL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0JL01
C END
C WBHYNB IFNE WZJ003 Invoice sequenc
C W0JL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0JL02
C END
C WBDCCD IFNE WZJ004 Internal header
C W0JL02 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0JL03
C END
C WBCVNB IFNE WZJ005 Quote/order num
C W0JL03 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0JL04
C END
C WBHXCD IFNE WZJ006 Comment user re
C W0JL04 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0JL05
C END
C WBKBNB IFNE WZJ007 Comment line se
C W0JL05 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0JL06
C END
C END
*================================================================
CSR J3EXIT ENDSR
/EJECT
CSR J4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0JL06 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0JP06
C END
C W0JL05 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0JP05
C END
C W0JL04 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0JP04
C END
C W0JL03 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0JP03
C END
C W0JL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0JP02
C END
C W0JL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0JP01
C END
C W0JL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0JP00
C END
C W0EOFJ IFEQ '1'
* If there is not enough space on the
* physical page for this format:
C @$PGL SUB @$CLN @$WRK
C @$WRK IFLE 1
* Signal new page required
C MOVE 'Y' W0NEWP
* Start new page
C EXSR Q0PRNT
C END
* Print format
C WRITEZTFINTTL
C END
*================================================================
CSR J4EXIT ENDSR
/EJECT
CSR K0MAIN BEGSR
*================================================================
* PRO:Invoice spc chg tax: Mainline
*================================================================
* PRO:Invoice spc chg tax: Initialise
C EXSR ZKINIT
* Declare restrictor key work fields
C *LIKE DEFN WRAENB WQKK01 Company number
C *LIKE DEFN WRGGNB WQKK02 Invoice number
C *LIKE DEFN WRHYNB WQKK03 Invoice sequenc
* Define keylist
C KRSK KLIST
C KFLD WQKK01 Company number
C KFLD WQKK02 Invoice number
C KFLD WQKK03 Invoice sequenc
* Setup key
C Z-ADDZRAENB WQKK01 Company number
C Z-ADDZRGGNB WQKK02 Invoice number
C Z-ADDZRHYNB WQKK03 Invoice sequenc
* Establish starting position
C KRSK SETLLFGFCPWL *
* Read first record with user selection
C EXSR K3READ
C W0EOFK IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0KL1P 1 First page
C MOVEL'Y' W0KL00 1 Company number
C MOVEL'Y' W0KL01 1 Invoice number
C MOVEL'Y' W0KL02 1 Invoice sequenc
C MOVEL'Y' W0KL03 1 Special charge
C MOVEL'Y' W0KL04 1 Tax sequence
* Set column headings flag
C MOVE 'Y' W0KCDT
* Print report body
C W0EOFK DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR K1PHDR
* Print report detail line
C EXSR K2PDTL
* Read next record with user selection
C EXSR K3READ
* Print totals
C EXSR K4PTOT
C END WOD
C END FI
*================================================================
CSR K0EXIT ENDSR
/EJECT
CSR K1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0KL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0KP1P 1
C END
C W0KL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0KP00 1
C END
C W0KL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0KP01 1
C END
C W0KL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0KP02 1
C END
C W0KL03 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0KP03 1
C END
C W0KL04 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0KP04 1
C END
*================================================================
CSR K1EXIT ENDSR
/EJECT
CSR K2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C Z-ADDWRAENB ZUAENB Company number
C Z-ADDWRGGNB ZUGGNB Invoice number
C Z-ADDWRHYNB ZUHYNB Invoice sequenc
C MOVELWRACHG ZUACHG Tax group code
C Z-ADDWRAAG2 ZUAAG2 Tax sequence
C MOVELWRG0ST ZUG0ST Tax base code
C Z-ADDWRZ0D6 ZUZ0D6 Compound tax up
C MOVELWRACHJ ZUACHJ Inv lang tax in
C MOVELWRZ9T1 ZUZ9T1 Tax code (atr)
C MOVELWRZ9VA ZUZ9VA Tax code result
C MOVELWRZ9T2 ZUZ9T2 Tax adj for cas
C MOVELWRZ9T3 ZUZ9T3 Tax in price -
C MOVELWRZ9T4 ZUZ9T4 Tax in price -
C MOVELWRZ9T5 ZUZ9T5 Compound tax co
C MOVELWRZ9VB ZUZ9VB Compound tax co
C MOVELWRZ9T6 ZUZ9T6 Tax base amt su
C MOVELWRZ9T7 ZUZ9T7 Tax rate substi
C Z-ADDWRZ9VC ZUZ9VC Tax rate
C MOVELWRZ9VD ZUZ9VD Tax rate method
C Z-ADDWRZ9VF ZUZ9VF Tax recovery pe
C MOVELWRZ9T8 ZUZ9T8 Inc tax in cash
C MOVELWRZ9T9 ZUZ9T9 Use tax flag
C MOVELWRZ9T0 ZUZ9T0 EC memo tax fla
C MOVELWRZ9VH ZUZ9VH Tax rate derive
C MOVELWRZ9VJ ZUZ9VJ Information onl
C MOVELWRZ9VK ZUZ9VK Tax is invoiced
C MOVELWRZ9VL ZUZ9VL Tax liab/rec na
C MOVELWRZ9VR ZUZ9VR Discount inc/ex
C MOVELWRZ9VS ZUZ9VS Write-off inc/e
C MOVELWRZ9VT ZUZ9VT Adjustment inc/
C MOVELWRZ9VV ZUZ9VV Use/memo liab/r
C MOVELWRZ9VW ZUZ9VW Use/memo offset
C MOVELWRZ9VX ZUZ9VX Non-recoverable
C Z-ADDWRZ9VM ZUZ9VM Tax exclusive p
C Z-ADDWRZ9VN ZUZ9VN Tax inclusive p
C Z-ADDWRZ9VP ZUZ9VP Original tax ba
C Z-ADDWRZ9VQ ZUZ9VQ Recoverable tax
C Z-ADDWRZ9VY ZUZ9VY Recoverable tax
C Z-ADDWRZ9VZ ZUZ9VZ Effective tax r
C MOVELWRZ9V1 ZUZ9V1 Currency id (at
C MOVELWRCHGU ZUCHGU Charge unit
C MOVELWRCHGN ZUCHGN Charge nature
C MOVELWROFFU ZUOFFU Offset unit
C MOVELWROFFN ZUOFFN Offset nature
C MOVELWRAJCD ZUAJCD Tax indicator
C MOVELWRZ9H5 ZUZ9H5 Tax transaction
C MOVELWRZ9WV ZUZ9WV Invoice-to/from
C MOVELWRB9CD ZUB9CD Ship to number
C MOVELWRZ9WW ZUZ9WW Ship-to/buy-fro
C MOVELWRAITX ZUAITX Item number
C MOVELWRZ9N0 ZUZ9N0 Item tax class
C MOVELWRGTCD ZUGTCD Special charge
C MOVELWRA3CD ZUA3CD Warehouse
C Z-ADDWRZ9WX ZUZ9WX Order quantity
C MOVELWRANCD ZUANCD Unit of measure
C Z-ADDWRZ9WY ZUZ9WY Transaction cas
C Z-ADDWRZ9WZ ZUZ9WZ Transaction cas
C Z-ADDWRGYVA ZUGYVA Tax amount
C MOVELWRAAG3 ZUAAG3 Line item type
C MOVELWRACHH ZUACHH Tax invoice tex
C MOVELWRDCCD ZUDCCD Internal header
C MOVELWRCVNB ZUCVNB Quote/order num
C Z-ADDWRK4NB ZUK4NB Shipment header
C Z-ADDWRLCNB ZULCNB Ship release se
C Z-ADDWRAASZ ZUAASZ Kit release seq
C Z-ADDWRAFAD ZUAFAD Shipment consol
C Z-ADDWRAAD2 ZUAAD2 Special charge
C Z-ADDWRZ9WH ZUZ9WH Original charge
C MOVELWRZ9ZY ZUZ9ZY Tax in price ca
C Z-ADDWRAHPC ZUAHPC Trade discount
C Z-ADDWRZ9ZZ ZUZ9ZZ Transaction amo
* Signal that format is now ready to print
C MOVE 'Y' W0KPDT 1
* Call print routine
C EXSR Q0PRNT
*================================================================
CSR K2EXIT ENDSR
/EJECT
CSR K3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN WRAENB WZK001 Company number
C Z-ADDWRAENB WZK001
C *LIKE DEFN WRGGNB WZK002 Invoice number
C Z-ADDWRGGNB WZK002
C *LIKE DEFN WRHYNB WZK003 Invoice sequenc
C Z-ADDWRHYNB WZK003
C *LIKE DEFN WRAAD2 WZK004 Special charge
C Z-ADDWRAAD2 WZK004
C *LIKE DEFN WRAAG2 WZK005 Tax sequence
C Z-ADDWRAAG2 WZK005
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFK OREQ '1'
C KRSK READEFGFCPWL 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFK 1
* Quit if no record read
C W0EOFK IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* See if for a specific special charge, or a surcharge.
* CASE: PAR.Special charge sequence # is Not Zero
C ZRAAD2 IFNE *ZERO *IF
* Make sure this is for this special charge.
* CASE: PAR.Special charge sequence # NE DB1.Special charge sequenc
C ZRAAD2 IFNE WRAAD2 *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
C ELSE
* CASE: *OTHERWISE
* CASE: WRK.&No of Tax groups is GT 0
C WUAC0D IFGT *ZERO *IF
* Tax groups remaining to print
* RTV:Next Tax Grp - surch - Historical Tax *
C EXSR OCRVGN
C SUB 1 WUAC0D &No of Tax grou
C ELSE
* CASE: *OTHERWISE
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END *FI
* Do not print tax if amount is zero.
* CASE: DB1.Tax amount is Zero
C WRGYVA IFEQ *ZERO *IF
C MOVEL'N' W0RSL *Record selecte
C END *FI
* Do not print tax if: Tax in price, EC memo tax, or not invoiced.
* CASE:
* - c1 OR c2 OR c3 OR c4 OR c5
* |- c1 : DB1.Tax in price - Europe is Yes
* |- c2 : DB1.Tax in price - Brazil is Yes
* |- c3 : DB1.EC memo tax flag is Yes
* |- c4 : DB1.Tax is invoiced flag is No
* |- c5 : DB1.Use tax flag is Yes
* '-
C WRZ9T3 IFEQ '1' *IF
C WRZ9T4 OREQ '1' *OR
C WRZ9T0 OREQ '1' *OR
C WRZ9VK OREQ '0' *OR
C WRZ9T9 OREQ '1' *OR
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0KL00 1 Company number
C MOVEL*BLANK W0KL01 1 Invoice number
C MOVEL*BLANK W0KL02 1 Invoice sequenc
C MOVEL*BLANK W0KL03 1 Special charge
C MOVEL*BLANK W0KL04 1 Tax sequence
C W0EOFK IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0KL00 1 Company number
C MOVEL'Y' W0KL01 1 Invoice number
C MOVEL'Y' W0KL02 1 Invoice sequenc
C MOVEL'Y' W0KL03 1 Special charge
C MOVEL'Y' W0KL04 1 Tax sequence
C ELSE
* Next record - Detect level breaks
C WRAENB IFNE WZK001 Company number
* Set on level break indicator
C MOVEL'Y' W0KL00
C END
C WRGGNB IFNE WZK002 Invoice number
C W0KL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0KL01
C END
C WRHYNB IFNE WZK003 Invoice sequenc
C W0KL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0KL02
C END
C WRAAD2 IFNE WZK004 Special charge
C W0KL02 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0KL03
C END
C WRAAG2 IFNE WZK005 Tax sequence
C W0KL03 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0KL04
C END
C END
*================================================================
CSR K3EXIT ENDSR
/EJECT
CSR K4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0KL04 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0KP04
C END
C W0KL03 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0KP03
C END
C W0KL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0KP02
C END
C W0KL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0KP01
C END
C W0KL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0KP00
C END
C W0EOFK IFEQ '1'
* If there is not enough space on the
* physical page for this format:
C @$PGL SUB @$CLN @$WRK
C @$WRK IFLE 1
* Signal new page required
C MOVE 'Y' W0NEWP
* Start new page
C EXSR Q0PRNT
C END
* Print format
C WRITEZVFINTTL
C END
*================================================================
CSR K4EXIT ENDSR
/EJECT
CSR L0MAIN BEGSR
*================================================================
* PRO:Invoice Tax Summary: Mainline
*================================================================
* PRO:Invoice Tax Summary: Initialise
C EXSR ZLINIT
* Declare restrictor key work fields
C *LIKE DEFN WVAENB WQKL01 Company number
C *LIKE DEFN WVGGNB WQKL02 Invoice number
C *LIKE DEFN WVHYNB WQKL03 Invoice sequenc
* Define keylist
C KRSL KLIST
C KFLD WQKL01 Company number
C KFLD WQKL02 Invoice number
C KFLD WQKL03 Invoice sequenc
* Setup key
C Z-ADDC6AENB WQKL01 Company number
C Z-ADD*ZERO WQKL02 Invoice number
C Z-ADDP3HYNB WQKL03 Invoice sequenc
* Establish starting position
C KRSL SETLLFGFCPPL *
* Read first record with user selection
C EXSR L3READ
C W0EOFL IFNE '0' IF
C ELSE
* Request all headings
C MOVEL'Y' W0LL1P 1 First page
C MOVEL'Y' W0LL00 1 Company number
C MOVEL'Y' W0LL01 1 Invoice number
C MOVEL'Y' W0LL02 1 Invoice sequenc
* Set column headings flag
C MOVE 'Y' W0LCDT
* Print report body
C W0EOFL DOWEQ'0' DOW
* Prepare heading formats for printing
C EXSR L1PHDR
* Print report detail line
C EXSR L2PDTL
* Read next record with user selection
C EXSR L3READ
* Print totals
C EXSR L4PTOT
C END WOD
C END FI
*================================================================
CSR L0EXIT ENDSR
/EJECT
CSR L1PHDR BEGSR
*================================================================
* Prepare heading formats for printing
*================================================================
C W0LL1P IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0LP1P 1
C END
C W0LL00 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0LP00 1
C END
C W0LL01 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0LP01 1
C END
C W0LL02 IFEQ 'Y'
* Signal that format is now ready to print
C MOVE 'Y' W0LP02 1
C END
*================================================================
CSR L1EXIT ENDSR
/EJECT
CSR L2PDTL BEGSR
*================================================================
* Process detail record
*================================================================
* Load details format
C Z-ADDWVAENB ZXAENB Company number
C Z-ADDWVGGNB ZXGGNB Invoice number
C Z-ADDWVHYNB ZXHYNB Invoice sequenc
C MOVELWVACHG ZXACHG Tax group code
C Z-ADDWVAAG2 ZXAAG2 Tax sequence
C MOVELWVG0ST ZXG0ST Tax base code
C Z-ADDWVZ0D6 ZXZ0D6 Compound tax up
C MOVELWVACHJ ZXACHJ Inv lang tax in
C MOVELWVZ9T1 ZXZ9T1 Tax code (atr)
C MOVELWVZ9VA ZXZ9VA Tax code result
C MOVELWVZ9T2 ZXZ9T2 Tax adj for cas
C MOVELWVZ9T3 ZXZ9T3 Tax in price -
C MOVELWVZ9T4 ZXZ9T4 Tax in price -
C MOVELWVZ9T5 ZXZ9T5 Compound tax co
C MOVELWVZ9VB ZXZ9VB Compound tax co
C MOVELWVZ9T6 ZXZ9T6 Tax base amt su
C MOVELWVZ9T7 ZXZ9T7 Tax rate substi
C Z-ADDWVZ9VC ZXZ9VC Tax rate
C MOVELWVZ9VD ZXZ9VD Tax rate method
C Z-ADDWVZ9VF ZXZ9VF Tax recovery pe
C MOVELWVZ9T8 ZXZ9T8 Inc tax in cash
C MOVELWVZ9T9 ZXZ9T9 Use tax flag
C MOVELWVZ9T0 ZXZ9T0 EC memo tax fla
C MOVELWVZ9VH ZXZ9VH Tax rate derive
C MOVELWVZ9VJ ZXZ9VJ Information onl
C MOVELWVZ9VK ZXZ9VK Tax is invoiced
C MOVELWVZ9VL ZXZ9VL Tax liab/rec na
C MOVELWVZ9VR ZXZ9VR Discount inc/ex
C MOVELWVZ9VS ZXZ9VS Write-off inc/e
C MOVELWVZ9VT ZXZ9VT Adjustment inc/
C MOVELWVZ9VV ZXZ9VV Use/memo liab/r
C MOVELWVZ9VW ZXZ9VW Use/memo offset
C MOVELWVZ9VX ZXZ9VX Non-recoverable
C Z-ADDWVZ9VM ZXZ9VM Tax exclusive p
C Z-ADDWVZ9VN ZXZ9VN Tax inclusive p
C Z-ADDWVZ9VP ZXZ9VP Original tax ba
C Z-ADDWVZ9VQ ZXZ9VQ Recoverable tax
C Z-ADDWVZ9VY ZXZ9VY Recoverable tax
C Z-ADDWVZ9VZ ZXZ9VZ Effective tax r
C MOVELWVZ9V1 ZXZ9V1 Currency id (at
C MOVELWVCHGU ZXCHGU Charge unit
C MOVELWVCHGN ZXCHGN Charge nature
C MOVELWVOFFU ZXOFFU Offset unit
C MOVELWVOFFN ZXOFFN Offset nature
C MOVELWVAJCD ZXAJCD Tax indicator
C MOVELWVZ9H5 ZXZ9H5 Tax transaction
C MOVELWVZ9WV ZXZ9WV Invoice-to/from
C MOVELWVB9CD ZXB9CD Ship to number
C MOVELWVZ9WW ZXZ9WW Ship-to/buy-fro
C MOVELWVAITX ZXAITX Item number
C MOVELWVZ9N0 ZXZ9N0 Item tax class
C MOVELWVGTCD ZXGTCD Special charge
C MOVELWVA3CD ZXA3CD Warehouse
C Z-ADDWVZ9WX ZXZ9WX Order quantity
C MOVELWVANCD ZXANCD Unit of measure
C Z-ADDWVZ9WY ZXZ9WY Transaction cas
C Z-ADDWVZ9WZ ZXZ9WZ Transaction cas
C Z-ADDWVGYVA ZXGYVA Tax amount
C MOVELWVAAG3 ZXAAG3 Line item type
C MOVELWVACHH ZXACHH Tax invoice tex
C MOVELWVDCCD ZXDCCD Internal header
C MOVELWVCVNB ZXCVNB Quote/order num
C Z-ADDWVK4NB ZXK4NB Shipment header
C Z-ADDWVLCNB ZXLCNB Ship release se
C Z-ADDWVAASZ ZXAASZ Kit release seq
C Z-ADDWVAFAD ZXAFAD Shipment consol
C Z-ADDWVAAD2 ZXAAD2 Special charge
C Z-ADDWVZ9WH ZXZ9WH Original charge
C MOVELWVZ9ZY ZXZ9ZY Tax in price ca
C Z-ADDWVAHPC ZXAHPC Trade discount
C Z-ADDWVZ9ZZ ZXZ9ZZ Transaction amo
* Signal that format is now ready to print
C MOVE 'Y' W0LPDT 1
* Call print routine
C EXSR Q0PRNT
*================================================================
CSR L2EXIT ENDSR
/EJECT
CSR L3READ BEGSR
*================================================================
* Read next record
*================================================================
* Hold current values
C *LIKE DEFN WVAENB WZL001 Company number
C Z-ADDWVAENB WZL001
C *LIKE DEFN WVGGNB WZL002 Invoice number
C Z-ADDWVGGNB WZL002
C *LIKE DEFN WVHYNB WZL003 Invoice sequenc
C Z-ADDWVHYNB WZL003
* Read next record
C W0RSL DOUEQ'Y' DOU
C W0EOFL OREQ '1'
C KRSL READEFGFCPPL 90*
* Transfer error indicator to EOF flag
C MOVEL*IN90 W0EOFL 1
* Quit if no record read
C W0EOFL IFNE '1' IF
* Select record unless user action states otherwise
C MOVEL'Y' W0RSL 1
* USER: Record selection processing
* CASE: WRK.&No of Tax groups is GT 0
C WUAC0D IFGT *ZERO *IF
* Tax groups remaining to print
* RTV:Next Tax Group - Historical Tax *
C EXSR OSRVGN
C SUB 1 WUAC0D &No of Tax grou
C ELSE
* CASE: *OTHERWISE
C MOVEL'N' W0RSL *Record selecte
C END *FI
C END FI
C END UOD
* Reset key level breaks
C MOVEL*BLANK W0LL00 1 Company number
C MOVEL*BLANK W0LL01 1 Invoice number
C MOVEL*BLANK W0LL02 1 Invoice sequenc
C W0EOFL IFEQ '1'
* End of file - Signal all level breaks
C MOVEL'Y' W0LL00 1 Company number
C MOVEL'Y' W0LL01 1 Invoice number
C MOVEL'Y' W0LL02 1 Invoice sequenc
C ELSE
* Next record - Detect level breaks
C WVAENB IFNE WZL001 Company number
* Set on level break indicator
C MOVEL'Y' W0LL00
C END
C WVGGNB IFNE WZL002 Invoice number
C W0LL00 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0LL01
C END
C WVHYNB IFNE WZL003 Invoice sequenc
C W0LL01 OREQ 'Y'
* Set on level break indicator
C MOVEL'Y' W0LL02
C END
C END
*================================================================
CSR L3EXIT ENDSR
/EJECT
CSR L4PTOT BEGSR
*================================================================
* Print report Totals
*================================================================
* Print level break totals as required
C W0LL02 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0LP02
C END
C W0LL01 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0LP01
C END
C W0LL00 IFEQ 'Y'
* Signal header format is no longer ready
C MOVEL*BLANK W0LP00
C END
C W0EOFL IFEQ '1'
C END
*================================================================
CSR L4EXIT ENDSR
/EJECT
CSR NARVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSNA KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0059 EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSNA CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO NAEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR NAEXIT ENDSR
/EJECT
CSR NBDLRC BEGSR
*================================================================
* Clear Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Initialize array variables
C MOVEA*HIVAL YK01
* Initialize last used element number
C Z-ADD0 YL01
*================================================================
CSR NBEXIT ENDSR
/EJECT
CSR NCCRRC BEGSR
*================================================================
* Load Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL01 IFEQ 5
C MOVEL'Y2U0036' W0RTN 7
* USER: Processing if Data update error
* ** This error indicates the array is full.
* ** The calling function will handle the error.
* ** The array size of 5 was chosen to limit the program's size
* but still handle quite a few currencies before running
* this exception handling.
C MOVEL'Y2U0004' W0RTN *Return code
C GOTO NCEXIT
C ENDIF
C MOVEL*BLANK XAACVX Loaded from fil
C Z-ADD*ZERO XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* Move all fields to Currency File Data
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* USER: Processing before Data update
* RTV:All information - CURRENCY *
C EXSR NDRVGN
* Set default data for record not found.
* CASE:
* - NOT c1
* |- c1 : PGM.*Return code is *Normal
* '-
C MOVEL'0' Y0CX01 1
C W0RTN IFEQ *BLANK *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL*BLANK W0RTN *Return code
* ** Keep the key data from PAR; blank the rest of the record.
* DB1 = PAR,CON By name
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* ** Default to 2 decimal positions.
C Z-ADD2 XAAKNB Decimal positio
C END *FI
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI01
* Only search if key is not beyond range of current elements
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Set search index to first element of array
C Z-ADD1 Y 50
C YD01 LOKUPYK01,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK01,Y YD01
* Compare
C YI0101 IFEQ XAACVX
C YI0102 ANDEQXAAENB
C YI0103 ANDEQXABRCD
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO NCEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL01 ADD 1 Y 50
* Check if element was a previously deleted element
C YK01,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK01,Y YD01
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI01
C ENDIF
* Create(insert) new element
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
C MOVELYD01 YK01,Y
C YI01 OCUR YM01
* Update MODS fields
C MOVELXAACVX WFACVX Loaded from fil
C Z-ADDXAAENB WFAENB Company number
C MOVELXABRCD WFBRCD Currency ID
C MOVELXAA3TX WFA3TX Currency descri
C Z-ADDXAAJNB WFAJNB Exchange rate c
C Z-ADDXAAKNB WFAKNB Decimal positio
C MOVELXAALNB WFALNB AP exchange gai
C MOVELXAAMNB WFAMNB AR exchange gai
C Z-ADDXAABVA WFABVA Price adjustmen
C MOVELXAAALP WFAALP Primary Currenc
* Only sort if element is out of position
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Adjust RTVOBJ index to reflect position of added/removed element
C YR01 IFGT 0
C YR01 ANDLE5
C YK01,YR01 ANDGTYD01
C ADD 1 YR01 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK01
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL01
* Move Currency F fields back
C MOVELWFA3TX WUA3TX Currency descri
C Z-ADDWFAJNB WUAJNB Exchange rate c
C Z-ADDWFAKNB WN0055 Decimal positio
C MOVELWFALNB WUALNB AP exchange gai
C MOVELWFAMNB WUAMNB AR exchange gai
C Z-ADDWFABVA WUABVA Price adjustmen
C MOVELWFAALP WUAALP Primary Currenc
* USER: Processing after Data update
* Load output?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* PAR = DB1 By name
C MOVELXAA3TX WUA3TX Currency descri
C Z-ADDXAAJNB WUAJNB Exchange rate c
C Z-ADDXAAKNB WN0055 Decimal positio
C MOVELXAALNB WUALNB AP exchange gai
C MOVELXAAMNB WUAMNB AR exchange gai
C Z-ADDXAABVA WUABVA Price adjustmen
C MOVELXAAALP WUAALP Primary Currenc
C END *FI
*================================================================
CSR NCEXIT ENDSR
/EJECT
CSR NDRVGN BEGSR
*================================================================
* RTV:All information - CURRENCY *
*================================================================
C Z-ADD*ZERO WN0062 20 Company number
C MOVEL*BLANK WN0063 10 Admin division
C MOVEL*BLANK WN0064 3 Currency ID (us
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Check if IFM is installed.
* CASE: *OTHERWISE
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0269 4 Application ali
C WUADVB PARM *BLANK WQ0270 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Adjust company/currency if IFM is installed.
* CASE: WRK.Installed apps - IFM is Installed
C WUADVB IFEQ '1' *IF
* Looking for local currency?
* CASE:
* - c1 AND c2
* |- c1 : PAR.Company number is Zero
* |- c2 : PAR.Currency ID is Blank
* '-
C MOVEL'0' Y0CX01 1
C XAAENB IFEQ *ZERO *IF
C XABRCD IFEQ *BLANK *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* Get MAPICS dflt admin div - IFM Programs *
C CALL 'UAEMXFR' 90 Get MAPICS dflt
C PARM W0RTN WQ0271 7 *Return code
C PARM ZZUSR WQ0272 10 User id (usr)
C WN0063 PARM *BLANK WQ0273 10 Admin division
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UAEMXFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* EXT:COM Get Lcl Currency - IFM Programs *
C CALL 'UA39XFR' 90 EXT:COM Get Lcl
C PARM W0RTN WQ0274 7 *Return code
C PARM WN0063 WQ0275 10 Admin division
C WN0064 PARM *BLANK WQ0276 4 Currency id IFM
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UA39XFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C Z-ADD01 WN0062 Company number
* RTV:All information IFM - CURRENCY *
C EXSR NERVGN
C GOTO NDEXIT *QUIT
C END *FI
* Adjust Company_number?
* CASE: PAR.Company number is Not equal 01
C XAAENB IFNE 01 *IF
C Z-ADD01 WN0062 Company number
* RTV:All information IFM - CURRENCY *
C EXSR NFRVGN
C GOTO NDEXIT *QUIT
C END *FI
C END *FI
* Define keylist
C KRSND KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDXAAENB EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSND CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C Z-ADD*ZERO WN0062 Company number
C MOVEL*BLANK WN0063 Admin division
C MOVEL*BLANK WN0064 Currency ID (us
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO NDEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR NDEXIT ENDSR
/EJECT
CSR NERVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSNE KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0062 EPAENB Company number
C MOVELWN0064 EPBRCD Currency ID
* Establish starting position
C KRSNE CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO NEEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR NEEXIT ENDSR
/EJECT
CSR NFRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSNF KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0062 EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSNF CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO NFEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR NFEXIT ENDSR
/EJECT
CSR NGRVGN BEGSR
*================================================================
* RTV:Desc,Unit of Measure - ITEM MASTER *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSNG KLIST
C KFLD FIAITX Item number
* Setup key
C MOVELZJGYTX FIAITX Item number
* Establish starting position
C KRSNG CHAINFEMASAG 90 *
* Data record not found
C 90 MOVEL'AMB0244' W0RTN 7
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELFIALTX ZJAAR1 Item descriptio
C MOVELFICQCD ZJAC1T Dimension U/M
C ENDIF
*================================================================
CSR NGEXIT ENDSR
/EJECT
CSR NHRVGN BEGSR
*================================================================
* RTV: Item foreign desc - ITEM FOREIGN LANGUAGE *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSNH KLIST
C KFLD FGAITX Item number
C KFLD FGAKCD Language code
* Setup key
C MOVELZJGYTX FGAITX Item number
C MOVELCDAKCD FGAKCD Language code
* Establish starting position
C KRSNH CHAINFMLANAO 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0240' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUALCD Item descriptio
C MOVEL*BLANK WUAJTX Item descriptio
C MOVEL*BLANK ZJACLQ Item descriptio
C GOTO NHEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELFGALCD WUALCD Item descriptio
C MOVELFGAJTX WUAJTX Item descriptio
C MOVELFGAKTX ZJACLQ Item descriptio
C ENDIF
*================================================================
CSR NHEXIT ENDSR
/EJECT
CSR NIRVGN BEGSR
*================================================================
* RTV: Item foreign desc - ITEM FOREIGN LANGUAGE *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSNI KLIST
C KFLD FGAITX Item number
C KFLD FGAKCD Language code
* Setup key
C MOVELZJGYTX FGAITX Item number
C MOVEL'000' FGAKCD Language code
* Establish starting position
C KRSNI CHAINFMLANAO 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0240' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUALCD Item descriptio
C MOVEL*BLANK WUAJTX Item descriptio
C MOVEL*BLANK ZJACLQ Item descriptio
C GOTO NIEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELFGALCD WUALCD Item descriptio
C MOVELFGAJTX WUAJTX Item descriptio
C MOVELFGAKTX ZJACLQ Item descriptio
C ENDIF
*================================================================
CSR NIEXIT ENDSR
/EJECT
CSR NJRVGN BEGSR
*================================================================
* RTV:Component Exist? - Release *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C MOVEL'0' WUACM1 Record found?
* Declare restrictor key work fields
C *LIKE DEFN ADAENB WQNJ01 Company number
C *LIKE DEFN ADDCCD WQNJ02 Internal header
C *LIKE DEFN ADCVNB WQNJ03 Quote/order num
C *LIKE DEFN ADFCNB WQNJ04 Line item seque
* Define keylist
C KRSNJ KLIST
C KFLD WQNJ01 Company number
C KFLD WQNJ02 Internal header
C KFLD WQNJ03 Quote/order num
C KFLD WQNJ04 Line item seque
* Setup key
C Z-ADDZFAENB WQNJ01 Company number
C MOVELZFDCCD WQNJ02 Internal header
C MOVELZFCVNB WQNJ03 Quote/order num
C Z-ADDZFFCNB WQNJ04 Line item seque
* Establish starting position
C KRSNJ SETLLMBADRE1 *
C KRSNJ READEMBADRE1 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0316' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'0' WUACM1 Record found?
C GOTO NJEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: PAR.Component item EQ DB1.Item number
C CAGYTX IFEQ ADAITX *IF
C MOVEL'1' WUACM1 Record found?
C GOTO NJEXIT *QUIT
C END *FI
C KRSNJ READEMBADRE1 90*
C ENDDO
*================================================================
CSR NJEXIT ENDSR
/EJECT
CSR NKRVGN BEGSR
*================================================================
* RTV:No. of Releases - Release *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WGAENB WQNK01 Company number
C *LIKE DEFN WGDCCD WQNK02 Internal header
C *LIKE DEFN WGCVNB WQNK03 Quote/order num
C *LIKE DEFN WGFCNB WQNK04 Line item seque
* Define keylist
C KRSNK KLIST
C KFLD WQNK01 Company number
C KFLD WQNK02 Internal header
C KFLD WQNK03 Quote/order num
C KFLD WQNK04 Line item seque
* Setup key
C Z-ADDZFAENB WQNK01 Company number
C MOVELZFDCCD WQNK02 Internal header
C MOVELZFCVNB WQNK03 Quote/order num
C Z-ADDZFFCNB WQNK04 Line item seque
* Establish starting position
C KRSNK SETLLFADRECD *
C KRSNK READEFADRECD 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0316' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C Z-ADD*ZERO WUDRNB Release number
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO NKEXIT *QUIT
C GOTO NKEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* PAR = DB1 By name
C Z-ADDWGDRNB WUDRNB Release number
C MOVEL'Y2U0003' W0RTN *Return code
C GOTO NKEXIT *QUIT
C KRSNK READEFADRECD 90*
C ENDDO
*================================================================
CSR NKEXIT ENDSR
/EJECT
CSR NLRVGN BEGSR
*================================================================
* RTV:line itm cmnt ex inv. - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WIAENB WQNL01 Company number
C *LIKE DEFN WIDCCD WQNL02 Internal header
C *LIKE DEFN WICVNB WQNL03 Quote/order num
C *LIKE DEFN WIK4NB WQNL04 Shipment header
C *LIKE DEFN WILCNB WQNL05 Ship release se
C *LIKE DEFN WIAASZ WQNL06 Kit release seq
* Define keylist
C KRSNL KLIST
C KFLD WQNL01 Company number
C KFLD WQNL02 Internal header
C KFLD WQNL03 Quote/order num
C KFLD WQNL04 Shipment header
C KFLD WQNL05 Ship release se
C KFLD WQNL06 Kit release seq
* Setup key
C Z-ADDZFAENB WQNL01 Company number
C MOVELZFDCCD WQNL02 Internal header
C MOVELZFCVNB WQNL03 Quote/order num
C Z-ADD1 WQNL04 Shipment header
C Z-ADDZFFCNB WQNL05 Ship release se
C Z-ADD*ZERO WQNL06 Kit release seq
* Establish starting position
C KRSNL SETLLFGACPWJ *
C KRSNL READEFGACPWJ 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0798' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO NLEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
C MOVEL'Y2U0003' W0RTN *Return code
C GOTO NLEXIT *QUIT
C KRSNL READEFGACPWJ 90*
C ENDDO
*================================================================
CSR NLEXIT ENDSR
/EJECT
CSR NMRVGN BEGSR
*================================================================
* RTV:Build lines up detail - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD1 WUAAJH Counter
C MOVELZNAKCD WUHVCD Language code U
C Z-ADD*ZERO WUAFD6 Comment line se
* Declare restrictor key work fields
C *LIKE DEFN WCAENB WQNM01 Company number
C *LIKE DEFN WCGGNB WQNM02 Invoice number
C *LIKE DEFN WCHYNB WQNM03 Invoice sequenc
* Define keylist
C KPSNM KLIST
C KFLD WQNM01 Company number
C KFLD WQNM02 Invoice number
C KFLD WQNM03 Invoice sequenc
C KFLD WCKBNB Comment line se
* Define keylist
C KRSNM KLIST
C KFLD WQNM01 Company number
C KFLD WQNM02 Invoice number
C KFLD WQNM03 Invoice sequenc
* Setup key
C Z-ADDZNAENB WQNM01 Company number
C Z-ADDZNGGNB WQNM02 Invoice number
C Z-ADDZNHYNB WQNM03 Invoice sequenc
C Z-ADDWUKBNB WCKBNB Comment line se
* Establish starting position
C KPSNM SETLLFGACPYO *
C KRSNM READEFGACPYO 90*
* Data record not found
C 90 MOVEL'AMB0798' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
C MOVEL'1' WUAA04 Continue?
* Are we supposed to print this comment & is it a line item.
* CASE: DB1.Internal print only? is Yes
C WCAAD9 IFEQ '1' *IF
C MOVEL'0' WUAA04 Continue?
C ELSE
* CASE: DB1.Special charge sequence # is Not Zero
C WCAAD2 IFNE *ZERO *IF
C MOVEL'0' WUAA04 Continue?
C END *FI
C END *FI
* See if this comment is for the line item we want.
* CASE: Make sure this is the comment we want
* - c1 OR c2 OR c3
* |- c1 : PAR.Shipment header number NE DB1.Shipment header nu
* |- c2 : PAR.Ship release sequence NE DB1.Ship release sequen
* |- c3 : PAR.Kit release sequence NE DB1.Kit release sequence
* '-
C ZNK4NB IFNE WCK4NB *IF
C ZNLCNB ORNE WCLCNB *OR
C ZNAASZ ORNE WCAASZ *OR
C GOTO NMEXIT *QUIT
C END *FI
* set up 2up or 3up
* CASE: WRK.Continue? is Yes
C WUAA04 IFEQ '1' *IF
* CASE: If Print Control,Reference,and Language equal PAR
* - c1 AND c2 AND c3
* |- c1 : DB1.Text line print control EQ PAR.Text line print c
* |- c2 : DB1.Comment user reference EQ PAR.Comment user refer
* |- c3 : DB1.Language code EQ PAR.Language code
* '-
C MOVEL'0' Y0CX01 1
C WCAD1N IFEQ ZNAD1N *IF
C WCHXCD IFEQ ZNHXCD *IF
C WCAKCD IFEQ ZNAKCD *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* 2 lines up process:
* CASE: DB1.Text line print control is 2 lines up
C WCAD1N IFEQ '2' *IF
C Z-ADDWCKBNB WUAFD6 Comment line se
C MOVELWCAKCD WUHVCD Language code U
C Z-ADD1 ZQ 50
C ZNAFD5 CAT WCHDTX:ZQ ZNAFD5 P Text Line Descr
C GOTO NMEXIT *QUIT
C END *FI
* 3 lines up process:
* CASE: DB1.Text line print control is 3 lines up
C WCAD1N IFEQ '3' *IF
C ADD 1 WUAAJH Counter
* CASE: WRK.Counter is EQ 2
C WUAAJH IFEQ 2 *IF
C Z-ADDWCKBNB WUAFD6 Comment line se
C MOVELWCAKCD WUHVCD Language code U
C Z-ADD1 ZQ 50
C ZNAFD5 CAT WCHDTX:ZQ ZNAFD5 P Text Line Descr
C ELSE
* CASE: WRK.Counter is EQ 3
C WUAAJH IFEQ 3 *IF
* ** Test if room allows for 3 across comments
C Z-ADD1 ZQ 50
C ZNAFD5 CAT WCHDTX:ZQ WUAFD7 P Text line 77 US
C Z-ADD2 YRSW00
C Z-ADD76 ZQ 50
C YRSW00 IFLT 1
C ZQ ORLT 1
C YRSW00 ORGT 00077
C ZQ ORGT 00077
C MOVEL'Y2U0510' W0RTN
C ELSE
C YRSW00 SUBSTWUAFD7:ZQ WUACC3 P 90 &Alpha 2 USR
C 90 MOVEL'Y2U0510' W0RTN
C END
* If characters are in the last 2 postions quite, other concat
* CASE: WRK.&Alpha 2 USR is Not blank
C WUACC3 IFGT *BLANK *IF
C GOTO NMEXIT *QUIT
C ELSE
* CASE: *OTHERWISE
C Z-ADDWCKBNB WUAFD6 Comment line se
C MOVELWCAKCD WUHVCD Language code U
C Z-ADD1 ZQ 50
C ZNAFD5 CAT WCHDTX:ZQ ZNAFD5 P Text Line Descr
C GOTO NMEXIT *QUIT
C END *FI
C END *FI
C END *FI
C END *FI
C ELSE
* CASE: *OTHERWISE
C GOTO NMEXIT *QUIT
C END *FI
C END *FI
C KRSNM READEFGACPYO 90*
C ENDDO
*================================================================
CSR NMEXIT ENDSR
/EJECT
CSR NNRVGN BEGSR
*================================================================
* RTV:Reposition pointer - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSNN KLIST
C KFLD WCAENB Company number
C KFLD WCGGNB Invoice number
C KFLD WCHYNB Invoice sequenc
C KFLD WCKBNB Comment line se
C KFLD WCAKCD Language code
* Setup key
C Z-ADDWCAENB WCAENB Company number
C Z-ADDWCGGNB WCGGNB Invoice number
C Z-ADDWCHYNB WCHYNB Invoice sequenc
C Z-ADDWUAFD6 WCKBNB Comment line se
C MOVELWUHVCD WCAKCD Language code
* Establish starting position
C KRSNN CHAINFGACPYO 90 *
* Data record not found
C 90 MOVEL'AMB0798' W0RTN 7
C *IN90 IFEQ '0'
* USER: Process Data record
C GOTO NNEXIT *QUIT
C ENDIF
*================================================================
CSR NNEXIT ENDSR
/EJECT
CSR NORVGN BEGSR
*================================================================
* RTV:SYSCTL XMREPT Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL02 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK02,Y YD02
C YI02 OCUR YM02
* Initialize internal index
C MOVEL*LOVAL YD02
* Move key fields to SYSCTL XMREPT format
C MOVEL'1' YI0201 Loaded from fil
* Only search if key is not beyond range of current elements
C YK02,YL02 IFGT YD02
C YD02 LOKUPYK02,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK02,Y YD02
* Compare
C YI0201 IFNE '1'
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO NOEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI02 OCUR YM02
* USER: Process Data record
* PAR = DB1 By name
C MOVELWJZ80O WUZ80O SYSCTL key erro
C MOVELWJADHJ WUADHJ ACS Apply compl
C MOVELWJADHK WUADHK Initial install
C MOVELWJADHL WUADHL Installation co
C MOVELWJADHM WUADHM AP - IM interfa
C MOVELWJADHN WUADHN AR - AP interfa
C MOVELWJADHP WUADHP PUR - MRP inter
C MOVELWJADHQ WUADHQ PUR - IM interf
C MOVELWJADHR WUADHR MPSP - MRP inte
C MOVELWJADHS WUADHS COM - MPSP inte
C MOVELWJADHT WUADHT MRP - REP inter
C MOVELWJADHV WUADHV COM - REP inter
C MOVELWJADHW WUADHW PMC - REP inter
C MOVELWJADHY WUADHY MPA - COM inter
C MOVELWJADHZ WUADHZ MPA - PCC inter
C MOVELWJADH1 WUADH1 MPA - MRP inter
C MOVELWJADH2 WUADH2 PUR - GL interf
C MOVELWJADH3 WUADH3 PUR - PCC inter
C MOVELWJABW2 WUABW2 Work (alpha 1)
C MOVELWJADH4 WUADH4 Master file sav
C MOVELWJADH5 WUADH5 Current unresta
C MOVELWJADH6 WUADH6 Reuse data entr
C MOVELWJZ9AD WUZ9AD Multi-company i
C MOVELWJADH7 WUADH7 Fiscal period i
C MOVELWJADH8 WUADH8 Date format for
C MOVELWJADH9 WUADH9 Date validation
C MOVELWJADH0 WUADH0 COM - GL interf
C MOVELWJADJA WUADJA I/T checkpoint
C MOVELWJADJB WUADJB PR - GL interfa
C MOVELWJADJC WUADJC AP - GL interfa
C MOVELWJADJD WUADJD AR - GL interfa
C MOVELWJADJF WUADJF AP - PCC interf
C MOVELWJADJG WUADJG PR - PCC interf
C MOVELWJADJH WUADJH PMC - PR interf
C MOVELWJADJJ WUADJJ IM - PCC interf
C MOVELWJADJK WUADJK PMC - IM interf
C MOVELWJADJL WUADJL IM - SA interfa
C MOVELWJADJM WUADJM IM - COM interf
C MOVELWJADJN WUADJN IM - MRP interf
C MOVELWJADJP WUADJP IM - PDM interf
C MOVELWJADJQ WUADJQ PDM - PCC inter
C MOVELWJADJR WUADJR PDM - MRP inter
C MOVELWJADJS WUADJS PDM - COM inter
C MOVELWJADJT WUADJT COM - MRP inter
C MOVELWJADJV WUADJV COM - SA interf
C MOVELWJADJW WUADJW COM - AR interf
C MOVELWJADJY WUADJY AR - SA interfa
C MOVELWJADJZ WUADJZ PMC - PCC inter
C MOVELWJADJ1 WUADJ1 PCC - IM interf
C MOVELWJADJ2 WUADJ2 IM - GL interfa
C MOVELWJADJ3 WUADJ3 COM - IM interf
C MOVELWJADJ4 WUADJ4 MRP - IM interf
C MOVELWJADJ5 WUADJ5 PDM - IM interf
C MOVELWJADJ6 WUADJ6 MRP - PDM inter
C MOVELWJADJ7 WUADJ7 PCC - GL interf
C MOVELWJADJ8 WUADJ8 EDMI - PDM inte
C MOVELWJADJ9 WUADJ9 FCST - MRP inte
C MOVELWJADJ0 WUADJ0 FA - GL interfa
C MOVELWJADKA WUADKA Questionnaire h
C MOVELWJADKB WUADKB Yes response ch
C MOVELWJADKC WUADKC No response cha
C MOVELWJACV5 WUACV5 Work alpha (1)
C MOVELWJADKD WUADKD Mth periods def
C MOVELWJADKF WUADKF Weeks per perio
C MOVELWJADKG WUADKG Week beginning
C MOVELWJADKH WUADKH Last file sts r
C MOVELWJADKJ WUADKJ Last file sts r
C MOVELWJADKK WUADKK REP - GL interf
C MOVELWJADKM WUADKM IFM GLI interfa
C MOVELWJADKN WUADKN IFM AP interfac
C MOVELWJADKP WUADKP IFM AR interfac
C ENDIF
*================================================================
CSR NOEXIT ENDSR
/EJECT
CSR NPCRRC BEGSR
*================================================================
* Load SYSCTL XMREPT Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL02 IFEQ 1
C MOVEL'Y2U0036' W0RTN 7
C GOTO NPEXIT
C ENDIF
C MOVEL*BLANK XBACVX Loaded from fil
C MOVEL*BLANK XBZ80O SYSCTL key erro
C MOVEL*BLANK XBADHJ ACS Apply compl
C MOVEL*BLANK XBADHK Initial install
C MOVEL*BLANK XBADHL Installation co
C MOVEL*BLANK XBADHM AP - IM interfa
C MOVEL*BLANK XBADHN AR - AP interfa
C MOVEL*BLANK XBADHP PUR - MRP inter
C MOVEL*BLANK XBADHQ PUR - IM interf
C MOVEL*BLANK XBADHR MPSP - MRP inte
C MOVEL*BLANK XBADHS COM - MPSP inte
C MOVEL*BLANK XBADHT MRP - REP inter
C MOVEL*BLANK XBADHV COM - REP inter
C MOVEL*BLANK XBADHW PMC - REP inter
C MOVEL*BLANK XBADHY MPA - COM inter
C MOVEL*BLANK XBADHZ MPA - PCC inter
C MOVEL*BLANK XBADH1 MPA - MRP inter
C MOVEL*BLANK XBADH2 PUR - GL interf
C MOVEL*BLANK XBADH3 PUR - PCC inter
C MOVEL*BLANK XBABW2 Work (alpha 1)
C MOVEL*BLANK XBADH4 Master file sav
C MOVEL*BLANK XBADH5 Current unresta
C MOVEL*BLANK XBADH6 Reuse data entr
C MOVEL*BLANK XBZ9AD Multi-company i
C MOVEL*BLANK XBADH7 Fiscal period i
C MOVEL*BLANK XBADH8 Date format for
C MOVEL*BLANK XBADH9 Date validation
C MOVEL*BLANK XBADH0 COM - GL interf
C MOVEL*BLANK XBADJA I/T checkpoint
C MOVEL*BLANK XBADJB PR - GL interfa
C MOVEL*BLANK XBADJC AP - GL interfa
C MOVEL*BLANK XBADJD AR - GL interfa
C MOVEL*BLANK XBADJF AP - PCC interf
C MOVEL*BLANK XBADJG PR - PCC interf
C MOVEL*BLANK XBADJH PMC - PR interf
C MOVEL*BLANK XBADJJ IM - PCC interf
C MOVEL*BLANK XBADJK PMC - IM interf
C MOVEL*BLANK XBADJL IM - SA interfa
C MOVEL*BLANK XBADJM IM - COM interf
C MOVEL*BLANK XBADJN IM - MRP interf
C MOVEL*BLANK XBADJP IM - PDM interf
C MOVEL*BLANK XBADJQ PDM - PCC inter
C MOVEL*BLANK XBADJR PDM - MRP inter
C MOVEL*BLANK XBADJS PDM - COM inter
C MOVEL*BLANK XBADJT COM - MRP inter
C MOVEL*BLANK XBADJV COM - SA interf
C MOVEL*BLANK XBADJW COM - AR interf
C MOVEL*BLANK XBADJY AR - SA interfa
C MOVEL*BLANK XBADJZ PMC - PCC inter
C MOVEL*BLANK XBADJ1 PCC - IM interf
C MOVEL*BLANK XBADJ2 IM - GL interfa
C MOVEL*BLANK XBADJ3 COM - IM interf
C MOVEL*BLANK XBADJ4 MRP - IM interf
C MOVEL*BLANK XBADJ5 PDM - IM interf
C MOVEL*BLANK XBADJ6 MRP - PDM inter
C MOVEL*BLANK XBADJ7 PCC - GL interf
C MOVEL*BLANK XBADJ8 EDMI - PDM inte
C MOVEL*BLANK XBADJ9 FCST - MRP inte
C MOVEL*BLANK XBADJ0 FA - GL interfa
C MOVEL*BLANK XBADKA Questionnaire h
C MOVEL*BLANK XBADKB Yes response ch
C MOVEL*BLANK XBADKC No response cha
C MOVEL*BLANK XBACV5 Work alpha (1)
C MOVEL*BLANK XBADKD Mth periods def
C MOVEL*BLANK XBADKF Weeks per perio
C MOVEL*BLANK XBADKG Week beginning
C MOVEL*BLANK XBADKH Last file sts r
C MOVEL*BLANK XBADKJ Last file sts r
C MOVEL*BLANK XBADKK REP - GL interf
C MOVEL*BLANK XBADKM IFM GLI interfa
C MOVEL*BLANK XBADKN IFM AP interfac
C MOVEL*BLANK XBADKP IFM AR interfac
* Move all fields to SYSCTL XMREPT format
C MOVEL'1' XBACVX Loaded from fil
C MOVEL*BLANK XBZ80O SYSCTL key erro
C MOVEL*BLANK XBADHJ ACS Apply compl
C MOVEL*BLANK XBADHK Initial install
C MOVEL*BLANK XBADHL Installation co
C MOVEL*BLANK XBADHM AP - IM interfa
C MOVEL*BLANK XBADHN AR - AP interfa
C MOVEL*BLANK XBADHP PUR - MRP inter
C MOVEL*BLANK XBADHQ PUR - IM interf
C MOVEL*BLANK XBADHR MPSP - MRP inte
C MOVEL*BLANK XBADHS COM - MPSP inte
C MOVEL*BLANK XBADHT MRP - REP inter
C MOVEL*BLANK XBADHV COM - REP inter
C MOVEL*BLANK XBADHW PMC - REP inter
C MOVEL*BLANK XBADHY MPA - COM inter
C MOVEL*BLANK XBADHZ MPA - PCC inter
C MOVEL*BLANK XBADH1 MPA - MRP inter
C MOVEL*BLANK XBADH2 PUR - GL interf
C MOVEL*BLANK XBADH3 PUR - PCC inter
C MOVEL*BLANK XBABW2 Work (alpha 1)
C MOVEL*BLANK XBADH4 Master file sav
C MOVEL*BLANK XBADH5 Current unresta
C MOVEL*BLANK XBADH6 Reuse data entr
C MOVEL*BLANK XBZ9AD Multi-company i
C MOVEL*BLANK XBADH7 Fiscal period i
C MOVEL*BLANK XBADH8 Date format for
C MOVEL*BLANK XBADH9 Date validation
C MOVEL*BLANK XBADH0 COM - GL interf
C MOVEL*BLANK XBADJA I/T checkpoint
C MOVEL*BLANK XBADJB PR - GL interfa
C MOVEL*BLANK XBADJC AP - GL interfa
C MOVEL*BLANK XBADJD AR - GL interfa
C MOVEL*BLANK XBADJF AP - PCC interf
C MOVEL*BLANK XBADJG PR - PCC interf
C MOVEL*BLANK XBADJH PMC - PR interf
C MOVEL*BLANK XBADJJ IM - PCC interf
C MOVEL*BLANK XBADJK PMC - IM interf
C MOVEL*BLANK XBADJL IM - SA interfa
C MOVEL*BLANK XBADJM IM - COM interf
C MOVEL*BLANK XBADJN IM - MRP interf
C MOVEL*BLANK XBADJP IM - PDM interf
C MOVEL*BLANK XBADJQ PDM - PCC inter
C MOVEL*BLANK XBADJR PDM - MRP inter
C MOVEL*BLANK XBADJS PDM - COM inter
C MOVEL*BLANK XBADJT COM - MRP inter
C MOVEL*BLANK XBADJV COM - SA interf
C MOVEL*BLANK XBADJW COM - AR interf
C MOVEL*BLANK XBADJY AR - SA interfa
C MOVEL*BLANK XBADJZ PMC - PCC inter
C MOVEL*BLANK XBADJ1 PCC - IM interf
C MOVEL*BLANK XBADJ2 IM - GL interfa
C MOVEL*BLANK XBADJ3 COM - IM interf
C MOVEL*BLANK XBADJ4 MRP - IM interf
C MOVEL*BLANK XBADJ5 PDM - IM interf
C MOVEL*BLANK XBADJ6 MRP - PDM inter
C MOVEL*BLANK XBADJ7 PCC - GL interf
C MOVEL*BLANK XBADJ8 EDMI - PDM inte
C MOVEL*BLANK XBADJ9 FCST - MRP inte
C MOVEL*BLANK XBADJ0 FA - GL interfa
C MOVEL*BLANK XBADKA Questionnaire h
C MOVEL*BLANK XBADKB Yes response ch
C MOVEL*BLANK XBADKC No response cha
C MOVEL*BLANK XBACV5 Work alpha (1)
C MOVEL*BLANK XBADKD Mth periods def
C MOVEL*BLANK XBADKF Weeks per perio
C MOVEL*BLANK XBADKG Week beginning
C MOVEL*BLANK XBADKH Last file sts r
C MOVEL*BLANK XBADKJ Last file sts r
C MOVEL*BLANK XBADKK REP - GL interf
C MOVEL*BLANK XBADKM IFM GLI interfa
C MOVEL*BLANK XBADKN IFM AP interfac
C MOVEL*BLANK XBADKP IFM AR interfac
* USER: Processing before Data update
* RTV:SYSCTL XMREPT format - SYSCTL API non-OEI rcds *
C CALL 'AMZARUPR' 90 RTV:SYSCTL XMRE
C PARM XBZ80O WQ0299 6 SYSCTL key erro
C PARM W0RTN WQ0300 7 *Return code
C XBADHJ PARM *BLANK WQ0301 1 ACS Apply compl
C XBADHK PARM *BLANK WQ0302 1 Initial install
C XBADHL PARM *BLANK WQ0303 1 Installation co
C XBADHM PARM *BLANK WQ0304 1 AP - IM interfa
C XBADHN PARM *BLANK WQ0305 1 AR - AP interfa
C XBADHP PARM *BLANK WQ0306 1 PUR - MRP inter
C XBADHQ PARM *BLANK WQ0307 1 PUR - IM interf
C XBADHR PARM *BLANK WQ0308 1 MPSP - MRP inte
C XBADHS PARM *BLANK WQ0309 1 COM - MPSP inte
C XBADHT PARM *BLANK WQ0310 1 MRP - REP inter
C XBADHV PARM *BLANK WQ0311 1 COM - REP inter
C XBADHW PARM *BLANK WQ0312 1 PMC - REP inter
C XBADHY PARM *BLANK WQ0313 1 MPA - COM inter
C XBADHZ PARM *BLANK WQ0314 1 MPA - PCC inter
C XBADH1 PARM *BLANK WQ0315 1 MPA - MRP inter
C XBADH2 PARM *BLANK WQ0316 1 PUR - GL interf
C XBADH3 PARM *BLANK WQ0317 1 PUR - PCC inter
C XBABW2 PARM *BLANK WQ0318 1 Work (alpha 1)
C XBADH4 PARM *BLANK WQ0319 1 Master file sav
C XBADH5 PARM *BLANK WQ0320 3 Current unresta
C XBADH6 PARM *BLANK WQ0321 1 Reuse data entr
C XBZ9AD PARM *BLANK WQ0322 1 Multi-company i
C XBADH7 PARM *BLANK WQ0323 1 Fiscal period i
C XBADH8 PARM *BLANK WQ0324 1 Date format for
C XBADH9 PARM *BLANK WQ0325 1 Date validation
C XBADH0 PARM *BLANK WQ0326 1 COM - GL interf
C XBADJA PARM *BLANK WQ0327 3 I/T checkpoint
C XBADJB PARM *BLANK WQ0328 1 PR - GL interfa
C XBADJC PARM *BLANK WQ0329 1 AP - GL interfa
C XBADJD PARM *BLANK WQ0330 1 AR - GL interfa
C XBADJF PARM *BLANK WQ0331 1 AP - PCC interf
C XBADJG PARM *BLANK WQ0332 1 PR - PCC interf
C XBADJH PARM *BLANK WQ0333 1 PMC - PR interf
C XBADJJ PARM *BLANK WQ0334 1 IM - PCC interf
C XBADJK PARM *BLANK WQ0335 1 PMC - IM interf
C XBADJL PARM *BLANK WQ0336 1 IM - SA interfa
C XBADJM PARM *BLANK WQ0337 1 IM - COM interf
C XBADJN PARM *BLANK WQ0338 1 IM - MRP interf
C XBADJP PARM *BLANK WQ0339 1 IM - PDM interf
C XBADJQ PARM *BLANK WQ0340 1 PDM - PCC inter
C XBADJR PARM *BLANK WQ0341 1 PDM - MRP inter
C XBADJS PARM *BLANK WQ0342 1 PDM - COM inter
C XBADJT PARM *BLANK WQ0343 1 COM - MRP inter
C XBADJV PARM *BLANK WQ0344 1 COM - SA interf
C XBADJW PARM *BLANK WQ0345 1 COM - AR interf
C XBADJY PARM *BLANK WQ0346 1 AR - SA interfa
C XBADJZ PARM *BLANK WQ0347 1 PMC - PCC inter
C XBADJ1 PARM *BLANK WQ0348 1 PCC - IM interf
C XBADJ2 PARM *BLANK WQ0349 1 IM - GL interfa
C XBADJ3 PARM *BLANK WQ0350 1 COM - IM interf
C XBADJ4 PARM *BLANK WQ0351 1 MRP - IM interf
C XBADJ5 PARM *BLANK WQ0352 1 PDM - IM interf
C XBADJ6 PARM *BLANK WQ0353 1 MRP - PDM inter
C XBADJ7 PARM *BLANK WQ0354 1 PCC - GL interf
C XBADJ8 PARM *BLANK WQ0355 1 EDMI - PDM inte
C XBADJ9 PARM *BLANK WQ0356 1 FCST - MRP inte
C XBADJ0 PARM *BLANK WQ0357 1 FA - GL interfa
C XBADKA PARM *BLANK WQ0358 1 Questionnaire h
C XBADKB PARM *BLANK WQ0359 1 Yes response ch
C XBADKC PARM *BLANK WQ0360 1 No response cha
C XBACV5 PARM *BLANK WQ0361 1 Work alpha (1)
C XBADKD PARM *BLANK WQ0362 1 Mth periods def
C XBADKF PARM *BLANK WQ0363 12 Weeks per perio
C XBADKG PARM *BLANK WQ0364 1 Week beginning
C XBADKH PARM *BLANK WQ0365 6 Last file sts r
C XBADKJ PARM *BLANK WQ0366 6 Last file sts r
C XBADKK PARM *BLANK WQ0367 1 REP - GL interf
C XBADKM PARM *BLANK WQ0368 1 IFM GLI interfa
C XBADKN PARM *BLANK WQ0369 1 IFM AP interfac
C XBADKP PARM *BLANK WQ0370 1 IFM AR interfac
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZARUPR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Move key fields to SYSCTL XMREPT format
C MOVELXBACVX YI0201 Loaded from fil
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI02
* Only search if key is not beyond range of current elements
C YL02 IFGT 0
C YK02,YL02 ANDGTYD02
* Set search index to first element of array
C Z-ADD1 Y 50
C YD02 LOKUPYK02,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK02,Y YD02
* Compare
C YI0201 IFEQ XBACVX
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO NPEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL02 ADD 1 Y 50
* Check if element was a previously deleted element
C YK02,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK02,Y YD02
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI02
C ENDIF
* Create(insert) new element
* Move key fields to SYSCTL XMREPT format
C MOVELXBACVX YI0201 Loaded from fil
C MOVELYD02 YK02,Y
C YI02 OCUR YM02
* Update MODS fields
C MOVELXBACVX WJACVX Loaded from fil
C MOVELXBZ80O WJZ80O SYSCTL key erro
C MOVELXBADHJ WJADHJ ACS Apply compl
C MOVELXBADHK WJADHK Initial install
C MOVELXBADHL WJADHL Installation co
C MOVELXBADHM WJADHM AP - IM interfa
C MOVELXBADHN WJADHN AR - AP interfa
C MOVELXBADHP WJADHP PUR - MRP inter
C MOVELXBADHQ WJADHQ PUR - IM interf
C MOVELXBADHR WJADHR MPSP - MRP inte
C MOVELXBADHS WJADHS COM - MPSP inte
C MOVELXBADHT WJADHT MRP - REP inter
C MOVELXBADHV WJADHV COM - REP inter
C MOVELXBADHW WJADHW PMC - REP inter
C MOVELXBADHY WJADHY MPA - COM inter
C MOVELXBADHZ WJADHZ MPA - PCC inter
C MOVELXBADH1 WJADH1 MPA - MRP inter
C MOVELXBADH2 WJADH2 PUR - GL interf
C MOVELXBADH3 WJADH3 PUR - PCC inter
C MOVELXBABW2 WJABW2 Work (alpha 1)
C MOVELXBADH4 WJADH4 Master file sav
C MOVELXBADH5 WJADH5 Current unresta
C MOVELXBADH6 WJADH6 Reuse data entr
C MOVELXBZ9AD WJZ9AD Multi-company i
C MOVELXBADH7 WJADH7 Fiscal period i
C MOVELXBADH8 WJADH8 Date format for
C MOVELXBADH9 WJADH9 Date validation
C MOVELXBADH0 WJADH0 COM - GL interf
C MOVELXBADJA WJADJA I/T checkpoint
C MOVELXBADJB WJADJB PR - GL interfa
C MOVELXBADJC WJADJC AP - GL interfa
C MOVELXBADJD WJADJD AR - GL interfa
C MOVELXBADJF WJADJF AP - PCC interf
C MOVELXBADJG WJADJG PR - PCC interf
C MOVELXBADJH WJADJH PMC - PR interf
C MOVELXBADJJ WJADJJ IM - PCC interf
C MOVELXBADJK WJADJK PMC - IM interf
C MOVELXBADJL WJADJL IM - SA interfa
C MOVELXBADJM WJADJM IM - COM interf
C MOVELXBADJN WJADJN IM - MRP interf
C MOVELXBADJP WJADJP IM - PDM interf
C MOVELXBADJQ WJADJQ PDM - PCC inter
C MOVELXBADJR WJADJR PDM - MRP inter
C MOVELXBADJS WJADJS PDM - COM inter
C MOVELXBADJT WJADJT COM - MRP inter
C MOVELXBADJV WJADJV COM - SA interf
C MOVELXBADJW WJADJW COM - AR interf
C MOVELXBADJY WJADJY AR - SA interfa
C MOVELXBADJZ WJADJZ PMC - PCC inter
C MOVELXBADJ1 WJADJ1 PCC - IM interf
C MOVELXBADJ2 WJADJ2 IM - GL interfa
C MOVELXBADJ3 WJADJ3 COM - IM interf
C MOVELXBADJ4 WJADJ4 MRP - IM interf
C MOVELXBADJ5 WJADJ5 PDM - IM interf
C MOVELXBADJ6 WJADJ6 MRP - PDM inter
C MOVELXBADJ7 WJADJ7 PCC - GL interf
C MOVELXBADJ8 WJADJ8 EDMI - PDM inte
C MOVELXBADJ9 WJADJ9 FCST - MRP inte
C MOVELXBADJ0 WJADJ0 FA - GL interfa
C MOVELXBADKA WJADKA Questionnaire h
C MOVELXBADKB WJADKB Yes response ch
C MOVELXBADKC WJADKC No response cha
C MOVELXBACV5 WJACV5 Work alpha (1)
C MOVELXBADKD WJADKD Mth periods def
C MOVELXBADKF WJADKF Weeks per perio
C MOVELXBADKG WJADKG Week beginning
C MOVELXBADKH WJADKH Last file sts r
C MOVELXBADKJ WJADKJ Last file sts r
C MOVELXBADKK WJADKK REP - GL interf
C MOVELXBADKM WJADKM IFM GLI interfa
C MOVELXBADKN WJADKN IFM AP interfac
C MOVELXBADKP WJADKP IFM AR interfac
* Only sort if element is out of position
C YL02 IFGT 0
C YK02,YL02 ANDGTYD02
* Adjust RTVOBJ index to reflect position of added/removed element
C YR02 IFGT 0
C YR02 ANDLE1
C YK02,YR02 ANDGTYD02
C ADD 1 YR02 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK02
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL02
* Move SYSCTL XMR fields back
C MOVELWJZ80O WUZ80O SYSCTL key erro
C MOVELWJADHJ WUADHJ ACS Apply compl
C MOVELWJADHK WUADHK Initial install
C MOVELWJADHL WUADHL Installation co
C MOVELWJADHM WUADHM AP - IM interfa
C MOVELWJADHN WUADHN AR - AP interfa
C MOVELWJADHP WUADHP PUR - MRP inter
C MOVELWJADHQ WUADHQ PUR - IM interf
C MOVELWJADHR WUADHR MPSP - MRP inte
C MOVELWJADHS WUADHS COM - MPSP inte
C MOVELWJADHT WUADHT MRP - REP inter
C MOVELWJADHV WUADHV COM - REP inter
C MOVELWJADHW WUADHW PMC - REP inter
C MOVELWJADHY WUADHY MPA - COM inter
C MOVELWJADHZ WUADHZ MPA - PCC inter
C MOVELWJADH1 WUADH1 MPA - MRP inter
C MOVELWJADH2 WUADH2 PUR - GL interf
C MOVELWJADH3 WUADH3 PUR - PCC inter
C MOVELWJABW2 WUABW2 Work (alpha 1)
C MOVELWJADH4 WUADH4 Master file sav
C MOVELWJADH5 WUADH5 Current unresta
C MOVELWJADH6 WUADH6 Reuse data entr
C MOVELWJZ9AD WUZ9AD Multi-company i
C MOVELWJADH7 WUADH7 Fiscal period i
C MOVELWJADH8 WUADH8 Date format for
C MOVELWJADH9 WUADH9 Date validation
C MOVELWJADH0 WUADH0 COM - GL interf
C MOVELWJADJA WUADJA I/T checkpoint
C MOVELWJADJB WUADJB PR - GL interfa
C MOVELWJADJC WUADJC AP - GL interfa
C MOVELWJADJD WUADJD AR - GL interfa
C MOVELWJADJF WUADJF AP - PCC interf
C MOVELWJADJG WUADJG PR - PCC interf
C MOVELWJADJH WUADJH PMC - PR interf
C MOVELWJADJJ WUADJJ IM - PCC interf
C MOVELWJADJK WUADJK PMC - IM interf
C MOVELWJADJL WUADJL IM - SA interfa
C MOVELWJADJM WUADJM IM - COM interf
C MOVELWJADJN WUADJN IM - MRP interf
C MOVELWJADJP WUADJP IM - PDM interf
C MOVELWJADJQ WUADJQ PDM - PCC inter
C MOVELWJADJR WUADJR PDM - MRP inter
C MOVELWJADJS WUADJS PDM - COM inter
C MOVELWJADJT WUADJT COM - MRP inter
C MOVELWJADJV WUADJV COM - SA interf
C MOVELWJADJW WUADJW COM - AR interf
C MOVELWJADJY WUADJY AR - SA interfa
C MOVELWJADJZ WUADJZ PMC - PCC inter
C MOVELWJADJ1 WUADJ1 PCC - IM interf
C MOVELWJADJ2 WUADJ2 IM - GL interfa
C MOVELWJADJ3 WUADJ3 COM - IM interf
C MOVELWJADJ4 WUADJ4 MRP - IM interf
C MOVELWJADJ5 WUADJ5 PDM - IM interf
C MOVELWJADJ6 WUADJ6 MRP - PDM inter
C MOVELWJADJ7 WUADJ7 PCC - GL interf
C MOVELWJADJ8 WUADJ8 EDMI - PDM inte
C MOVELWJADJ9 WUADJ9 FCST - MRP inte
C MOVELWJADJ0 WUADJ0 FA - GL interfa
C MOVELWJADKA WUADKA Questionnaire h
C MOVELWJADKB WUADKB Yes response ch
C MOVELWJADKC WUADKC No response cha
C MOVELWJACV5 WUACV5 Work alpha (1)
C MOVELWJADKD WUADKD Mth periods def
C MOVELWJADKF WUADKF Weeks per perio
C MOVELWJADKG WUADKG Week beginning
C MOVELWJADKH WUADKH Last file sts r
C MOVELWJADKJ WUADKJ Last file sts r
C MOVELWJADKK WUADKK REP - GL interf
C MOVELWJADKM WUADKM IFM GLI interfa
C MOVELWJADKN WUADKN IFM AP interfac
C MOVELWJADKP WUADKP IFM AR interfac
* USER: Processing after Data update
* PAR = DB1 By name
C MOVELXBZ80O WUZ80O SYSCTL key erro
C MOVELXBADHJ WUADHJ ACS Apply compl
C MOVELXBADHK WUADHK Initial install
C MOVELXBADHL WUADHL Installation co
C MOVELXBADHM WUADHM AP - IM interfa
C MOVELXBADHN WUADHN AR - AP interfa
C MOVELXBADHP WUADHP PUR - MRP inter
C MOVELXBADHQ WUADHQ PUR - IM interf
C MOVELXBADHR WUADHR MPSP - MRP inte
C MOVELXBADHS WUADHS COM - MPSP inte
C MOVELXBADHT WUADHT MRP - REP inter
C MOVELXBADHV WUADHV COM - REP inter
C MOVELXBADHW WUADHW PMC - REP inter
C MOVELXBADHY WUADHY MPA - COM inter
C MOVELXBADHZ WUADHZ MPA - PCC inter
C MOVELXBADH1 WUADH1 MPA - MRP inter
C MOVELXBADH2 WUADH2 PUR - GL interf
C MOVELXBADH3 WUADH3 PUR - PCC inter
C MOVELXBABW2 WUABW2 Work (alpha 1)
C MOVELXBADH4 WUADH4 Master file sav
C MOVELXBADH5 WUADH5 Current unresta
C MOVELXBADH6 WUADH6 Reuse data entr
C MOVELXBZ9AD WUZ9AD Multi-company i
C MOVELXBADH7 WUADH7 Fiscal period i
C MOVELXBADH8 WUADH8 Date format for
C MOVELXBADH9 WUADH9 Date validation
C MOVELXBADH0 WUADH0 COM - GL interf
C MOVELXBADJA WUADJA I/T checkpoint
C MOVELXBADJB WUADJB PR - GL interfa
C MOVELXBADJC WUADJC AP - GL interfa
C MOVELXBADJD WUADJD AR - GL interfa
C MOVELXBADJF WUADJF AP - PCC interf
C MOVELXBADJG WUADJG PR - PCC interf
C MOVELXBADJH WUADJH PMC - PR interf
C MOVELXBADJJ WUADJJ IM - PCC interf
C MOVELXBADJK WUADJK PMC - IM interf
C MOVELXBADJL WUADJL IM - SA interfa
C MOVELXBADJM WUADJM IM - COM interf
C MOVELXBADJN WUADJN IM - MRP interf
C MOVELXBADJP WUADJP IM - PDM interf
C MOVELXBADJQ WUADJQ PDM - PCC inter
C MOVELXBADJR WUADJR PDM - MRP inter
C MOVELXBADJS WUADJS PDM - COM inter
C MOVELXBADJT WUADJT COM - MRP inter
C MOVELXBADJV WUADJV COM - SA interf
C MOVELXBADJW WUADJW COM - AR interf
C MOVELXBADJY WUADJY AR - SA interfa
C MOVELXBADJZ WUADJZ PMC - PCC inter
C MOVELXBADJ1 WUADJ1 PCC - IM interf
C MOVELXBADJ2 WUADJ2 IM - GL interfa
C MOVELXBADJ3 WUADJ3 COM - IM interf
C MOVELXBADJ4 WUADJ4 MRP - IM interf
C MOVELXBADJ5 WUADJ5 PDM - IM interf
C MOVELXBADJ6 WUADJ6 MRP - PDM inter
C MOVELXBADJ7 WUADJ7 PCC - GL interf
C MOVELXBADJ8 WUADJ8 EDMI - PDM inte
C MOVELXBADJ9 WUADJ9 FCST - MRP inte
C MOVELXBADJ0 WUADJ0 FA - GL interfa
C MOVELXBADKA WUADKA Questionnaire h
C MOVELXBADKB WUADKB Yes response ch
C MOVELXBADKC WUADKC No response cha
C MOVELXBACV5 WUACV5 Work alpha (1)
C MOVELXBADKD WUADKD Mth periods def
C MOVELXBADKF WUADKF Weeks per perio
C MOVELXBADKG WUADKG Week beginning
C MOVELXBADKH WUADKH Last file sts r
C MOVELXBADKJ WUADKJ Last file sts r
C MOVELXBADKK WUADKK REP - GL interf
C MOVELXBADKM WUADKM IFM GLI interfa
C MOVELXBADKN WUADKN IFM AP interfac
C MOVELXBADKP WUADKP IFM AR interfac
*================================================================
CSR NPEXIT ENDSR
/EJECT
CSR NQDLRC BEGSR
*================================================================
* DLT:History Special Chg 2 - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Initialize array variables
C MOVEA*HIVAL YK03
* Initialize last used element number
C Z-ADD0 YL03
*================================================================
CSR NQEXIT ENDSR
/EJECT
CSR NRDLRC BEGSR
*================================================================
* DLT:History Special Chg - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Initialize array variables
C MOVEA*HIVAL YK04
* Initialize last used element number
C Z-ADD0 YL04
*================================================================
CSR NREXIT ENDSR
/EJECT
CSR NSRVGN BEGSR
*================================================================
* RTV:Count Surch & Special - History Special Charge *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD*ZERO WUAC0B &No of Special
C Z-ADD*ZERO WUAC0C &No of Surcharg
* Declare restrictor key work fields
C *LIKE DEFN WMAENB WQNS01 Company number
C *LIKE DEFN WMGGNB WQNS02 Invoice number
C *LIKE DEFN WMHYNB WQNS03 Invoice sequenc
* Define keylist
C KRSNS KLIST
C KFLD WQNS01 Company number
C KFLD WQNS02 Invoice number
C KFLD WQNS03 Invoice sequenc
* Setup key
C Z-ADDC6AENB WQNS01 Company number
C Z-ADD*ZERO WQNS02 Invoice number
C Z-ADDP3HYNB WQNS03 Invoice sequenc
* Establish starting position
C KRSNS SETLLFF9CPYI *
C KRSNS READEFF9CPYI 90*
* Data record not found
C 90 MOVEL'AMB0796' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Special charge code is Blank
C WMBLST IFEQ *BLANK *IF
C ADD 1 WUAC0C &No of Surcharg
C ELSE
* CASE: *OTHERWISE
C ADD 1 WUAC0B &No of Special
C END *FI
C KRSNS READEFF9CPYI 90*
C ENDDO
*================================================================
CSR NSEXIT ENDSR
/EJECT
CSR NTRVGN BEGSR
*================================================================
* RTV:Spec Chg Commnt Exist - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WOAENB WQNT01 Company number
C *LIKE DEFN WOGGNB WQNT02 Invoice number
C *LIKE DEFN WOHYNB WQNT03 Invoice sequenc
C *LIKE DEFN WOAAD2 WQNT04 Special charge
* Define keylist
C KRSNT KLIST
C KFLD WQNT01 Company number
C KFLD WQNT02 Invoice number
C KFLD WQNT03 Invoice sequenc
C KFLD WQNT04 Special charge
* Setup key
C Z-ADDZRAENB WQNT01 Company number
C Z-ADDZRGGNB WQNT02 Invoice number
C Z-ADDZRHYNB WQNT03 Invoice sequenc
C Z-ADDZRAAD2 WQNT04 Special charge
* Establish starting position
C KRSNT SETLLFGACPUT *
C KRSNT READEFGACPUT 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0798' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO NTEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
C MOVEL'Y2U0003' W0RTN *Return code
C GOTO NTEXIT *QUIT
C KRSNT READEFGACPUT 90*
C ENDDO
*================================================================
CSR NTEXIT ENDSR
/EJECT
CSR NURVGN BEGSR
*================================================================
* RTV:Header Commnt - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSNU KLIST
C KFLD WCAENB Company number
C KFLD WCGGNB Invoice number
C KFLD WCHYNB Invoice sequenc
C KFLD WCKBNB Comment line se
C KFLD WCAKCD Language code
* Setup key
C Z-ADDZSAENB WCAENB Company number
C Z-ADDZSGGNB WCGGNB Invoice number
C Z-ADDZSHYNB WCHYNB Invoice sequenc
C Z-ADDWUKBNB WCKBNB Comment line se
C MOVELZSAKCD WCAKCD Language code
* Establish starting position
C KRSNU CHAINFGACPYO 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0798' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUHDTX Comment line te
C GOTO NUEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELWCHDTX WUHDTX Comment line te
C GOTO NUEXIT *QUIT
C ENDIF
*================================================================
CSR NUEXIT ENDSR
/EJECT
CSR NVRVGN BEGSR
*================================================================
* RTV:Build lines up header - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD1 WUAAJH Counter
C MOVELZSAKCD WUHVCD Language code U
C Z-ADD*ZERO WUAFD6 Comment line se
* Declare restrictor key work fields
C *LIKE DEFN WCAENB WQNV01 Company number
C *LIKE DEFN WCGGNB WQNV02 Invoice number
C *LIKE DEFN WCHYNB WQNV03 Invoice sequenc
* Define keylist
C KPSNV KLIST
C KFLD WQNV01 Company number
C KFLD WQNV02 Invoice number
C KFLD WQNV03 Invoice sequenc
C KFLD WCKBNB Comment line se
* Define keylist
C KRSNV KLIST
C KFLD WQNV01 Company number
C KFLD WQNV02 Invoice number
C KFLD WQNV03 Invoice sequenc
* Setup key
C Z-ADDZSAENB WQNV01 Company number
C Z-ADDZSGGNB WQNV02 Invoice number
C Z-ADDZSHYNB WQNV03 Invoice sequenc
C Z-ADDWUKBNB WCKBNB Comment line se
* Establish starting position
C KPSNV SETLLFGACPYO *
C KRSNV READEFGACPYO 90*
* Data record not found
C 90 MOVEL'AMB0798' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
C MOVEL'1' WUAA04 Continue?
* Make sure this is not a line item comment and it is supposed to p
* CASE: DB1.Internal print only? is Yes
C WCAAD9 IFEQ '1' *IF
C MOVEL'0' WUAA04 Continue?
C ELSE
* CASE: DB1.Ship release sequence is Not Zero
C WCLCNB IFNE *ZERO *IF
* Do not print comments for line items
C MOVEL'0' WUAA04 Continue?
C END *FI
C END *FI
* Par special charge seq NE DB1 special charge seq, then print=no
* CASE: PAR.Special charge sequence # NE DB1.Special charge sequenc
C ZSAAD2 IFNE WCAAD2 *IF
C MOVEL'0' WUAA04 Continue?
C END *FI
* set up 2up or 3up
* CASE: WRK.Continue? is Yes
C WUAA04 IFEQ '1' *IF
* CASE: If Print Control,Reference,and Language equal PAR
* - c1 AND c2 AND c3
* |- c1 : DB1.Text line print control EQ PAR.Text line print c
* |- c2 : DB1.Comment user reference EQ PAR.Comment user refer
* |- c3 : DB1.Language code EQ PAR.Language code
* '-
C MOVEL'0' Y0CX01 1
C WCAD1N IFEQ ZSAD1N *IF
C WCHXCD IFEQ ZSHXCD *IF
C WCAKCD IFEQ ZSAKCD *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* 2 lines up process:
* CASE: DB1.Text line print control is 2 lines up
C WCAD1N IFEQ '2' *IF
C Z-ADDWCKBNB WUAFD6 Comment line se
C MOVELWCAKCD WUHVCD Language code U
C Z-ADD1 ZQ 50
C ZSAFD5 CAT WCHDTX:ZQ ZSAFD5 P Text Line Descr
C GOTO NVEXIT *QUIT
C END *FI
* 3 lines up process:
* CASE: DB1.Text line print control is 3 lines up
C WCAD1N IFEQ '3' *IF
C ADD 1 WUAAJH Counter
* CASE: WRK.Counter is EQ 2
C WUAAJH IFEQ 2 *IF
C Z-ADDWCKBNB WUAFD6 Comment line se
C MOVELWCAKCD WUHVCD Language code U
C Z-ADD1 ZQ 50
C ZSAFD5 CAT WCHDTX:ZQ ZSAFD5 P Text Line Descr
C ELSE
* CASE: WRK.Counter is EQ 3
C WUAAJH IFEQ 3 *IF
* ** test if room allows for 3 across comments
C Z-ADD1 ZQ 50
C ZSAFD5 CAT WCHDTX:ZQ WUAFD7 P Text line 77 US
C Z-ADD2 YRSW00
C Z-ADD76 ZQ 50
C YRSW00 IFLT 1
C ZQ ORLT 1
C YRSW00 ORGT 00077
C ZQ ORGT 00077
C MOVEL'Y2U0510' W0RTN
C ELSE
C YRSW00 SUBSTWUAFD7:ZQ WUACC3 P 90 &Alpha 2 USR
C 90 MOVEL'Y2U0510' W0RTN
C END
* If characters are in the last 2 postions quite, other concat
* CASE: WRK.&Alpha 2 USR is Not blank
C WUACC3 IFGT *BLANK *IF
C GOTO NVEXIT *QUIT
C ELSE
* CASE: *OTHERWISE
C Z-ADDWCKBNB WUAFD6 Comment line se
C MOVELWCAKCD WUHVCD Language code U
C Z-ADD1 ZQ 50
C ZSAFD5 CAT WCHDTX:ZQ ZSAFD5 P Text Line Descr
C GOTO NVEXIT *QUIT
C END *FI
C END *FI
C END *FI
C END *FI
C ELSE
* CASE: *OTHERWISE
C GOTO NVEXIT *QUIT
C END *FI
C END *FI
C KRSNV READEFGACPYO 90*
C ENDDO
*================================================================
CSR NVEXIT ENDSR
/EJECT
CSR NWRVGN BEGSR
*================================================================
* RTV:Reposition ptr - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WBAENB WQNW01 Company number
C *LIKE DEFN WBGGNB WQNW02 Invoice number
C *LIKE DEFN WBHYNB WQNW03 Invoice sequenc
C *LIKE DEFN WBDCCD WQNW04 Internal header
C *LIKE DEFN WBCVNB WQNW05 Quote/order num
C *LIKE DEFN WBHXCD WQNW06 Comment user re
C *LIKE DEFN WBKBNB WQNW07 Comment line se
* Define keylist
C KRSNW KLIST
C KFLD WQNW01 Company number
C KFLD WQNW02 Invoice number
C KFLD WQNW03 Invoice sequenc
C KFLD WQNW04 Internal header
C KFLD WQNW05 Quote/order num
C KFLD WQNW06 Comment user re
C KFLD WQNW07 Comment line se
* Setup key
C Z-ADDWBAENB WQNW01 Company number
C Z-ADDWBGGNB WQNW02 Invoice number
C Z-ADDWBHYNB WQNW03 Invoice sequenc
C MOVELWBDCCD WQNW04 Internal header
C MOVELWBCVNB WQNW05 Quote/order num
C MOVELWBHXCD WQNW06 Comment user re
C Z-ADDWUAFD6 WQNW07 Comment line se
* Establish starting position
C KRSNW SETLLFGACPLS *
C KRSNW READEFGACPLS 90*
* Data record not found
C 90 MOVEL'AMB0798' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: PAR.Language code EQ DB1.Language code
C WUHVCD IFEQ WBAKCD *IF
C GOTO NWEXIT *QUIT
C END *FI
C KRSNW READEFGACPLS 90*
C ENDDO
*================================================================
CSR NWEXIT ENDSR
/EJECT
CSR NXRVGN BEGSR
*================================================================
* RTV:SYSCTL XMREPT Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL02 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK02,Y YD02
C YI02 OCUR YM02
* Initialize internal index
C MOVEL*LOVAL YD02
* Move key fields to SYSCTL XMREPT format
C MOVEL'1' YI0201 Loaded from fil
* Only search if key is not beyond range of current elements
C YK02,YL02 IFGT YD02
C YD02 LOKUPYK02,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK02,Y YD02
* Compare
C YI0201 IFNE '1'
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO NXEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI02 OCUR YM02
* USER: Process Data record
* PAR = DB1 By name
C MOVELWJZ80O WUZ80O SYSCTL key erro
C MOVELWJADHJ WUADHJ ACS Apply compl
C MOVELWJADHK WUADHK Initial install
C MOVELWJADHL WUADHL Installation co
C MOVELWJADHM WUADHM AP - IM interfa
C MOVELWJADHN WUADHN AR - AP interfa
C MOVELWJADHP WUADHP PUR - MRP inter
C MOVELWJADHQ WUADHQ PUR - IM interf
C MOVELWJADHR WUADHR MPSP - MRP inte
C MOVELWJADHS WUADHS COM - MPSP inte
C MOVELWJADHT WUADHT MRP - REP inter
C MOVELWJADHV WUADHV COM - REP inter
C MOVELWJADHW WUADHW PMC - REP inter
C MOVELWJADHY WUADHY MPA - COM inter
C MOVELWJADHZ WUADHZ MPA - PCC inter
C MOVELWJADH1 WUADH1 MPA - MRP inter
C MOVELWJADH2 WUADH2 PUR - GL interf
C MOVELWJADH3 WUADH3 PUR - PCC inter
C MOVELWJABW2 WUABW2 Work (alpha 1)
C MOVELWJADH4 WUADH4 Master file sav
C MOVELWJADH5 WUADH5 Current unresta
C MOVELWJADH6 WUADH6 Reuse data entr
C MOVELWJZ9AD WUZ9AD Multi-company i
C MOVELWJADH7 WUADH7 Fiscal period i
C MOVELWJADH8 WUADH8 Date format for
C MOVELWJADH9 WUADH9 Date validation
C MOVELWJADH0 WUADH0 COM - GL interf
C MOVELWJADJA WUADJA I/T checkpoint
C MOVELWJADJB WUADJB PR - GL interfa
C MOVELWJADJC WUADJC AP - GL interfa
C MOVELWJADJD WUADJD AR - GL interfa
C MOVELWJADJF WUADJF AP - PCC interf
C MOVELWJADJG WUADJG PR - PCC interf
C MOVELWJADJH WUADJH PMC - PR interf
C MOVELWJADJJ WUADJJ IM - PCC interf
C MOVELWJADJK WUADJK PMC - IM interf
C MOVELWJADJL WUADJL IM - SA interfa
C MOVELWJADJM WUADJM IM - COM interf
C MOVELWJADJN WUADJN IM - MRP interf
C MOVELWJADJP WUADJP IM - PDM interf
C MOVELWJADJQ WUADJQ PDM - PCC inter
C MOVELWJADJR WUADJR PDM - MRP inter
C MOVELWJADJS WUADJS PDM - COM inter
C MOVELWJADJT WUADJT COM - MRP inter
C MOVELWJADJV WUADJV COM - SA interf
C MOVELWJADJW WUADJW COM - AR interf
C MOVELWJADJY WUADJY AR - SA interfa
C MOVELWJADJZ WUADJZ PMC - PCC inter
C MOVELWJADJ1 WUADJ1 PCC - IM interf
C MOVELWJADJ2 WUADJ2 IM - GL interfa
C MOVELWJADJ3 WUADJ3 COM - IM interf
C MOVELWJADJ4 WUADJ4 MRP - IM interf
C MOVELWJADJ5 WUADJ5 PDM - IM interf
C MOVELWJADJ6 WUADJ6 MRP - PDM inter
C MOVELWJADJ7 WUADJ7 PCC - GL interf
C MOVELWJADJ8 WUADJ8 EDMI - PDM inte
C MOVELWJADJ9 WUADJ9 FCST - MRP inte
C MOVELWJADJ0 WUADJ0 FA - GL interfa
C MOVELWJADKA WUADKA Questionnaire h
C MOVELWJADKB WUADKB Yes response ch
C MOVELWJADKC WUADKC No response cha
C MOVELWJACV5 WUACV5 Work alpha (1)
C MOVELWJADKD WUADKD Mth periods def
C MOVELWJADKF WUADKF Weeks per perio
C MOVELWJADKG WUADKG Week beginning
C MOVELWJADKH WUADKH Last file sts r
C MOVELWJADKJ WUADKJ Last file sts r
C MOVELWJADKK WUADKK REP - GL interf
C MOVELWJADKM WUADKM IFM GLI interfa
C MOVELWJADKN WUADKN IFM AP interfac
C MOVELWJADKP WUADKP IFM AR interfac
C ENDIF
*================================================================
CSR NXEXIT ENDSR
/EJECT
CSR NYCRRC BEGSR
*================================================================
* Load SYSCTL XMREPT Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL02 IFEQ 1
C MOVEL'Y2U0036' W0RTN 7
C GOTO NYEXIT
C ENDIF
C MOVEL*BLANK XBACVX Loaded from fil
C MOVEL*BLANK XBZ80O SYSCTL key erro
C MOVEL*BLANK XBADHJ ACS Apply compl
C MOVEL*BLANK XBADHK Initial install
C MOVEL*BLANK XBADHL Installation co
C MOVEL*BLANK XBADHM AP - IM interfa
C MOVEL*BLANK XBADHN AR - AP interfa
C MOVEL*BLANK XBADHP PUR - MRP inter
C MOVEL*BLANK XBADHQ PUR - IM interf
C MOVEL*BLANK XBADHR MPSP - MRP inte
C MOVEL*BLANK XBADHS COM - MPSP inte
C MOVEL*BLANK XBADHT MRP - REP inter
C MOVEL*BLANK XBADHV COM - REP inter
C MOVEL*BLANK XBADHW PMC - REP inter
C MOVEL*BLANK XBADHY MPA - COM inter
C MOVEL*BLANK XBADHZ MPA - PCC inter
C MOVEL*BLANK XBADH1 MPA - MRP inter
C MOVEL*BLANK XBADH2 PUR - GL interf
C MOVEL*BLANK XBADH3 PUR - PCC inter
C MOVEL*BLANK XBABW2 Work (alpha 1)
C MOVEL*BLANK XBADH4 Master file sav
C MOVEL*BLANK XBADH5 Current unresta
C MOVEL*BLANK XBADH6 Reuse data entr
C MOVEL*BLANK XBZ9AD Multi-company i
C MOVEL*BLANK XBADH7 Fiscal period i
C MOVEL*BLANK XBADH8 Date format for
C MOVEL*BLANK XBADH9 Date validation
C MOVEL*BLANK XBADH0 COM - GL interf
C MOVEL*BLANK XBADJA I/T checkpoint
C MOVEL*BLANK XBADJB PR - GL interfa
C MOVEL*BLANK XBADJC AP - GL interfa
C MOVEL*BLANK XBADJD AR - GL interfa
C MOVEL*BLANK XBADJF AP - PCC interf
C MOVEL*BLANK XBADJG PR - PCC interf
C MOVEL*BLANK XBADJH PMC - PR interf
C MOVEL*BLANK XBADJJ IM - PCC interf
C MOVEL*BLANK XBADJK PMC - IM interf
C MOVEL*BLANK XBADJL IM - SA interfa
C MOVEL*BLANK XBADJM IM - COM interf
C MOVEL*BLANK XBADJN IM - MRP interf
C MOVEL*BLANK XBADJP IM - PDM interf
C MOVEL*BLANK XBADJQ PDM - PCC inter
C MOVEL*BLANK XBADJR PDM - MRP inter
C MOVEL*BLANK XBADJS PDM - COM inter
C MOVEL*BLANK XBADJT COM - MRP inter
C MOVEL*BLANK XBADJV COM - SA interf
C MOVEL*BLANK XBADJW COM - AR interf
C MOVEL*BLANK XBADJY AR - SA interfa
C MOVEL*BLANK XBADJZ PMC - PCC inter
C MOVEL*BLANK XBADJ1 PCC - IM interf
C MOVEL*BLANK XBADJ2 IM - GL interfa
C MOVEL*BLANK XBADJ3 COM - IM interf
C MOVEL*BLANK XBADJ4 MRP - IM interf
C MOVEL*BLANK XBADJ5 PDM - IM interf
C MOVEL*BLANK XBADJ6 MRP - PDM inter
C MOVEL*BLANK XBADJ7 PCC - GL interf
C MOVEL*BLANK XBADJ8 EDMI - PDM inte
C MOVEL*BLANK XBADJ9 FCST - MRP inte
C MOVEL*BLANK XBADJ0 FA - GL interfa
C MOVEL*BLANK XBADKA Questionnaire h
C MOVEL*BLANK XBADKB Yes response ch
C MOVEL*BLANK XBADKC No response cha
C MOVEL*BLANK XBACV5 Work alpha (1)
C MOVEL*BLANK XBADKD Mth periods def
C MOVEL*BLANK XBADKF Weeks per perio
C MOVEL*BLANK XBADKG Week beginning
C MOVEL*BLANK XBADKH Last file sts r
C MOVEL*BLANK XBADKJ Last file sts r
C MOVEL*BLANK XBADKK REP - GL interf
C MOVEL*BLANK XBADKM IFM GLI interfa
C MOVEL*BLANK XBADKN IFM AP interfac
C MOVEL*BLANK XBADKP IFM AR interfac
* Move all fields to SYSCTL XMREPT format
C MOVEL'1' XBACVX Loaded from fil
C MOVEL*BLANK XBZ80O SYSCTL key erro
C MOVEL*BLANK XBADHJ ACS Apply compl
C MOVEL*BLANK XBADHK Initial install
C MOVEL*BLANK XBADHL Installation co
C MOVEL*BLANK XBADHM AP - IM interfa
C MOVEL*BLANK XBADHN AR - AP interfa
C MOVEL*BLANK XBADHP PUR - MRP inter
C MOVEL*BLANK XBADHQ PUR - IM interf
C MOVEL*BLANK XBADHR MPSP - MRP inte
C MOVEL*BLANK XBADHS COM - MPSP inte
C MOVEL*BLANK XBADHT MRP - REP inter
C MOVEL*BLANK XBADHV COM - REP inter
C MOVEL*BLANK XBADHW PMC - REP inter
C MOVEL*BLANK XBADHY MPA - COM inter
C MOVEL*BLANK XBADHZ MPA - PCC inter
C MOVEL*BLANK XBADH1 MPA - MRP inter
C MOVEL*BLANK XBADH2 PUR - GL interf
C MOVEL*BLANK XBADH3 PUR - PCC inter
C MOVEL*BLANK XBABW2 Work (alpha 1)
C MOVEL*BLANK XBADH4 Master file sav
C MOVEL*BLANK XBADH5 Current unresta
C MOVEL*BLANK XBADH6 Reuse data entr
C MOVEL*BLANK XBZ9AD Multi-company i
C MOVEL*BLANK XBADH7 Fiscal period i
C MOVEL*BLANK XBADH8 Date format for
C MOVEL*BLANK XBADH9 Date validation
C MOVEL*BLANK XBADH0 COM - GL interf
C MOVEL*BLANK XBADJA I/T checkpoint
C MOVEL*BLANK XBADJB PR - GL interfa
C MOVEL*BLANK XBADJC AP - GL interfa
C MOVEL*BLANK XBADJD AR - GL interfa
C MOVEL*BLANK XBADJF AP - PCC interf
C MOVEL*BLANK XBADJG PR - PCC interf
C MOVEL*BLANK XBADJH PMC - PR interf
C MOVEL*BLANK XBADJJ IM - PCC interf
C MOVEL*BLANK XBADJK PMC - IM interf
C MOVEL*BLANK XBADJL IM - SA interfa
C MOVEL*BLANK XBADJM IM - COM interf
C MOVEL*BLANK XBADJN IM - MRP interf
C MOVEL*BLANK XBADJP IM - PDM interf
C MOVEL*BLANK XBADJQ PDM - PCC inter
C MOVEL*BLANK XBADJR PDM - MRP inter
C MOVEL*BLANK XBADJS PDM - COM inter
C MOVEL*BLANK XBADJT COM - MRP inter
C MOVEL*BLANK XBADJV COM - SA interf
C MOVEL*BLANK XBADJW COM - AR interf
C MOVEL*BLANK XBADJY AR - SA interfa
C MOVEL*BLANK XBADJZ PMC - PCC inter
C MOVEL*BLANK XBADJ1 PCC - IM interf
C MOVEL*BLANK XBADJ2 IM - GL interfa
C MOVEL*BLANK XBADJ3 COM - IM interf
C MOVEL*BLANK XBADJ4 MRP - IM interf
C MOVEL*BLANK XBADJ5 PDM - IM interf
C MOVEL*BLANK XBADJ6 MRP - PDM inter
C MOVEL*BLANK XBADJ7 PCC - GL interf
C MOVEL*BLANK XBADJ8 EDMI - PDM inte
C MOVEL*BLANK XBADJ9 FCST - MRP inte
C MOVEL*BLANK XBADJ0 FA - GL interfa
C MOVEL*BLANK XBADKA Questionnaire h
C MOVEL*BLANK XBADKB Yes response ch
C MOVEL*BLANK XBADKC No response cha
C MOVEL*BLANK XBACV5 Work alpha (1)
C MOVEL*BLANK XBADKD Mth periods def
C MOVEL*BLANK XBADKF Weeks per perio
C MOVEL*BLANK XBADKG Week beginning
C MOVEL*BLANK XBADKH Last file sts r
C MOVEL*BLANK XBADKJ Last file sts r
C MOVEL*BLANK XBADKK REP - GL interf
C MOVEL*BLANK XBADKM IFM GLI interfa
C MOVEL*BLANK XBADKN IFM AP interfac
C MOVEL*BLANK XBADKP IFM AR interfac
* USER: Processing before Data update
* RTV:SYSCTL XMREPT format - SYSCTL API non-OEI rcds *
C CALL 'AMZARUPR' 90 RTV:SYSCTL XMRE
C PARM XBZ80O WQ0386 6 SYSCTL key erro
C PARM W0RTN WQ0387 7 *Return code
C XBADHJ PARM *BLANK WQ0388 1 ACS Apply compl
C XBADHK PARM *BLANK WQ0389 1 Initial install
C XBADHL PARM *BLANK WQ0390 1 Installation co
C XBADHM PARM *BLANK WQ0391 1 AP - IM interfa
C XBADHN PARM *BLANK WQ0392 1 AR - AP interfa
C XBADHP PARM *BLANK WQ0393 1 PUR - MRP inter
C XBADHQ PARM *BLANK WQ0394 1 PUR - IM interf
C XBADHR PARM *BLANK WQ0395 1 MPSP - MRP inte
C XBADHS PARM *BLANK WQ0396 1 COM - MPSP inte
C XBADHT PARM *BLANK WQ0397 1 MRP - REP inter
C XBADHV PARM *BLANK WQ0398 1 COM - REP inter
C XBADHW PARM *BLANK WQ0399 1 PMC - REP inter
C XBADHY PARM *BLANK WQ0400 1 MPA - COM inter
C XBADHZ PARM *BLANK WQ0401 1 MPA - PCC inter
C XBADH1 PARM *BLANK WQ0402 1 MPA - MRP inter
C XBADH2 PARM *BLANK WQ0403 1 PUR - GL interf
C XBADH3 PARM *BLANK WQ0404 1 PUR - PCC inter
C XBABW2 PARM *BLANK WQ0405 1 Work (alpha 1)
C XBADH4 PARM *BLANK WQ0406 1 Master file sav
C XBADH5 PARM *BLANK WQ0407 3 Current unresta
C XBADH6 PARM *BLANK WQ0408 1 Reuse data entr
C XBZ9AD PARM *BLANK WQ0409 1 Multi-company i
C XBADH7 PARM *BLANK WQ0410 1 Fiscal period i
C XBADH8 PARM *BLANK WQ0411 1 Date format for
C XBADH9 PARM *BLANK WQ0412 1 Date validation
C XBADH0 PARM *BLANK WQ0413 1 COM - GL interf
C XBADJA PARM *BLANK WQ0414 3 I/T checkpoint
C XBADJB PARM *BLANK WQ0415 1 PR - GL interfa
C XBADJC PARM *BLANK WQ0416 1 AP - GL interfa
C XBADJD PARM *BLANK WQ0417 1 AR - GL interfa
C XBADJF PARM *BLANK WQ0418 1 AP - PCC interf
C XBADJG PARM *BLANK WQ0419 1 PR - PCC interf
C XBADJH PARM *BLANK WQ0420 1 PMC - PR interf
C XBADJJ PARM *BLANK WQ0421 1 IM - PCC interf
C XBADJK PARM *BLANK WQ0422 1 PMC - IM interf
C XBADJL PARM *BLANK WQ0423 1 IM - SA interfa
C XBADJM PARM *BLANK WQ0424 1 IM - COM interf
C XBADJN PARM *BLANK WQ0425 1 IM - MRP interf
C XBADJP PARM *BLANK WQ0426 1 IM - PDM interf
C XBADJQ PARM *BLANK WQ0427 1 PDM - PCC inter
C XBADJR PARM *BLANK WQ0428 1 PDM - MRP inter
C XBADJS PARM *BLANK WQ0429 1 PDM - COM inter
C XBADJT PARM *BLANK WQ0430 1 COM - MRP inter
C XBADJV PARM *BLANK WQ0431 1 COM - SA interf
C XBADJW PARM *BLANK WQ0432 1 COM - AR interf
C XBADJY PARM *BLANK WQ0433 1 AR - SA interfa
C XBADJZ PARM *BLANK WQ0434 1 PMC - PCC inter
C XBADJ1 PARM *BLANK WQ0435 1 PCC - IM interf
C XBADJ2 PARM *BLANK WQ0436 1 IM - GL interfa
C XBADJ3 PARM *BLANK WQ0437 1 COM - IM interf
C XBADJ4 PARM *BLANK WQ0438 1 MRP - IM interf
C XBADJ5 PARM *BLANK WQ0439 1 PDM - IM interf
C XBADJ6 PARM *BLANK WQ0440 1 MRP - PDM inter
C XBADJ7 PARM *BLANK WQ0441 1 PCC - GL interf
C XBADJ8 PARM *BLANK WQ0442 1 EDMI - PDM inte
C XBADJ9 PARM *BLANK WQ0443 1 FCST - MRP inte
C XBADJ0 PARM *BLANK WQ0444 1 FA - GL interfa
C XBADKA PARM *BLANK WQ0445 1 Questionnaire h
C XBADKB PARM *BLANK WQ0446 1 Yes response ch
C XBADKC PARM *BLANK WQ0447 1 No response cha
C XBACV5 PARM *BLANK WQ0448 1 Work alpha (1)
C XBADKD PARM *BLANK WQ0449 1 Mth periods def
C XBADKF PARM *BLANK WQ0450 12 Weeks per perio
C XBADKG PARM *BLANK WQ0451 1 Week beginning
C XBADKH PARM *BLANK WQ0452 6 Last file sts r
C XBADKJ PARM *BLANK WQ0453 6 Last file sts r
C XBADKK PARM *BLANK WQ0454 1 REP - GL interf
C XBADKM PARM *BLANK WQ0455 1 IFM GLI interfa
C XBADKN PARM *BLANK WQ0456 1 IFM AP interfac
C XBADKP PARM *BLANK WQ0457 1 IFM AR interfac
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZARUPR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Move key fields to SYSCTL XMREPT format
C MOVELXBACVX YI0201 Loaded from fil
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI02
* Only search if key is not beyond range of current elements
C YL02 IFGT 0
C YK02,YL02 ANDGTYD02
* Set search index to first element of array
C Z-ADD1 Y 50
C YD02 LOKUPYK02,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK02,Y YD02
* Compare
C YI0201 IFEQ XBACVX
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO NYEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL02 ADD 1 Y 50
* Check if element was a previously deleted element
C YK02,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK02,Y YD02
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI02
C ENDIF
* Create(insert) new element
* Move key fields to SYSCTL XMREPT format
C MOVELXBACVX YI0201 Loaded from fil
C MOVELYD02 YK02,Y
C YI02 OCUR YM02
* Update MODS fields
C MOVELXBACVX WJACVX Loaded from fil
C MOVELXBZ80O WJZ80O SYSCTL key erro
C MOVELXBADHJ WJADHJ ACS Apply compl
C MOVELXBADHK WJADHK Initial install
C MOVELXBADHL WJADHL Installation co
C MOVELXBADHM WJADHM AP - IM interfa
C MOVELXBADHN WJADHN AR - AP interfa
C MOVELXBADHP WJADHP PUR - MRP inter
C MOVELXBADHQ WJADHQ PUR - IM interf
C MOVELXBADHR WJADHR MPSP - MRP inte
C MOVELXBADHS WJADHS COM - MPSP inte
C MOVELXBADHT WJADHT MRP - REP inter
C MOVELXBADHV WJADHV COM - REP inter
C MOVELXBADHW WJADHW PMC - REP inter
C MOVELXBADHY WJADHY MPA - COM inter
C MOVELXBADHZ WJADHZ MPA - PCC inter
C MOVELXBADH1 WJADH1 MPA - MRP inter
C MOVELXBADH2 WJADH2 PUR - GL interf
C MOVELXBADH3 WJADH3 PUR - PCC inter
C MOVELXBABW2 WJABW2 Work (alpha 1)
C MOVELXBADH4 WJADH4 Master file sav
C MOVELXBADH5 WJADH5 Current unresta
C MOVELXBADH6 WJADH6 Reuse data entr
C MOVELXBZ9AD WJZ9AD Multi-company i
C MOVELXBADH7 WJADH7 Fiscal period i
C MOVELXBADH8 WJADH8 Date format for
C MOVELXBADH9 WJADH9 Date validation
C MOVELXBADH0 WJADH0 COM - GL interf
C MOVELXBADJA WJADJA I/T checkpoint
C MOVELXBADJB WJADJB PR - GL interfa
C MOVELXBADJC WJADJC AP - GL interfa
C MOVELXBADJD WJADJD AR - GL interfa
C MOVELXBADJF WJADJF AP - PCC interf
C MOVELXBADJG WJADJG PR - PCC interf
C MOVELXBADJH WJADJH PMC - PR interf
C MOVELXBADJJ WJADJJ IM - PCC interf
C MOVELXBADJK WJADJK PMC - IM interf
C MOVELXBADJL WJADJL IM - SA interfa
C MOVELXBADJM WJADJM IM - COM interf
C MOVELXBADJN WJADJN IM - MRP interf
C MOVELXBADJP WJADJP IM - PDM interf
C MOVELXBADJQ WJADJQ PDM - PCC inter
C MOVELXBADJR WJADJR PDM - MRP inter
C MOVELXBADJS WJADJS PDM - COM inter
C MOVELXBADJT WJADJT COM - MRP inter
C MOVELXBADJV WJADJV COM - SA interf
C MOVELXBADJW WJADJW COM - AR interf
C MOVELXBADJY WJADJY AR - SA interfa
C MOVELXBADJZ WJADJZ PMC - PCC inter
C MOVELXBADJ1 WJADJ1 PCC - IM interf
C MOVELXBADJ2 WJADJ2 IM - GL interfa
C MOVELXBADJ3 WJADJ3 COM - IM interf
C MOVELXBADJ4 WJADJ4 MRP - IM interf
C MOVELXBADJ5 WJADJ5 PDM - IM interf
C MOVELXBADJ6 WJADJ6 MRP - PDM inter
C MOVELXBADJ7 WJADJ7 PCC - GL interf
C MOVELXBADJ8 WJADJ8 EDMI - PDM inte
C MOVELXBADJ9 WJADJ9 FCST - MRP inte
C MOVELXBADJ0 WJADJ0 FA - GL interfa
C MOVELXBADKA WJADKA Questionnaire h
C MOVELXBADKB WJADKB Yes response ch
C MOVELXBADKC WJADKC No response cha
C MOVELXBACV5 WJACV5 Work alpha (1)
C MOVELXBADKD WJADKD Mth periods def
C MOVELXBADKF WJADKF Weeks per perio
C MOVELXBADKG WJADKG Week beginning
C MOVELXBADKH WJADKH Last file sts r
C MOVELXBADKJ WJADKJ Last file sts r
C MOVELXBADKK WJADKK REP - GL interf
C MOVELXBADKM WJADKM IFM GLI interfa
C MOVELXBADKN WJADKN IFM AP interfac
C MOVELXBADKP WJADKP IFM AR interfac
* Only sort if element is out of position
C YL02 IFGT 0
C YK02,YL02 ANDGTYD02
* Adjust RTVOBJ index to reflect position of added/removed element
C YR02 IFGT 0
C YR02 ANDLE1
C YK02,YR02 ANDGTYD02
C ADD 1 YR02 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK02
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL02
* Move SYSCTL XMR fields back
C MOVELWJZ80O WUZ80O SYSCTL key erro
C MOVELWJADHJ WUADHJ ACS Apply compl
C MOVELWJADHK WUADHK Initial install
C MOVELWJADHL WUADHL Installation co
C MOVELWJADHM WUADHM AP - IM interfa
C MOVELWJADHN WUADHN AR - AP interfa
C MOVELWJADHP WUADHP PUR - MRP inter
C MOVELWJADHQ WUADHQ PUR - IM interf
C MOVELWJADHR WUADHR MPSP - MRP inte
C MOVELWJADHS WUADHS COM - MPSP inte
C MOVELWJADHT WUADHT MRP - REP inter
C MOVELWJADHV WUADHV COM - REP inter
C MOVELWJADHW WUADHW PMC - REP inter
C MOVELWJADHY WUADHY MPA - COM inter
C MOVELWJADHZ WUADHZ MPA - PCC inter
C MOVELWJADH1 WUADH1 MPA - MRP inter
C MOVELWJADH2 WUADH2 PUR - GL interf
C MOVELWJADH3 WUADH3 PUR - PCC inter
C MOVELWJABW2 WUABW2 Work (alpha 1)
C MOVELWJADH4 WUADH4 Master file sav
C MOVELWJADH5 WUADH5 Current unresta
C MOVELWJADH6 WUADH6 Reuse data entr
C MOVELWJZ9AD WUZ9AD Multi-company i
C MOVELWJADH7 WUADH7 Fiscal period i
C MOVELWJADH8 WUADH8 Date format for
C MOVELWJADH9 WUADH9 Date validation
C MOVELWJADH0 WUADH0 COM - GL interf
C MOVELWJADJA WUADJA I/T checkpoint
C MOVELWJADJB WUADJB PR - GL interfa
C MOVELWJADJC WUADJC AP - GL interfa
C MOVELWJADJD WUADJD AR - GL interfa
C MOVELWJADJF WUADJF AP - PCC interf
C MOVELWJADJG WUADJG PR - PCC interf
C MOVELWJADJH WUADJH PMC - PR interf
C MOVELWJADJJ WUADJJ IM - PCC interf
C MOVELWJADJK WUADJK PMC - IM interf
C MOVELWJADJL WUADJL IM - SA interfa
C MOVELWJADJM WUADJM IM - COM interf
C MOVELWJADJN WUADJN IM - MRP interf
C MOVELWJADJP WUADJP IM - PDM interf
C MOVELWJADJQ WUADJQ PDM - PCC inter
C MOVELWJADJR WUADJR PDM - MRP inter
C MOVELWJADJS WUADJS PDM - COM inter
C MOVELWJADJT WUADJT COM - MRP inter
C MOVELWJADJV WUADJV COM - SA interf
C MOVELWJADJW WUADJW COM - AR interf
C MOVELWJADJY WUADJY AR - SA interfa
C MOVELWJADJZ WUADJZ PMC - PCC inter
C MOVELWJADJ1 WUADJ1 PCC - IM interf
C MOVELWJADJ2 WUADJ2 IM - GL interfa
C MOVELWJADJ3 WUADJ3 COM - IM interf
C MOVELWJADJ4 WUADJ4 MRP - IM interf
C MOVELWJADJ5 WUADJ5 PDM - IM interf
C MOVELWJADJ6 WUADJ6 MRP - PDM inter
C MOVELWJADJ7 WUADJ7 PCC - GL interf
C MOVELWJADJ8 WUADJ8 EDMI - PDM inte
C MOVELWJADJ9 WUADJ9 FCST - MRP inte
C MOVELWJADJ0 WUADJ0 FA - GL interfa
C MOVELWJADKA WUADKA Questionnaire h
C MOVELWJADKB WUADKB Yes response ch
C MOVELWJADKC WUADKC No response cha
C MOVELWJACV5 WUACV5 Work alpha (1)
C MOVELWJADKD WUADKD Mth periods def
C MOVELWJADKF WUADKF Weeks per perio
C MOVELWJADKG WUADKG Week beginning
C MOVELWJADKH WUADKH Last file sts r
C MOVELWJADKJ WUADKJ Last file sts r
C MOVELWJADKK WUADKK REP - GL interf
C MOVELWJADKM WUADKM IFM GLI interfa
C MOVELWJADKN WUADKN IFM AP interfac
C MOVELWJADKP WUADKP IFM AR interfac
* USER: Processing after Data update
* PAR = DB1 By name
C MOVELXBZ80O WUZ80O SYSCTL key erro
C MOVELXBADHJ WUADHJ ACS Apply compl
C MOVELXBADHK WUADHK Initial install
C MOVELXBADHL WUADHL Installation co
C MOVELXBADHM WUADHM AP - IM interfa
C MOVELXBADHN WUADHN AR - AP interfa
C MOVELXBADHP WUADHP PUR - MRP inter
C MOVELXBADHQ WUADHQ PUR - IM interf
C MOVELXBADHR WUADHR MPSP - MRP inte
C MOVELXBADHS WUADHS COM - MPSP inte
C MOVELXBADHT WUADHT MRP - REP inter
C MOVELXBADHV WUADHV COM - REP inter
C MOVELXBADHW WUADHW PMC - REP inter
C MOVELXBADHY WUADHY MPA - COM inter
C MOVELXBADHZ WUADHZ MPA - PCC inter
C MOVELXBADH1 WUADH1 MPA - MRP inter
C MOVELXBADH2 WUADH2 PUR - GL interf
C MOVELXBADH3 WUADH3 PUR - PCC inter
C MOVELXBABW2 WUABW2 Work (alpha 1)
C MOVELXBADH4 WUADH4 Master file sav
C MOVELXBADH5 WUADH5 Current unresta
C MOVELXBADH6 WUADH6 Reuse data entr
C MOVELXBZ9AD WUZ9AD Multi-company i
C MOVELXBADH7 WUADH7 Fiscal period i
C MOVELXBADH8 WUADH8 Date format for
C MOVELXBADH9 WUADH9 Date validation
C MOVELXBADH0 WUADH0 COM - GL interf
C MOVELXBADJA WUADJA I/T checkpoint
C MOVELXBADJB WUADJB PR - GL interfa
C MOVELXBADJC WUADJC AP - GL interfa
C MOVELXBADJD WUADJD AR - GL interfa
C MOVELXBADJF WUADJF AP - PCC interf
C MOVELXBADJG WUADJG PR - PCC interf
C MOVELXBADJH WUADJH PMC - PR interf
C MOVELXBADJJ WUADJJ IM - PCC interf
C MOVELXBADJK WUADJK PMC - IM interf
C MOVELXBADJL WUADJL IM - SA interfa
C MOVELXBADJM WUADJM IM - COM interf
C MOVELXBADJN WUADJN IM - MRP interf
C MOVELXBADJP WUADJP IM - PDM interf
C MOVELXBADJQ WUADJQ PDM - PCC inter
C MOVELXBADJR WUADJR PDM - MRP inter
C MOVELXBADJS WUADJS PDM - COM inter
C MOVELXBADJT WUADJT COM - MRP inter
C MOVELXBADJV WUADJV COM - SA interf
C MOVELXBADJW WUADJW COM - AR interf
C MOVELXBADJY WUADJY AR - SA interfa
C MOVELXBADJZ WUADJZ PMC - PCC inter
C MOVELXBADJ1 WUADJ1 PCC - IM interf
C MOVELXBADJ2 WUADJ2 IM - GL interfa
C MOVELXBADJ3 WUADJ3 COM - IM interf
C MOVELXBADJ4 WUADJ4 MRP - IM interf
C MOVELXBADJ5 WUADJ5 PDM - IM interf
C MOVELXBADJ6 WUADJ6 MRP - PDM inter
C MOVELXBADJ7 WUADJ7 PCC - GL interf
C MOVELXBADJ8 WUADJ8 EDMI - PDM inte
C MOVELXBADJ9 WUADJ9 FCST - MRP inte
C MOVELXBADJ0 WUADJ0 FA - GL interfa
C MOVELXBADKA WUADKA Questionnaire h
C MOVELXBADKB WUADKB Yes response ch
C MOVELXBADKC WUADKC No response cha
C MOVELXBACV5 WUACV5 Work alpha (1)
C MOVELXBADKD WUADKD Mth periods def
C MOVELXBADKF WUADKF Weeks per perio
C MOVELXBADKG WUADKG Week beginning
C MOVELXBADKH WUADKH Last file sts r
C MOVELXBADKJ WUADKJ Last file sts r
C MOVELXBADKK WUADKK REP - GL interf
C MOVELXBADKM WUADKM IFM GLI interfa
C MOVELXBADKN WUADKN IFM AP interfac
C MOVELXBADKP WUADKP IFM AR interfac
*================================================================
CSR NYEXIT ENDSR
/EJECT
CSR NZDLRC BEGSR
*================================================================
* DLT:Historical Tax Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Initialize array variables
C MOVEA*HIVAL YK05
* Initialize last used element number
C Z-ADD0 YL05
*================================================================
CSR NZEXIT ENDSR
/EJECT
CSR OARVGN BEGSR
*================================================================
* RTV:Count Tax Grps - surc - Historical Tax *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD*ZERO WUAC0D &No of Tax grou
C MOVEL*BLANK WUACHG Tax group code
* Declare restrictor key work fields
C *LIKE DEFN WTAENB WQOA01 Company number
C *LIKE DEFN WTGGNB WQOA02 Invoice number
C *LIKE DEFN WTHYNB WQOA03 Invoice sequenc
* Define keylist
C KRSOA KLIST
C KFLD WQOA01 Company number
C KFLD WQOA02 Invoice number
C KFLD WQOA03 Invoice sequenc
* Setup key
C Z-ADDZRAENB WQOA01 Company number
C Z-ADDZRGGNB WQOA02 Invoice number
C Z-ADDZRHYNB WQOA03 Invoice sequenc
* Establish starting position
C KRSOA SETLLFGFCPYL *
C KRSOA READEFGFCPYL 90*
* Data record not found
C 90 MOVEL'AMB0812' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Tax group code NE WRK.Tax group code
C WTACHG IFNE WUACHG *IF
* RTV:Exist check / 1 surch - History Special Charge *
C EXSR OBRVGN
* If this tax is for this surcharge, count it.
* CASE: PGM.*Return code is *Record already exists
C W0RTN IFEQ 'Y2U0003' *IF
C ADD 1 WUAC0D &No of Tax grou
C MOVELWTACHG WUACHG Tax group code
C END *FI
C END *FI
C KRSOA READEFGFCPYL 90*
C ENDDO
*================================================================
CSR OAEXIT ENDSR
/EJECT
CSR OBRVGN BEGSR
*================================================================
* RTV:Exist check / 1 surch - History Special Charge *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Default this to no.
C MOVEL'Y2U0005' W0RTN *Return code
* Define keylist
C KRSOB KLIST
C KFLD WMAENB Company number
C KFLD WMGGNB Invoice number
C KFLD WMHYNB Invoice sequenc
C KFLD WMAAD2 Special charge
* Setup key
C Z-ADDWTAENB WMAENB Company number
C Z-ADDWTGGNB WMGGNB Invoice number
C Z-ADDWTHYNB WMHYNB Invoice sequenc
C Z-ADDWTAAD2 WMAAD2 Special charge
* Establish starting position
C KRSOB CHAINFF9CPYI 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0796' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO OBEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* See if this is the specific surcharge we are looking for.
* CASE: PAR.Surcharge detail code 1 EQ DB1.Surcharge detail code 1
C ZRAAD8 IFEQ WMAAD8 *IF
C MOVEL'Y2U0003' W0RTN *Return code
C GOTO OBEXIT *QUIT
C END *FI
C ENDIF
*================================================================
CSR OBEXIT ENDSR
/EJECT
CSR OCRVGN BEGSR
*================================================================
* RTV:Next Tax Grp - surch - Historical Tax *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WVAENB WQOC01 Company number
C *LIKE DEFN WVGGNB WQOC02 Invoice number
C *LIKE DEFN WVHYNB WQOC03 Invoice sequenc
* Define keylist
C KRSOC KLIST
C KFLD WQOC01 Company number
C KFLD WQOC02 Invoice number
C KFLD WQOC03 Invoice sequenc
* Setup key
C Z-ADDWRAENB WQOC01 Company number
C Z-ADDWRGGNB WQOC02 Invoice number
C Z-ADDWRHYNB WQOC03 Invoice sequenc
* Establish starting position
C KRSOC SETLLFGFCPPL *
C KRSOC READEFGFCPPL 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0812' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C Z-ADD*ZERO WUGYVA Tax amount
C MOVEL*BLANK WUACHH Tax invoice tex
C MOVEL*BLANK WUACHJ Inv lang tax in
C GOTO OCEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* Has this tax group been processed?
* RTV:Check for Tax Group - *Arrays *
C EXSR ODRVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* PAR = DB1 By name
C Z-ADDWVGYVA WUGYVA Tax amount
C MOVELWVACHH WUACHH Tax invoice tex
C MOVELWVACHJ WUACHJ Inv lang tax in
C MOVELWVACHG WUACHG Tax group code
* RTV:Bucket Taxes - surch - Historical Tax *
C EXSR OFRVGN
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO OCEXIT *QUIT
C END *FI
C KRSOC READEFGFCPPL 90*
C ENDDO
*================================================================
CSR OCEXIT ENDSR
/EJECT
CSR ODRVGN BEGSR
*================================================================
* RTV:Check for Tax Group - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL05 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK05,Y YD05
C YI05 OCUR YM05
* Initialize internal index
C MOVEL*LOVAL YD05
* Move key fields to Historical Tax
C MOVELWVACHG YI0501 Tax group code
* Only search if key is not beyond range of current elements
C YK05,YL05 IFGT YD05
C YD05 LOKUPYK05,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK05,Y YD05
* Compare
C YI0501 IFNE WVACHG
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
* CRT:Historical Tax - *Arrays *
C EXSR OECRRC
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO ODEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI05 OCUR YM05
* USER: Process Data record
C MOVEL'Y2U0003' W0RTN *Return code
C GOTO ODEXIT *QUIT
C ENDIF
*================================================================
CSR ODEXIT ENDSR
/EJECT
CSR OECRRC BEGSR
*================================================================
* CRT:Historical Tax - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL05 IFEQ 9999
C MOVEL'Y2U0036' W0RTN 7
C GOTO OEEXIT
C ENDIF
* Move all fields to Historical Tax
C MOVELWVACHG XEACHG Tax group code
* Move key fields to Historical Tax
C MOVELXEACHG YI0501 Tax group code
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI05
* Only search if key is not beyond range of current elements
C YL05 IFGT 0
C YK05,YL05 ANDGTYD05
* Set search index to first element of array
C Z-ADD1 Y 50
C YD05 LOKUPYK05,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK05,Y YD05
* Compare
C YI0501 IFEQ XEACHG
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO OEEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL05 ADD 1 Y 50
* Check if element was a previously deleted element
C YK05,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK05,Y YD05
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI05
C ENDIF
* Create(insert) new element
* Move key fields to Historical Tax
C MOVELXEACHG YI0501 Tax group code
C MOVELYD05 YK05,Y
C YI05 OCUR YM05
* Update MODS fields
C MOVELXEACHG WSACHG Tax group code
* Only sort if element is out of position
C YL05 IFGT 0
C YK05,YL05 ANDGTYD05
* Adjust RTVOBJ index to reflect position of added/removed element
C YR05 IFGT 0
C YR05 ANDLE9999
C YK05,YR05 ANDGTYD05
C ADD 1 YR05 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK05
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL05
*================================================================
CSR OEEXIT ENDSR
/EJECT
CSR OFRVGN BEGSR
*================================================================
* RTV:Bucket Taxes - surch - Historical Tax *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD*ZERO WUGYVA Tax amount
* Declare restrictor key work fields
C *LIKE DEFN WTAENB WQOF01 Company number
C *LIKE DEFN WTGGNB WQOF02 Invoice number
C *LIKE DEFN WTHYNB WQOF03 Invoice sequenc
* Define keylist
C KRSOF KLIST
C KFLD WQOF01 Company number
C KFLD WQOF02 Invoice number
C KFLD WQOF03 Invoice sequenc
* Setup key
C Z-ADDWVAENB WQOF01 Company number
C Z-ADDWVGGNB WQOF02 Invoice number
C Z-ADDWVHYNB WQOF03 Invoice sequenc
* Establish starting position
C KRSOF SETLLFGFCPYL *
C KRSOF READEFGFCPYL 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0812' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C Z-ADD*ZERO WUGYVA Tax amount
C GOTO OFEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Tax group code EQ WRK.Tax group code
C WTACHG IFEQ WUACHG *IF
* RTV:Exist check / 1 surch - History Special Charge *
C EXSR OGRVGN
* Make sure it is for this surcharge.
* CASE: PGM.*Return code is *Record already exists
C W0RTN IFEQ 'Y2U0003' *IF
* Do not total tax if: Tax in price, EC memo tax, or not invoiced.
* CASE:
* - c1 OR c2 OR c3 OR c4 OR c5
* |- c1 : DB1.Tax in price - Europe is Yes
* |- c2 : DB1.Tax in price - Brazil is Yes
* |- c3 : DB1.EC memo tax flag is Yes
* |- c4 : DB1.Tax is invoiced flag is No
* |- c5 : DB1.Use tax flag is Yes
* '-
C WTZ9T3 IFEQ '1' *IF
C WTZ9T4 OREQ '1' *OR
C WTZ9T0 OREQ '1' *OR
C WTZ9VK OREQ '0' *OR
C WTZ9T9 OREQ '1' *OR
C ELSE
* CASE: *OTHERWISE
C ADD WTGYVA WUGYVA Tax amount
C END *FI
C END *FI
C END *FI
C KRSOF READEFGFCPYL 90*
C ENDDO
* USER: Exit processing
C Z-ADDWUGYVA WUGYVA Tax amount
*================================================================
CSR OFEXIT ENDSR
/EJECT
CSR OGRVGN BEGSR
*================================================================
* RTV:Exist check / 1 surch - History Special Charge *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Default this to no.
C MOVEL'Y2U0005' W0RTN *Return code
* Define keylist
C KRSOG KLIST
C KFLD WMAENB Company number
C KFLD WMGGNB Invoice number
C KFLD WMHYNB Invoice sequenc
C KFLD WMAAD2 Special charge
* Setup key
C Z-ADDWTAENB WMAENB Company number
C Z-ADDWTGGNB WMGGNB Invoice number
C Z-ADDWTHYNB WMHYNB Invoice sequenc
C Z-ADDWTAAD2 WMAAD2 Special charge
* Establish starting position
C KRSOG CHAINFF9CPYI 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0796' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO OGEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* See if this is the specific surcharge we are looking for.
* CASE: PAR.Surcharge detail code 1 EQ DB1.Surcharge detail code 1
C ZRAAD8 IFEQ WMAAD8 *IF
C MOVEL'Y2U0003' W0RTN *Return code
C GOTO OGEXIT *QUIT
C END *FI
C ENDIF
*================================================================
CSR OGEXIT ENDSR
/EJECT
CSR OHRVGN BEGSR
*================================================================
* RTV:Next Special Charge - History Special Charge *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WMAENB WQOH01 Company number
C *LIKE DEFN WMGGNB WQOH02 Invoice number
C *LIKE DEFN WMHYNB WQOH03 Invoice sequenc
* Define keylist
C KRSOH KLIST
C KFLD WQOH01 Company number
C KFLD WQOH02 Invoice number
C KFLD WQOH03 Invoice sequenc
* Setup key
C Z-ADDF9AENB WQOH01 Company number
C Z-ADDF9GGNB WQOH02 Invoice number
C Z-ADDF9HYNB WQOH03 Invoice sequenc
* Establish starting position
C KRSOH SETLLFF9CPYI *
C KRSOH READEFF9CPYI 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0796' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C Z-ADD*ZERO WUAAD2 Special charge
C MOVEL*BLANK WUBLST Special charge
C MOVEL*BLANK WUBXTX Special charge
C MOVEL*BLANK WUAA73 Foreign descrip
C Z-ADD*ZERO WUDDVA Special charge
C MOVEL*BLANK WUAAD7 Surcharge code
C MOVEL*BLANK WUAAD8 Surcharge detai
C Z-ADD*ZERO WUZ9QF Tax include Spe
C GOTO OHEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Special charge code is Blank
C WMBLST IFEQ *BLANK *IF
C ELSE
* CASE: *OTHERWISE
* Only process special charges
* Has this special charge been processed?
* RTV:Check for Spc Charge - *Arrays *
C EXSR OIRVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* PAR = DB1 By name
C Z-ADDWMAAD2 WUAAD2 Special charge
C MOVELWMBLST WUBLST Special charge
C MOVELWMBXTX WUBXTX Special charge
C MOVELWMAA73 WUAA73 Foreign descrip
C Z-ADDWMDDVA WUDDVA Special charge
C MOVELWMAAD7 WUAAD7 Surcharge code
C MOVELWMAAD8 WUAAD8 Surcharge detai
C Z-ADDWMZ9QF WUZ9QF Tax include Spe
C GOTO OHEXIT *QUIT
C END *FI
C END *FI
C KRSOH READEFF9CPYI 90*
C ENDDO
*================================================================
CSR OHEXIT ENDSR
/EJECT
CSR OIRVGN BEGSR
*================================================================
* RTV:Check for Spc Charge - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL03 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK03,Y YD03
C YI03 OCUR YM03
* Initialize internal index
C MOVEL*LOVAL YD03
* Move key fields to History Special Charge 2
C Z-ADDWMAAD2 YI0301 Special charge
* Only search if key is not beyond range of current elements
C YK03,YL03 IFGT YD03
C YD03 LOKUPYK03,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK03,Y YD03
* Compare
C YI0301 IFNE WMAAD2
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
* CRT:Hist Special Charge 2 - *Arrays *
C EXSR OJCRRC
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO OIEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI03 OCUR YM03
* USER: Process Data record
C MOVEL'Y2U0003' W0RTN *Return code
C GOTO OIEXIT *QUIT
C ENDIF
*================================================================
CSR OIEXIT ENDSR
/EJECT
CSR OJCRRC BEGSR
*================================================================
* CRT:Hist Special Charge 2 - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL03 IFEQ 9999
C MOVEL'Y2U0036' W0RTN 7
C GOTO OJEXIT
C ENDIF
* Move all fields to History Special Charge 2
C Z-ADDWMAAD2 XCAAD2 Special charge
* Move key fields to History Special Charge 2
C Z-ADDXCAAD2 YI0301 Special charge
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI03
* Only search if key is not beyond range of current elements
C YL03 IFGT 0
C YK03,YL03 ANDGTYD03
* Set search index to first element of array
C Z-ADD1 Y 50
C YD03 LOKUPYK03,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK03,Y YD03
* Compare
C YI0301 IFEQ XCAAD2
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO OJEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL03 ADD 1 Y 50
* Check if element was a previously deleted element
C YK03,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK03,Y YD03
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI03
C ENDIF
* Create(insert) new element
* Move key fields to History Special Charge 2
C Z-ADDXCAAD2 YI0301 Special charge
C MOVELYD03 YK03,Y
C YI03 OCUR YM03
* Update MODS fields
C Z-ADDXCAAD2 WKAAD2 Special charge
* Only sort if element is out of position
C YL03 IFGT 0
C YK03,YL03 ANDGTYD03
* Adjust RTVOBJ index to reflect position of added/removed element
C YR03 IFGT 0
C YR03 ANDLE9999
C YK03,YR03 ANDGTYD03
C ADD 1 YR03 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK03
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL03
*================================================================
CSR OJEXIT ENDSR
/EJECT
CSR OKRVGN BEGSR
*================================================================
* RTV:Next Bucket Surcharge - History Special Charge *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WMAENB WQOK01 Company number
C *LIKE DEFN WMGGNB WQOK02 Invoice number
C *LIKE DEFN WMHYNB WQOK03 Invoice sequenc
* Define keylist
C KRSOK KLIST
C KFLD WQOK01 Company number
C KFLD WQOK02 Invoice number
C KFLD WQOK03 Invoice sequenc
* Setup key
C Z-ADDF9AENB WQOK01 Company number
C Z-ADDF9GGNB WQOK02 Invoice number
C Z-ADDF9HYNB WQOK03 Invoice sequenc
* Establish starting position
C KRSOK SETLLFF9CPYI *
C KRSOK READEFF9CPYI 90*
* Data record not found
C 90 MOVEL'AMB0796' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Special charge code is Blank
C WMBLST IFEQ *BLANK *IF
* Only process surcharges
* RTV:Chk for Surcharge - *Arrays *
C EXSR OLRVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* PAR = DB1 By name
C Z-ADDWMAAD2 WUAAD2 Special charge
C MOVELWMBLST WUBLST Special charge
C MOVELWMBXTX WUBXTX Special charge
C MOVELWMAA73 WUAA73 Foreign descrip
C Z-ADDWMDDVA WUDDVA Special charge
C MOVELWMAAD7 WUAAD7 Surcharge code
C MOVELWMAAD8 WUAAD8 Surcharge detai
C Z-ADDWMZ9QF WUZ9QF Tax include Spe
C MOVELWMAAD8 WUAAD8 Surcharge detai
* RTV:Bucket Surcharges - History Special Charge *
C EXSR ONRVGN
C GOTO OKEXIT *QUIT
C END *FI
C MOVEL'Y2U0003' W0RTN *Return code
C END *FI
C KRSOK READEFF9CPYI 90*
C ENDDO
*================================================================
CSR OKEXIT ENDSR
/EJECT
CSR OLRVGN BEGSR
*================================================================
* RTV:Chk for Surcharge - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL04 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK04,Y YD04
C YI04 OCUR YM04
* Initialize internal index
C MOVEL*LOVAL YD04
* Move key fields to History Special Charge
C MOVELWMAAD8 YI0401 Surcharge detai
* Only search if key is not beyond range of current elements
C YK04,YL04 IFGT YD04
C YD04 LOKUPYK04,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK04,Y YD04
* Compare
C YI0401 IFNE WMAAD8
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
* CRT:History Special Chg - *Arrays *
C EXSR OMCRRC
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO OLEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI04 OCUR YM04
* USER: Process Data record
C MOVEL'Y2U0003' W0RTN *Return code
C ENDIF
*================================================================
CSR OLEXIT ENDSR
/EJECT
CSR OMCRRC BEGSR
*================================================================
* CRT:History Special Chg - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL04 IFEQ 9999
C MOVEL'Y2U0036' W0RTN 7
C GOTO OMEXIT
C ENDIF
* Move all fields to History Special Charge
C MOVELWMAAD8 XDAAD8 Surcharge detai
* Move key fields to History Special Charge
C MOVELXDAAD8 YI0401 Surcharge detai
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI04
* Only search if key is not beyond range of current elements
C YL04 IFGT 0
C YK04,YL04 ANDGTYD04
* Set search index to first element of array
C Z-ADD1 Y 50
C YD04 LOKUPYK04,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK04,Y YD04
* Compare
C YI0401 IFEQ XDAAD8
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO OMEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL04 ADD 1 Y 50
* Check if element was a previously deleted element
C YK04,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK04,Y YD04
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI04
C ENDIF
* Create(insert) new element
* Move key fields to History Special Charge
C MOVELXDAAD8 YI0401 Surcharge detai
C MOVELYD04 YK04,Y
C YI04 OCUR YM04
* Update MODS fields
C MOVELXDAAD8 WLAAD8 Surcharge detai
* Only sort if element is out of position
C YL04 IFGT 0
C YK04,YL04 ANDGTYD04
* Adjust RTVOBJ index to reflect position of added/removed element
C YR04 IFGT 0
C YR04 ANDLE9999
C YK04,YR04 ANDGTYD04
C ADD 1 YR04 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK04
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL04
*================================================================
CSR OMEXIT ENDSR
/EJECT
CSR ONRVGN BEGSR
*================================================================
* RTV:Bucket Surcharges - History Special Charge *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD*ZERO WUDDVA Special charge
C Z-ADD*ZERO WUZ9QF Tax include Spe
* Declare restrictor key work fields
C *LIKE DEFN WMAENB WQON01 Company number
C *LIKE DEFN WMGGNB WQON02 Invoice number
C *LIKE DEFN WMHYNB WQON03 Invoice sequenc
* Define keylist
C KRSON KLIST
C KFLD WQON01 Company number
C KFLD WQON02 Invoice number
C KFLD WQON03 Invoice sequenc
* Setup key
C Z-ADDWMAENB WQON01 Company number
C Z-ADDWMGGNB WQON02 Invoice number
C Z-ADDWMHYNB WQON03 Invoice sequenc
* Establish starting position
C KRSON SETLLFF9CPYI *
C KRSON READEFF9CPYI 90*
* Data record not found
C 90 MOVEL'AMB0796' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Surcharge detail code 1 EQ PAR.Surcharge detail code 1
C WMAAD8 IFEQ WUAAD8 *IF
C ADD WMDDVA WUDDVA Special charge
C ADD WMZ9QF WUZ9QF Tax include Spe
C END *FI
C KRSON READEFF9CPYI 90*
C ENDDO
*================================================================
CSR ONEXIT ENDSR
/EJECT
CSR OORVGN BEGSR
*================================================================
* RTV:SYSCTL XMREPT Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL02 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK02,Y YD02
C YI02 OCUR YM02
* Initialize internal index
C MOVEL*LOVAL YD02
* Move key fields to SYSCTL XMREPT format
C MOVEL'1' YI0201 Loaded from fil
* Only search if key is not beyond range of current elements
C YK02,YL02 IFGT YD02
C YD02 LOKUPYK02,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK02,Y YD02
* Compare
C YI0201 IFNE '1'
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO OOEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI02 OCUR YM02
* USER: Process Data record
* PAR = DB1 By name
C MOVELWJZ80O WUZ80O SYSCTL key erro
C MOVELWJADHJ WUADHJ ACS Apply compl
C MOVELWJADHK WUADHK Initial install
C MOVELWJADHL WUADHL Installation co
C MOVELWJADHM WUADHM AP - IM interfa
C MOVELWJADHN WUADHN AR - AP interfa
C MOVELWJADHP WUADHP PUR - MRP inter
C MOVELWJADHQ WUADHQ PUR - IM interf
C MOVELWJADHR WUADHR MPSP - MRP inte
C MOVELWJADHS WUADHS COM - MPSP inte
C MOVELWJADHT WUADHT MRP - REP inter
C MOVELWJADHV WUADHV COM - REP inter
C MOVELWJADHW WUADHW PMC - REP inter
C MOVELWJADHY WUADHY MPA - COM inter
C MOVELWJADHZ WUADHZ MPA - PCC inter
C MOVELWJADH1 WUADH1 MPA - MRP inter
C MOVELWJADH2 WUADH2 PUR - GL interf
C MOVELWJADH3 WUADH3 PUR - PCC inter
C MOVELWJABW2 WUABW2 Work (alpha 1)
C MOVELWJADH4 WUADH4 Master file sav
C MOVELWJADH5 WUADH5 Current unresta
C MOVELWJADH6 WUADH6 Reuse data entr
C MOVELWJZ9AD WUZ9AD Multi-company i
C MOVELWJADH7 WUADH7 Fiscal period i
C MOVELWJADH8 WUADH8 Date format for
C MOVELWJADH9 WUADH9 Date validation
C MOVELWJADH0 WUADH0 COM - GL interf
C MOVELWJADJA WUADJA I/T checkpoint
C MOVELWJADJB WUADJB PR - GL interfa
C MOVELWJADJC WUADJC AP - GL interfa
C MOVELWJADJD WUADJD AR - GL interfa
C MOVELWJADJF WUADJF AP - PCC interf
C MOVELWJADJG WUADJG PR - PCC interf
C MOVELWJADJH WUADJH PMC - PR interf
C MOVELWJADJJ WUADJJ IM - PCC interf
C MOVELWJADJK WUADJK PMC - IM interf
C MOVELWJADJL WUADJL IM - SA interfa
C MOVELWJADJM WUADJM IM - COM interf
C MOVELWJADJN WUADJN IM - MRP interf
C MOVELWJADJP WUADJP IM - PDM interf
C MOVELWJADJQ WUADJQ PDM - PCC inter
C MOVELWJADJR WUADJR PDM - MRP inter
C MOVELWJADJS WUADJS PDM - COM inter
C MOVELWJADJT WUADJT COM - MRP inter
C MOVELWJADJV WUADJV COM - SA interf
C MOVELWJADJW WUADJW COM - AR interf
C MOVELWJADJY WUADJY AR - SA interfa
C MOVELWJADJZ WUADJZ PMC - PCC inter
C MOVELWJADJ1 WUADJ1 PCC - IM interf
C MOVELWJADJ2 WUADJ2 IM - GL interfa
C MOVELWJADJ3 WUADJ3 COM - IM interf
C MOVELWJADJ4 WUADJ4 MRP - IM interf
C MOVELWJADJ5 WUADJ5 PDM - IM interf
C MOVELWJADJ6 WUADJ6 MRP - PDM inter
C MOVELWJADJ7 WUADJ7 PCC - GL interf
C MOVELWJADJ8 WUADJ8 EDMI - PDM inte
C MOVELWJADJ9 WUADJ9 FCST - MRP inte
C MOVELWJADJ0 WUADJ0 FA - GL interfa
C MOVELWJADKA WUADKA Questionnaire h
C MOVELWJADKB WUADKB Yes response ch
C MOVELWJADKC WUADKC No response cha
C MOVELWJACV5 WUACV5 Work alpha (1)
C MOVELWJADKD WUADKD Mth periods def
C MOVELWJADKF WUADKF Weeks per perio
C MOVELWJADKG WUADKG Week beginning
C MOVELWJADKH WUADKH Last file sts r
C MOVELWJADKJ WUADKJ Last file sts r
C MOVELWJADKK WUADKK REP - GL interf
C MOVELWJADKM WUADKM IFM GLI interfa
C MOVELWJADKN WUADKN IFM AP interfac
C MOVELWJADKP WUADKP IFM AR interfac
C ENDIF
*================================================================
CSR OOEXIT ENDSR
/EJECT
CSR OPCRRC BEGSR
*================================================================
* Load SYSCTL XMREPT Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL02 IFEQ 1
C MOVEL'Y2U0036' W0RTN 7
C GOTO OPEXIT
C ENDIF
C MOVEL*BLANK XBACVX Loaded from fil
C MOVEL*BLANK XBZ80O SYSCTL key erro
C MOVEL*BLANK XBADHJ ACS Apply compl
C MOVEL*BLANK XBADHK Initial install
C MOVEL*BLANK XBADHL Installation co
C MOVEL*BLANK XBADHM AP - IM interfa
C MOVEL*BLANK XBADHN AR - AP interfa
C MOVEL*BLANK XBADHP PUR - MRP inter
C MOVEL*BLANK XBADHQ PUR - IM interf
C MOVEL*BLANK XBADHR MPSP - MRP inte
C MOVEL*BLANK XBADHS COM - MPSP inte
C MOVEL*BLANK XBADHT MRP - REP inter
C MOVEL*BLANK XBADHV COM - REP inter
C MOVEL*BLANK XBADHW PMC - REP inter
C MOVEL*BLANK XBADHY MPA - COM inter
C MOVEL*BLANK XBADHZ MPA - PCC inter
C MOVEL*BLANK XBADH1 MPA - MRP inter
C MOVEL*BLANK XBADH2 PUR - GL interf
C MOVEL*BLANK XBADH3 PUR - PCC inter
C MOVEL*BLANK XBABW2 Work (alpha 1)
C MOVEL*BLANK XBADH4 Master file sav
C MOVEL*BLANK XBADH5 Current unresta
C MOVEL*BLANK XBADH6 Reuse data entr
C MOVEL*BLANK XBZ9AD Multi-company i
C MOVEL*BLANK XBADH7 Fiscal period i
C MOVEL*BLANK XBADH8 Date format for
C MOVEL*BLANK XBADH9 Date validation
C MOVEL*BLANK XBADH0 COM - GL interf
C MOVEL*BLANK XBADJA I/T checkpoint
C MOVEL*BLANK XBADJB PR - GL interfa
C MOVEL*BLANK XBADJC AP - GL interfa
C MOVEL*BLANK XBADJD AR - GL interfa
C MOVEL*BLANK XBADJF AP - PCC interf
C MOVEL*BLANK XBADJG PR - PCC interf
C MOVEL*BLANK XBADJH PMC - PR interf
C MOVEL*BLANK XBADJJ IM - PCC interf
C MOVEL*BLANK XBADJK PMC - IM interf
C MOVEL*BLANK XBADJL IM - SA interfa
C MOVEL*BLANK XBADJM IM - COM interf
C MOVEL*BLANK XBADJN IM - MRP interf
C MOVEL*BLANK XBADJP IM - PDM interf
C MOVEL*BLANK XBADJQ PDM - PCC inter
C MOVEL*BLANK XBADJR PDM - MRP inter
C MOVEL*BLANK XBADJS PDM - COM inter
C MOVEL*BLANK XBADJT COM - MRP inter
C MOVEL*BLANK XBADJV COM - SA interf
C MOVEL*BLANK XBADJW COM - AR interf
C MOVEL*BLANK XBADJY AR - SA interfa
C MOVEL*BLANK XBADJZ PMC - PCC inter
C MOVEL*BLANK XBADJ1 PCC - IM interf
C MOVEL*BLANK XBADJ2 IM - GL interfa
C MOVEL*BLANK XBADJ3 COM - IM interf
C MOVEL*BLANK XBADJ4 MRP - IM interf
C MOVEL*BLANK XBADJ5 PDM - IM interf
C MOVEL*BLANK XBADJ6 MRP - PDM inter
C MOVEL*BLANK XBADJ7 PCC - GL interf
C MOVEL*BLANK XBADJ8 EDMI - PDM inte
C MOVEL*BLANK XBADJ9 FCST - MRP inte
C MOVEL*BLANK XBADJ0 FA - GL interfa
C MOVEL*BLANK XBADKA Questionnaire h
C MOVEL*BLANK XBADKB Yes response ch
C MOVEL*BLANK XBADKC No response cha
C MOVEL*BLANK XBACV5 Work alpha (1)
C MOVEL*BLANK XBADKD Mth periods def
C MOVEL*BLANK XBADKF Weeks per perio
C MOVEL*BLANK XBADKG Week beginning
C MOVEL*BLANK XBADKH Last file sts r
C MOVEL*BLANK XBADKJ Last file sts r
C MOVEL*BLANK XBADKK REP - GL interf
C MOVEL*BLANK XBADKM IFM GLI interfa
C MOVEL*BLANK XBADKN IFM AP interfac
C MOVEL*BLANK XBADKP IFM AR interfac
* Move all fields to SYSCTL XMREPT format
C MOVEL'1' XBACVX Loaded from fil
C MOVEL*BLANK XBZ80O SYSCTL key erro
C MOVEL*BLANK XBADHJ ACS Apply compl
C MOVEL*BLANK XBADHK Initial install
C MOVEL*BLANK XBADHL Installation co
C MOVEL*BLANK XBADHM AP - IM interfa
C MOVEL*BLANK XBADHN AR - AP interfa
C MOVEL*BLANK XBADHP PUR - MRP inter
C MOVEL*BLANK XBADHQ PUR - IM interf
C MOVEL*BLANK XBADHR MPSP - MRP inte
C MOVEL*BLANK XBADHS COM - MPSP inte
C MOVEL*BLANK XBADHT MRP - REP inter
C MOVEL*BLANK XBADHV COM - REP inter
C MOVEL*BLANK XBADHW PMC - REP inter
C MOVEL*BLANK XBADHY MPA - COM inter
C MOVEL*BLANK XBADHZ MPA - PCC inter
C MOVEL*BLANK XBADH1 MPA - MRP inter
C MOVEL*BLANK XBADH2 PUR - GL interf
C MOVEL*BLANK XBADH3 PUR - PCC inter
C MOVEL*BLANK XBABW2 Work (alpha 1)
C MOVEL*BLANK XBADH4 Master file sav
C MOVEL*BLANK XBADH5 Current unresta
C MOVEL*BLANK XBADH6 Reuse data entr
C MOVEL*BLANK XBZ9AD Multi-company i
C MOVEL*BLANK XBADH7 Fiscal period i
C MOVEL*BLANK XBADH8 Date format for
C MOVEL*BLANK XBADH9 Date validation
C MOVEL*BLANK XBADH0 COM - GL interf
C MOVEL*BLANK XBADJA I/T checkpoint
C MOVEL*BLANK XBADJB PR - GL interfa
C MOVEL*BLANK XBADJC AP - GL interfa
C MOVEL*BLANK XBADJD AR - GL interfa
C MOVEL*BLANK XBADJF AP - PCC interf
C MOVEL*BLANK XBADJG PR - PCC interf
C MOVEL*BLANK XBADJH PMC - PR interf
C MOVEL*BLANK XBADJJ IM - PCC interf
C MOVEL*BLANK XBADJK PMC - IM interf
C MOVEL*BLANK XBADJL IM - SA interfa
C MOVEL*BLANK XBADJM IM - COM interf
C MOVEL*BLANK XBADJN IM - MRP interf
C MOVEL*BLANK XBADJP IM - PDM interf
C MOVEL*BLANK XBADJQ PDM - PCC inter
C MOVEL*BLANK XBADJR PDM - MRP inter
C MOVEL*BLANK XBADJS PDM - COM inter
C MOVEL*BLANK XBADJT COM - MRP inter
C MOVEL*BLANK XBADJV COM - SA interf
C MOVEL*BLANK XBADJW COM - AR interf
C MOVEL*BLANK XBADJY AR - SA interfa
C MOVEL*BLANK XBADJZ PMC - PCC inter
C MOVEL*BLANK XBADJ1 PCC - IM interf
C MOVEL*BLANK XBADJ2 IM - GL interfa
C MOVEL*BLANK XBADJ3 COM - IM interf
C MOVEL*BLANK XBADJ4 MRP - IM interf
C MOVEL*BLANK XBADJ5 PDM - IM interf
C MOVEL*BLANK XBADJ6 MRP - PDM inter
C MOVEL*BLANK XBADJ7 PCC - GL interf
C MOVEL*BLANK XBADJ8 EDMI - PDM inte
C MOVEL*BLANK XBADJ9 FCST - MRP inte
C MOVEL*BLANK XBADJ0 FA - GL interfa
C MOVEL*BLANK XBADKA Questionnaire h
C MOVEL*BLANK XBADKB Yes response ch
C MOVEL*BLANK XBADKC No response cha
C MOVEL*BLANK XBACV5 Work alpha (1)
C MOVEL*BLANK XBADKD Mth periods def
C MOVEL*BLANK XBADKF Weeks per perio
C MOVEL*BLANK XBADKG Week beginning
C MOVEL*BLANK XBADKH Last file sts r
C MOVEL*BLANK XBADKJ Last file sts r
C MOVEL*BLANK XBADKK REP - GL interf
C MOVEL*BLANK XBADKM IFM GLI interfa
C MOVEL*BLANK XBADKN IFM AP interfac
C MOVEL*BLANK XBADKP IFM AR interfac
* USER: Processing before Data update
* RTV:SYSCTL XMREPT format - SYSCTL API non-OEI rcds *
C CALL 'AMZARUPR' 90 RTV:SYSCTL XMRE
C PARM XBZ80O WQ0463 6 SYSCTL key erro
C PARM W0RTN WQ0464 7 *Return code
C XBADHJ PARM *BLANK WQ0465 1 ACS Apply compl
C XBADHK PARM *BLANK WQ0466 1 Initial install
C XBADHL PARM *BLANK WQ0467 1 Installation co
C XBADHM PARM *BLANK WQ0468 1 AP - IM interfa
C XBADHN PARM *BLANK WQ0469 1 AR - AP interfa
C XBADHP PARM *BLANK WQ0470 1 PUR - MRP inter
C XBADHQ PARM *BLANK WQ0471 1 PUR - IM interf
C XBADHR PARM *BLANK WQ0472 1 MPSP - MRP inte
C XBADHS PARM *BLANK WQ0473 1 COM - MPSP inte
C XBADHT PARM *BLANK WQ0474 1 MRP - REP inter
C XBADHV PARM *BLANK WQ0475 1 COM - REP inter
C XBADHW PARM *BLANK WQ0476 1 PMC - REP inter
C XBADHY PARM *BLANK WQ0477 1 MPA - COM inter
C XBADHZ PARM *BLANK WQ0478 1 MPA - PCC inter
C XBADH1 PARM *BLANK WQ0479 1 MPA - MRP inter
C XBADH2 PARM *BLANK WQ0480 1 PUR - GL interf
C XBADH3 PARM *BLANK WQ0481 1 PUR - PCC inter
C XBABW2 PARM *BLANK WQ0482 1 Work (alpha 1)
C XBADH4 PARM *BLANK WQ0483 1 Master file sav
C XBADH5 PARM *BLANK WQ0484 3 Current unresta
C XBADH6 PARM *BLANK WQ0485 1 Reuse data entr
C XBZ9AD PARM *BLANK WQ0486 1 Multi-company i
C XBADH7 PARM *BLANK WQ0487 1 Fiscal period i
C XBADH8 PARM *BLANK WQ0488 1 Date format for
C XBADH9 PARM *BLANK WQ0489 1 Date validation
C XBADH0 PARM *BLANK WQ0490 1 COM - GL interf
C XBADJA PARM *BLANK WQ0491 3 I/T checkpoint
C XBADJB PARM *BLANK WQ0492 1 PR - GL interfa
C XBADJC PARM *BLANK WQ0493 1 AP - GL interfa
C XBADJD PARM *BLANK WQ0494 1 AR - GL interfa
C XBADJF PARM *BLANK WQ0495 1 AP - PCC interf
C XBADJG PARM *BLANK WQ0496 1 PR - PCC interf
C XBADJH PARM *BLANK WQ0497 1 PMC - PR interf
C XBADJJ PARM *BLANK WQ0498 1 IM - PCC interf
C XBADJK PARM *BLANK WQ0499 1 PMC - IM interf
C XBADJL PARM *BLANK WQ0500 1 IM - SA interfa
C XBADJM PARM *BLANK WQ0501 1 IM - COM interf
C XBADJN PARM *BLANK WQ0502 1 IM - MRP interf
C XBADJP PARM *BLANK WQ0503 1 IM - PDM interf
C XBADJQ PARM *BLANK WQ0504 1 PDM - PCC inter
C XBADJR PARM *BLANK WQ0505 1 PDM - MRP inter
C XBADJS PARM *BLANK WQ0506 1 PDM - COM inter
C XBADJT PARM *BLANK WQ0507 1 COM - MRP inter
C XBADJV PARM *BLANK WQ0508 1 COM - SA interf
C XBADJW PARM *BLANK WQ0509 1 COM - AR interf
C XBADJY PARM *BLANK WQ0510 1 AR - SA interfa
C XBADJZ PARM *BLANK WQ0511 1 PMC - PCC inter
C XBADJ1 PARM *BLANK WQ0512 1 PCC - IM interf
C XBADJ2 PARM *BLANK WQ0513 1 IM - GL interfa
C XBADJ3 PARM *BLANK WQ0514 1 COM - IM interf
C XBADJ4 PARM *BLANK WQ0515 1 MRP - IM interf
C XBADJ5 PARM *BLANK WQ0516 1 PDM - IM interf
C XBADJ6 PARM *BLANK WQ0517 1 MRP - PDM inter
C XBADJ7 PARM *BLANK WQ0518 1 PCC - GL interf
C XBADJ8 PARM *BLANK WQ0519 1 EDMI - PDM inte
C XBADJ9 PARM *BLANK WQ0520 1 FCST - MRP inte
C XBADJ0 PARM *BLANK WQ0521 1 FA - GL interfa
C XBADKA PARM *BLANK WQ0522 1 Questionnaire h
C XBADKB PARM *BLANK WQ0523 1 Yes response ch
C XBADKC PARM *BLANK WQ0524 1 No response cha
C XBACV5 PARM *BLANK WQ0525 1 Work alpha (1)
C XBADKD PARM *BLANK WQ0526 1 Mth periods def
C XBADKF PARM *BLANK WQ0527 12 Weeks per perio
C XBADKG PARM *BLANK WQ0528 1 Week beginning
C XBADKH PARM *BLANK WQ0529 6 Last file sts r
C XBADKJ PARM *BLANK WQ0530 6 Last file sts r
C XBADKK PARM *BLANK WQ0531 1 REP - GL interf
C XBADKM PARM *BLANK WQ0532 1 IFM GLI interfa
C XBADKN PARM *BLANK WQ0533 1 IFM AP interfac
C XBADKP PARM *BLANK WQ0534 1 IFM AR interfac
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZARUPR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Move key fields to SYSCTL XMREPT format
C MOVELXBACVX YI0201 Loaded from fil
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI02
* Only search if key is not beyond range of current elements
C YL02 IFGT 0
C YK02,YL02 ANDGTYD02
* Set search index to first element of array
C Z-ADD1 Y 50
C YD02 LOKUPYK02,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK02,Y YD02
* Compare
C YI0201 IFEQ XBACVX
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO OPEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL02 ADD 1 Y 50
* Check if element was a previously deleted element
C YK02,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK02,Y YD02
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI02
C ENDIF
* Create(insert) new element
* Move key fields to SYSCTL XMREPT format
C MOVELXBACVX YI0201 Loaded from fil
C MOVELYD02 YK02,Y
C YI02 OCUR YM02
* Update MODS fields
C MOVELXBACVX WJACVX Loaded from fil
C MOVELXBZ80O WJZ80O SYSCTL key erro
C MOVELXBADHJ WJADHJ ACS Apply compl
C MOVELXBADHK WJADHK Initial install
C MOVELXBADHL WJADHL Installation co
C MOVELXBADHM WJADHM AP - IM interfa
C MOVELXBADHN WJADHN AR - AP interfa
C MOVELXBADHP WJADHP PUR - MRP inter
C MOVELXBADHQ WJADHQ PUR - IM interf
C MOVELXBADHR WJADHR MPSP - MRP inte
C MOVELXBADHS WJADHS COM - MPSP inte
C MOVELXBADHT WJADHT MRP - REP inter
C MOVELXBADHV WJADHV COM - REP inter
C MOVELXBADHW WJADHW PMC - REP inter
C MOVELXBADHY WJADHY MPA - COM inter
C MOVELXBADHZ WJADHZ MPA - PCC inter
C MOVELXBADH1 WJADH1 MPA - MRP inter
C MOVELXBADH2 WJADH2 PUR - GL interf
C MOVELXBADH3 WJADH3 PUR - PCC inter
C MOVELXBABW2 WJABW2 Work (alpha 1)
C MOVELXBADH4 WJADH4 Master file sav
C MOVELXBADH5 WJADH5 Current unresta
C MOVELXBADH6 WJADH6 Reuse data entr
C MOVELXBZ9AD WJZ9AD Multi-company i
C MOVELXBADH7 WJADH7 Fiscal period i
C MOVELXBADH8 WJADH8 Date format for
C MOVELXBADH9 WJADH9 Date validation
C MOVELXBADH0 WJADH0 COM - GL interf
C MOVELXBADJA WJADJA I/T checkpoint
C MOVELXBADJB WJADJB PR - GL interfa
C MOVELXBADJC WJADJC AP - GL interfa
C MOVELXBADJD WJADJD AR - GL interfa
C MOVELXBADJF WJADJF AP - PCC interf
C MOVELXBADJG WJADJG PR - PCC interf
C MOVELXBADJH WJADJH PMC - PR interf
C MOVELXBADJJ WJADJJ IM - PCC interf
C MOVELXBADJK WJADJK PMC - IM interf
C MOVELXBADJL WJADJL IM - SA interfa
C MOVELXBADJM WJADJM IM - COM interf
C MOVELXBADJN WJADJN IM - MRP interf
C MOVELXBADJP WJADJP IM - PDM interf
C MOVELXBADJQ WJADJQ PDM - PCC inter
C MOVELXBADJR WJADJR PDM - MRP inter
C MOVELXBADJS WJADJS PDM - COM inter
C MOVELXBADJT WJADJT COM - MRP inter
C MOVELXBADJV WJADJV COM - SA interf
C MOVELXBADJW WJADJW COM - AR interf
C MOVELXBADJY WJADJY AR - SA interfa
C MOVELXBADJZ WJADJZ PMC - PCC inter
C MOVELXBADJ1 WJADJ1 PCC - IM interf
C MOVELXBADJ2 WJADJ2 IM - GL interfa
C MOVELXBADJ3 WJADJ3 COM - IM interf
C MOVELXBADJ4 WJADJ4 MRP - IM interf
C MOVELXBADJ5 WJADJ5 PDM - IM interf
C MOVELXBADJ6 WJADJ6 MRP - PDM inter
C MOVELXBADJ7 WJADJ7 PCC - GL interf
C MOVELXBADJ8 WJADJ8 EDMI - PDM inte
C MOVELXBADJ9 WJADJ9 FCST - MRP inte
C MOVELXBADJ0 WJADJ0 FA - GL interfa
C MOVELXBADKA WJADKA Questionnaire h
C MOVELXBADKB WJADKB Yes response ch
C MOVELXBADKC WJADKC No response cha
C MOVELXBACV5 WJACV5 Work alpha (1)
C MOVELXBADKD WJADKD Mth periods def
C MOVELXBADKF WJADKF Weeks per perio
C MOVELXBADKG WJADKG Week beginning
C MOVELXBADKH WJADKH Last file sts r
C MOVELXBADKJ WJADKJ Last file sts r
C MOVELXBADKK WJADKK REP - GL interf
C MOVELXBADKM WJADKM IFM GLI interfa
C MOVELXBADKN WJADKN IFM AP interfac
C MOVELXBADKP WJADKP IFM AR interfac
* Only sort if element is out of position
C YL02 IFGT 0
C YK02,YL02 ANDGTYD02
* Adjust RTVOBJ index to reflect position of added/removed element
C YR02 IFGT 0
C YR02 ANDLE1
C YK02,YR02 ANDGTYD02
C ADD 1 YR02 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK02
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL02
* Move SYSCTL XMR fields back
C MOVELWJZ80O WUZ80O SYSCTL key erro
C MOVELWJADHJ WUADHJ ACS Apply compl
C MOVELWJADHK WUADHK Initial install
C MOVELWJADHL WUADHL Installation co
C MOVELWJADHM WUADHM AP - IM interfa
C MOVELWJADHN WUADHN AR - AP interfa
C MOVELWJADHP WUADHP PUR - MRP inter
C MOVELWJADHQ WUADHQ PUR - IM interf
C MOVELWJADHR WUADHR MPSP - MRP inte
C MOVELWJADHS WUADHS COM - MPSP inte
C MOVELWJADHT WUADHT MRP - REP inter
C MOVELWJADHV WUADHV COM - REP inter
C MOVELWJADHW WUADHW PMC - REP inter
C MOVELWJADHY WUADHY MPA - COM inter
C MOVELWJADHZ WUADHZ MPA - PCC inter
C MOVELWJADH1 WUADH1 MPA - MRP inter
C MOVELWJADH2 WUADH2 PUR - GL interf
C MOVELWJADH3 WUADH3 PUR - PCC inter
C MOVELWJABW2 WUABW2 Work (alpha 1)
C MOVELWJADH4 WUADH4 Master file sav
C MOVELWJADH5 WUADH5 Current unresta
C MOVELWJADH6 WUADH6 Reuse data entr
C MOVELWJZ9AD WUZ9AD Multi-company i
C MOVELWJADH7 WUADH7 Fiscal period i
C MOVELWJADH8 WUADH8 Date format for
C MOVELWJADH9 WUADH9 Date validation
C MOVELWJADH0 WUADH0 COM - GL interf
C MOVELWJADJA WUADJA I/T checkpoint
C MOVELWJADJB WUADJB PR - GL interfa
C MOVELWJADJC WUADJC AP - GL interfa
C MOVELWJADJD WUADJD AR - GL interfa
C MOVELWJADJF WUADJF AP - PCC interf
C MOVELWJADJG WUADJG PR - PCC interf
C MOVELWJADJH WUADJH PMC - PR interf
C MOVELWJADJJ WUADJJ IM - PCC interf
C MOVELWJADJK WUADJK PMC - IM interf
C MOVELWJADJL WUADJL IM - SA interfa
C MOVELWJADJM WUADJM IM - COM interf
C MOVELWJADJN WUADJN IM - MRP interf
C MOVELWJADJP WUADJP IM - PDM interf
C MOVELWJADJQ WUADJQ PDM - PCC inter
C MOVELWJADJR WUADJR PDM - MRP inter
C MOVELWJADJS WUADJS PDM - COM inter
C MOVELWJADJT WUADJT COM - MRP inter
C MOVELWJADJV WUADJV COM - SA interf
C MOVELWJADJW WUADJW COM - AR interf
C MOVELWJADJY WUADJY AR - SA interfa
C MOVELWJADJZ WUADJZ PMC - PCC inter
C MOVELWJADJ1 WUADJ1 PCC - IM interf
C MOVELWJADJ2 WUADJ2 IM - GL interfa
C MOVELWJADJ3 WUADJ3 COM - IM interf
C MOVELWJADJ4 WUADJ4 MRP - IM interf
C MOVELWJADJ5 WUADJ5 PDM - IM interf
C MOVELWJADJ6 WUADJ6 MRP - PDM inter
C MOVELWJADJ7 WUADJ7 PCC - GL interf
C MOVELWJADJ8 WUADJ8 EDMI - PDM inte
C MOVELWJADJ9 WUADJ9 FCST - MRP inte
C MOVELWJADJ0 WUADJ0 FA - GL interfa
C MOVELWJADKA WUADKA Questionnaire h
C MOVELWJADKB WUADKB Yes response ch
C MOVELWJADKC WUADKC No response cha
C MOVELWJACV5 WUACV5 Work alpha (1)
C MOVELWJADKD WUADKD Mth periods def
C MOVELWJADKF WUADKF Weeks per perio
C MOVELWJADKG WUADKG Week beginning
C MOVELWJADKH WUADKH Last file sts r
C MOVELWJADKJ WUADKJ Last file sts r
C MOVELWJADKK WUADKK REP - GL interf
C MOVELWJADKM WUADKM IFM GLI interfa
C MOVELWJADKN WUADKN IFM AP interfac
C MOVELWJADKP WUADKP IFM AR interfac
* USER: Processing after Data update
* PAR = DB1 By name
C MOVELXBZ80O WUZ80O SYSCTL key erro
C MOVELXBADHJ WUADHJ ACS Apply compl
C MOVELXBADHK WUADHK Initial install
C MOVELXBADHL WUADHL Installation co
C MOVELXBADHM WUADHM AP - IM interfa
C MOVELXBADHN WUADHN AR - AP interfa
C MOVELXBADHP WUADHP PUR - MRP inter
C MOVELXBADHQ WUADHQ PUR - IM interf
C MOVELXBADHR WUADHR MPSP - MRP inte
C MOVELXBADHS WUADHS COM - MPSP inte
C MOVELXBADHT WUADHT MRP - REP inter
C MOVELXBADHV WUADHV COM - REP inter
C MOVELXBADHW WUADHW PMC - REP inter
C MOVELXBADHY WUADHY MPA - COM inter
C MOVELXBADHZ WUADHZ MPA - PCC inter
C MOVELXBADH1 WUADH1 MPA - MRP inter
C MOVELXBADH2 WUADH2 PUR - GL interf
C MOVELXBADH3 WUADH3 PUR - PCC inter
C MOVELXBABW2 WUABW2 Work (alpha 1)
C MOVELXBADH4 WUADH4 Master file sav
C MOVELXBADH5 WUADH5 Current unresta
C MOVELXBADH6 WUADH6 Reuse data entr
C MOVELXBZ9AD WUZ9AD Multi-company i
C MOVELXBADH7 WUADH7 Fiscal period i
C MOVELXBADH8 WUADH8 Date format for
C MOVELXBADH9 WUADH9 Date validation
C MOVELXBADH0 WUADH0 COM - GL interf
C MOVELXBADJA WUADJA I/T checkpoint
C MOVELXBADJB WUADJB PR - GL interfa
C MOVELXBADJC WUADJC AP - GL interfa
C MOVELXBADJD WUADJD AR - GL interfa
C MOVELXBADJF WUADJF AP - PCC interf
C MOVELXBADJG WUADJG PR - PCC interf
C MOVELXBADJH WUADJH PMC - PR interf
C MOVELXBADJJ WUADJJ IM - PCC interf
C MOVELXBADJK WUADJK PMC - IM interf
C MOVELXBADJL WUADJL IM - SA interfa
C MOVELXBADJM WUADJM IM - COM interf
C MOVELXBADJN WUADJN IM - MRP interf
C MOVELXBADJP WUADJP IM - PDM interf
C MOVELXBADJQ WUADJQ PDM - PCC inter
C MOVELXBADJR WUADJR PDM - MRP inter
C MOVELXBADJS WUADJS PDM - COM inter
C MOVELXBADJT WUADJT COM - MRP inter
C MOVELXBADJV WUADJV COM - SA interf
C MOVELXBADJW WUADJW COM - AR interf
C MOVELXBADJY WUADJY AR - SA interfa
C MOVELXBADJZ WUADJZ PMC - PCC inter
C MOVELXBADJ1 WUADJ1 PCC - IM interf
C MOVELXBADJ2 WUADJ2 IM - GL interfa
C MOVELXBADJ3 WUADJ3 COM - IM interf
C MOVELXBADJ4 WUADJ4 MRP - IM interf
C MOVELXBADJ5 WUADJ5 PDM - IM interf
C MOVELXBADJ6 WUADJ6 MRP - PDM inter
C MOVELXBADJ7 WUADJ7 PCC - GL interf
C MOVELXBADJ8 WUADJ8 EDMI - PDM inte
C MOVELXBADJ9 WUADJ9 FCST - MRP inte
C MOVELXBADJ0 WUADJ0 FA - GL interfa
C MOVELXBADKA WUADKA Questionnaire h
C MOVELXBADKB WUADKB Yes response ch
C MOVELXBADKC WUADKC No response cha
C MOVELXBACV5 WUACV5 Work alpha (1)
C MOVELXBADKD WUADKD Mth periods def
C MOVELXBADKF WUADKF Weeks per perio
C MOVELXBADKG WUADKG Week beginning
C MOVELXBADKH WUADKH Last file sts r
C MOVELXBADKJ WUADKJ Last file sts r
C MOVELXBADKK WUADKK REP - GL interf
C MOVELXBADKM WUADKM IFM GLI interfa
C MOVELXBADKN WUADKN IFM AP interfac
C MOVELXBADKP WUADKP IFM AR interfac
*================================================================
CSR OPEXIT ENDSR
/EJECT
CSR OQDLRC BEGSR
*================================================================
* DLT:Historical Tax Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Initialize array variables
C MOVEA*HIVAL YK05
* Initialize last used element number
C Z-ADD0 YL05
*================================================================
CSR OQEXIT ENDSR
/EJECT
CSR ORRVGN BEGSR
*================================================================
* RTV:Count Tax Groups - Historical Tax *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD*ZERO WUAC0D &No of Tax grou
C MOVEL*BLANK WUACHG Tax group code
* Declare restrictor key work fields
C *LIKE DEFN WTAENB WQOR01 Company number
C *LIKE DEFN WTGGNB WQOR02 Invoice number
C *LIKE DEFN WTHYNB WQOR03 Invoice sequenc
* Define keylist
C KRSOR KLIST
C KFLD WQOR01 Company number
C KFLD WQOR02 Invoice number
C KFLD WQOR03 Invoice sequenc
* Setup key
C Z-ADDC6AENB WQOR01 Company number
C Z-ADD*ZERO WQOR02 Invoice number
C Z-ADDP3HYNB WQOR03 Invoice sequenc
* Establish starting position
C KRSOR SETLLFGFCPYL *
C KRSOR READEFGFCPYL 90*
* Data record not found
C 90 MOVEL'AMB0812' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Tax group code NE WRK.Tax group code
C WTACHG IFNE WUACHG *IF
C ADD 1 WUAC0D &No of Tax grou
C MOVELWTACHG WUACHG Tax group code
C END *FI
C KRSOR READEFGFCPYL 90*
C ENDDO
*================================================================
CSR OREXIT ENDSR
/EJECT
CSR OSRVGN BEGSR
*================================================================
* RTV:Next Tax Group - Historical Tax *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WVAENB WQOS01 Company number
C *LIKE DEFN WVGGNB WQOS02 Invoice number
C *LIKE DEFN WVHYNB WQOS03 Invoice sequenc
* Define keylist
C KRSOS KLIST
C KFLD WQOS01 Company number
C KFLD WQOS02 Invoice number
C KFLD WQOS03 Invoice sequenc
* Setup key
C Z-ADDWVAENB WQOS01 Company number
C Z-ADDWVGGNB WQOS02 Invoice number
C Z-ADDWVHYNB WQOS03 Invoice sequenc
* Establish starting position
C KRSOS SETLLFGFCPPL *
C KRSOS READEFGFCPPL 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0812' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C Z-ADD*ZERO WUGYVA Tax amount
C MOVEL*BLANK WUACHH Tax invoice tex
C MOVEL*BLANK WUACHJ Inv lang tax in
C GOTO OSEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* Has this tax group been processed?
* RTV:Check for Tax Group - *Arrays *
C EXSR OTRVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* PAR = DB1 By name
C Z-ADDWVGYVA WUGYVA Tax amount
C MOVELWVACHH WUACHH Tax invoice tex
C MOVELWVACHJ WUACHJ Inv lang tax in
C MOVELWVACHG WUACHG Tax group code
* RTV:Bucket Taxes - Historical Tax *
C EXSR OVRVGN
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO OSEXIT *QUIT
C END *FI
C KRSOS READEFGFCPPL 90*
C ENDDO
*================================================================
CSR OSEXIT ENDSR
/EJECT
CSR OTRVGN BEGSR
*================================================================
* RTV:Check for Tax Group - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL05 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK05,Y YD05
C YI05 OCUR YM05
* Initialize internal index
C MOVEL*LOVAL YD05
* Move key fields to Historical Tax
C MOVELWVACHG YI0501 Tax group code
* Only search if key is not beyond range of current elements
C YK05,YL05 IFGT YD05
C YD05 LOKUPYK05,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK05,Y YD05
* Compare
C YI0501 IFNE WVACHG
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
* CRT:Historical Tax - *Arrays *
C EXSR OUCRRC
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO OTEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI05 OCUR YM05
* USER: Process Data record
C MOVEL'Y2U0003' W0RTN *Return code
C GOTO OTEXIT *QUIT
C ENDIF
*================================================================
CSR OTEXIT ENDSR
/EJECT
CSR OUCRRC BEGSR
*================================================================
* CRT:Historical Tax - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL05 IFEQ 9999
C MOVEL'Y2U0036' W0RTN 7
C GOTO OUEXIT
C ENDIF
* Move all fields to Historical Tax
C MOVELWVACHG XEACHG Tax group code
* Move key fields to Historical Tax
C MOVELXEACHG YI0501 Tax group code
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI05
* Only search if key is not beyond range of current elements
C YL05 IFGT 0
C YK05,YL05 ANDGTYD05
* Set search index to first element of array
C Z-ADD1 Y 50
C YD05 LOKUPYK05,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK05,Y YD05
* Compare
C YI0501 IFEQ XEACHG
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO OUEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL05 ADD 1 Y 50
* Check if element was a previously deleted element
C YK05,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK05,Y YD05
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI05
C ENDIF
* Create(insert) new element
* Move key fields to Historical Tax
C MOVELXEACHG YI0501 Tax group code
C MOVELYD05 YK05,Y
C YI05 OCUR YM05
* Update MODS fields
C MOVELXEACHG WSACHG Tax group code
* Only sort if element is out of position
C YL05 IFGT 0
C YK05,YL05 ANDGTYD05
* Adjust RTVOBJ index to reflect position of added/removed element
C YR05 IFGT 0
C YR05 ANDLE9999
C YK05,YR05 ANDGTYD05
C ADD 1 YR05 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK05
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL05
*================================================================
CSR OUEXIT ENDSR
/EJECT
CSR OVRVGN BEGSR
*================================================================
* RTV:Bucket Taxes - Historical Tax *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD*ZERO WUGYVA Tax amount
* Declare restrictor key work fields
C *LIKE DEFN WTAENB WQOV01 Company number
C *LIKE DEFN WTGGNB WQOV02 Invoice number
C *LIKE DEFN WTHYNB WQOV03 Invoice sequenc
* Define keylist
C KRSOV KLIST
C KFLD WQOV01 Company number
C KFLD WQOV02 Invoice number
C KFLD WQOV03 Invoice sequenc
* Setup key
C Z-ADDWVAENB WQOV01 Company number
C Z-ADDWVGGNB WQOV02 Invoice number
C Z-ADDWVHYNB WQOV03 Invoice sequenc
* Establish starting position
C KRSOV SETLLFGFCPYL *
C KRSOV READEFGFCPYL 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0812' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C Z-ADD*ZERO WUGYVA Tax amount
C GOTO OVEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Tax group code EQ WRK.Tax group code
C WTACHG IFEQ WUACHG *IF
* Do not total tax if: Tax in price, EC memo tax, or not invoiced.
* CASE:
* - c1 OR c2 OR c3 OR c4 OR c5
* |- c1 : DB1.Tax in price - Europe is Yes
* |- c2 : DB1.Tax in price - Brazil is Yes
* |- c3 : DB1.EC memo tax flag is Yes
* |- c4 : DB1.Tax is invoiced flag is No
* |- c5 : DB1.Use tax flag is Yes
* '-
C WTZ9T3 IFEQ '1' *IF
C WTZ9T4 OREQ '1' *OR
C WTZ9T0 OREQ '1' *OR
C WTZ9VK OREQ '0' *OR
C WTZ9T9 OREQ '1' *OR
C ELSE
* CASE: *OTHERWISE
C ADD WTGYVA WUGYVA Tax amount
C END *FI
C END *FI
C KRSOV READEFGFCPYL 90*
C ENDDO
* USER: Exit processing
C Z-ADDWUGYVA WUGYVA Tax amount
*================================================================
CSR OVEXIT ENDSR
/EJECT
CSR OWRVGN BEGSR
*================================================================
* RTV:ledger/alt cur/flag - Quote/Order Euro Xref *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSOW KLIST
C KFLD LJAENB Company number
C KFLD LJDCCD Internal header
C KFLD LJCVNB Quote/order num
* Setup key
C Z-ADDC6AENB LJAENB Company number
C MOVELC6DCCD LJDCCD Internal header
C MOVELC6CVNB LJCVNB Quote/order num
* Establish starting position
C KRSOW CHAINFLJRET4 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB3905' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUADZY Personal ledger
C MOVEL*BLANK WUZ0YH Alternate curre
C MOVEL*BLANK WUZ0YN Print Alternate
C MOVEL'0' WUZ0YN Print Alternate
C GOTO OWEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELLJADZY WUADZY Personal ledger
C MOVELLJZ0YH WUZ0YH Alternate curre
C MOVELLJZ0YN WUZ0YN Print Alternate
C ENDIF
*================================================================
CSR OWEXIT ENDSR
/EJECT
CSR OXRVGN BEGSR
*================================================================
* RTV:Invoice ttl discount? - Customer *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSOX KLIST
C KFLD BFAENB Company number
C KFLD BFCANB Customer number
* Setup key
C Z-ADDP1AENB BFAENB Company number
C Z-ADDP1CANB BFCANB Customer number
* Establish starting position
C KRSOX CHAINFGRREMF 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0690' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
* PAR = CON By name
C MOVEL*BLANK WUAAYA Invoice total d
C GOTO OXEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELBFAAYA WUAAYA Invoice total d
C ENDIF
*================================================================
CSR OXEXIT ENDSR
/EJECT
CSR OYRVGN BEGSR
*================================================================
* RTV:Freight/Misc - Quote/Order Spec Charge *
*================================================================
C Z-ADD*ZERO WN0065 132 Special charge
C Z-ADD*ZERO WN0066 132 LC special char
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* PAR = CON By name
C Z-ADD*ZERO WN0065 Special charge
C Z-ADD*ZERO WN0066 LC special char
C Z-ADD*ZERO YAAB11 Total misc 15.2
C Z-ADD*ZERO YAAB12 Total freight 1
C Z-ADD*ZERO WUAB15 LC - total misc
C Z-ADD*ZERO WUAB16 LC - total frei
* Declare restrictor key work fields
C *LIKE DEFN C7AENB WQOY01 Company number
C *LIKE DEFN C7DCCD WQOY02 Internal header
C *LIKE DEFN C7CVNB WQOY03 Quote/order num
* Define keylist
C KRSOY KLIST
C KFLD WQOY01 Company number
C KFLD WQOY02 Internal header
C KFLD WQOY03 Quote/order num
* Setup key
C Z-ADDP1AENB WQOY01 Company number
C MOVELP1DCCD WQOY02 Internal header
C MOVELP1CVNB WQOY03 Quote/order num
* Establish starting position
C KRSOY SETLLFFXREKX *
C KRSOY READEFFXREKX 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0630' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C Z-ADD*ZERO WN0065 Special charge
C Z-ADD*ZERO WN0066 LC special char
C Z-ADD*ZERO YAAB11 Total misc 15.2
C Z-ADD*ZERO YAAB12 Total freight 1
C Z-ADD*ZERO WUAB15 LC - total misc
C Z-ADD*ZERO WUAB16 LC - total frei
C MOVEL*BLANK W0RTN *Return code
C GOTO OYEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* For each special charge, sum to freight or miscellaneous
* CASE: DB1.Special charge code is Freight; no cost
C C7BLST IFEQ '1' *IF
* Include tax?
* CASE: PAR.Tax in price flag is Tax in price - list
C P5Z9JB IFEQ '1' *IF
C ADD C7Z9QF YAAB12 Total freight 1
C ADD C7Z9QD WUAB16 LC - total frei
C ELSE
* CASE: *OTHERWISE
C ADD C7DDVA YAAB12 Total freight 1
C ADD C7AAD4 WUAB16 LC - total frei
C END *FI
C ELSE
* CASE: *OTHERWISE
* Include tax?
* CASE: PAR.Tax in price flag is Tax in price - list
C P5Z9JB IFEQ '1' *IF
C ADD C7Z9QF YAAB11 Total misc 15.2
C ADD C7Z9QD WUAB15 LC - total misc
C ELSE
* CASE: *OTHERWISE
C ADD C7DDVA YAAB11 Total misc 15.2
C ADD C7AAD4 WUAB15 LC - total misc
C END *FI
C END *FI
C KRSOY READEFFXREKX 90*
C ENDDO
*================================================================
CSR OYEXIT ENDSR
/EJECT
CSR OZRVGN BEGSR
*================================================================
* RTV:Get taxes for invoice - Historical Tax *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD*ZERO WUAACC Total item tax
C Z-ADD*ZERO WUAACF Total spc charg
C Z-ADD*ZERO WUAACG Total surcharge
* Declare restrictor key work fields
C *LIKE DEFN WTAENB WQOZ01 Company number
C *LIKE DEFN WTGGNB WQOZ02 Invoice number
C *LIKE DEFN WTHYNB WQOZ03 Invoice sequenc
* Define keylist
C KRSOZ KLIST
C KFLD WQOZ01 Company number
C KFLD WQOZ02 Invoice number
C KFLD WQOZ03 Invoice sequenc
* Setup key
C Z-ADDP1AENB WQOZ01 Company number
C Z-ADD*ZERO WQOZ02 Invoice number
C Z-ADDP3HYNB WQOZ03 Invoice sequenc
* Establish starting position
C KRSOZ SETLLFGFCPYL *
C KRSOZ READEFGFCPYL 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0812' W0RTN 7
* USER: Processing if Data record not found
C MOVEL*BLANK W0RTN *Return code
C GOTO OZEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* Do not total tax if: Tax in price, EC memo tax, or not invoiced.
* CASE:
* - c1 OR c2 OR c3 OR c4 OR c5
* |- c1 : DB1.Tax in price - Europe is Yes
* |- c2 : DB1.Tax in price - Brazil is Yes
* |- c3 : DB1.EC memo tax flag is Yes
* |- c4 : DB1.Tax is invoiced flag is No
* |- c5 : DB1.Use tax flag is Yes
* '-
C WTZ9T3 IFEQ '1' *IF
C WTZ9T4 OREQ '1' *OR
C WTZ9T0 OREQ '1' *OR
C WTZ9VK OREQ '0' *OR
C WTZ9T9 OREQ '1' *OR
C ELSE
* CASE: *OTHERWISE
* See which tax this is and add it to the correct bucket.
* CASE: DB1.Line item type is Item
C WTAAG3 IFEQ '1' *IF
C ADD WTGYVA WUAACC Total item tax
C ELSE
* CASE: *OTHERWISE
* Now we have to see if it is a surcharge or a special charge.
* RTV:Is this spc or surch? - History Special Charge *
C EXSR PARVGN
* Update special charge or surcharge taxes.
* CASE: WRK.Special Charge found ? is Yes
C WUACKN IFEQ '1' *IF
C ADD WTGYVA WUAACF Total spc charg
C ELSE
* CASE: *OTHERWISE
* It must be a surcharge...
C ADD WTGYVA WUAACG Total surcharge
C END *FI
C END *FI
C END *FI
C KRSOZ READEFGFCPYL 90*
C ENDDO
*================================================================
CSR OZEXIT ENDSR
/EJECT
CSR PARVGN BEGSR
*================================================================
* RTV:Is this spc or surch? - History Special Charge *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSPA KLIST
C KFLD WMAENB Company number
C KFLD WMGGNB Invoice number
C KFLD WMHYNB Invoice sequenc
C KFLD WMAAD2 Special charge
* Setup key
C Z-ADDWTAENB WMAENB Company number
C Z-ADDWTGGNB WMGGNB Invoice number
C Z-ADDWTHYNB WMHYNB Invoice sequenc
C Z-ADDWTAAD2 WMAAD2 Special charge
* Establish starting position
C KRSPA CHAINFF9CPYI 90 *
* Data record not found
C 90 MOVEL'AMB0796' W0RTN 7
C *IN90 IFEQ '0'
* USER: Process Data record
* See if this is a special charge or a surcharge.
* CASE: DB1.Special charge code is Blank
C WMBLST IFEQ *BLANK *IF
C MOVEL'0' WUACKN Special Charge
C ELSE
* CASE: *OTHERWISE
C MOVEL'1' WUACKN Special Charge
C END *FI
C ENDIF
*================================================================
CSR PAEXIT ENDSR
/EJECT
CSR PBRVGN BEGSR
*================================================================
* RTV:Get All Terms Info. - Terms *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Check for IFM is installed
* RTV:SYSCTL Installed app - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0562 4 Application ali
C WUADRB PARM *BLANK WQ0563 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* CASE: WRK.Installed apps conditions is Installed
C WUADRB IFEQ '1' *IF
C MOVELP1BLCD WUACKW Terms code (USR
* Get IFM best terms info - IFM Programs *
C CALL 'UAFUXFR' 90 Get IFM best te
C W0RTN PARM W0RTN WQ0564 7 Return code IFM
C PARM WUACKW WQ0565 2 Terms code (USR
C WUADLL PARM *ZERO WQ0566 52 Discount percen
C WUCXNB PARM *ZERO WQ0567 30 Terms discount
C WUCYNB PARM *ZERO WQ0568 30 Terms net due d
C WUA2TX PARM *BLANK WQ0569 25 Terms descripti
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UAFUXFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Check for IFM terms code not found
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* PAR = CON By name
C MOVEL*BLANK WUA2TX Terms descripti
C Z-ADD*ZERO WUCXNB Terms discount
C Z-ADD*ZERO WUCYNB Terms net due d
C Z-ADD*ZERO WUABPC Terms percent
C ELSE
* CASE: *OTHERWISE
* Note; COM percent is 7.3 field, IFM percent is 5.2 field
C Z-ADD*ZERO WUABPC Terms percent
C ADD WUADLL WUABPC Terms percent
C END *FI
C GOTO PBEXIT *QUIT
C END *FI
* Define keylist
C KRSPB KLIST
C KFLD DYBLCD Terms code
* Setup key
C MOVELP1BLCD DYBLCD Terms code
* Establish starting position
C KRSPB CHAINFA2REDC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0270' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUA2TX Terms descripti
C Z-ADD*ZERO WUCXNB Terms discount
C Z-ADD*ZERO WUCYNB Terms net due d
C Z-ADD*ZERO WUABPC Terms percent
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO PBEXIT *QUIT
C GOTO PBEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELDYA2TX WUA2TX Terms descripti
C Z-ADDDYCXNB WUCXNB Terms discount
C Z-ADDDYCYNB WUCYNB Terms net due d
C Z-ADDDYABPC WUABPC Terms percent
C ENDIF
*================================================================
CSR PBEXIT ENDSR
/EJECT
CSR PCRVGN BEGSR
*================================================================
* RTV:Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL01 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK01,Y YD01
C YI01 OCUR YM01
* Initialize internal index
C MOVEL*LOVAL YD01
* Move key fields to Currency File Data
C MOVEL'1' YI0101 Loaded from fil
C Z-ADDWUAAQR YI0102 Company number
C MOVELP1BRCD YI0103 Currency ID
* Only search if key is not beyond range of current elements
C YK01,YL01 IFGT YD01
C YD01 LOKUPYK01,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK01,Y YD01
* Compare
C YI0101 IFNE '1'
C YI0102 ORNE WUAAQR
C YI0103 ORNE P1BRCD
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO PCEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI01 OCUR YM01
* USER: Process Data record
* PAR = DB1 By name
C MOVELWFA3TX WUA3TX Currency descri
C Z-ADDWFAJNB WUAJNB Exchange rate c
C Z-ADDWFAKNB WN0067 Decimal positio
C MOVELWFALNB WUALNB AP exchange gai
C MOVELWFAMNB WUAMNB AR exchange gai
C Z-ADDWFABVA WUABVA Price adjustmen
C MOVELWFAALP WUAALP Primary Currenc
C ENDIF
*================================================================
CSR PCEXIT ENDSR
/EJECT
CSR PDCRRC BEGSR
*================================================================
* Load Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL01 IFEQ 5
C MOVEL'Y2U0036' W0RTN 7
* USER: Processing if Data update error
* ** This error indicates the array is full.
* ** The calling function will handle the error.
* ** The array size of 5 was chosen to limit the program's size
* but still handle quite a few currencies before running
* this exception handling.
C MOVEL'Y2U0004' W0RTN *Return code
C GOTO PDEXIT
C ENDIF
C MOVEL*BLANK XAACVX Loaded from fil
C Z-ADD*ZERO XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* Move all fields to Currency File Data
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVELP1BRCD XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* USER: Processing before Data update
* RTV:All information - CURRENCY *
C EXSR PERVGN
* Set default data for record not found.
* CASE:
* - NOT c1
* |- c1 : PGM.*Return code is *Normal
* '-
C MOVEL'0' Y0CX01 1
C W0RTN IFEQ *BLANK *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL*BLANK W0RTN *Return code
* ** Keep the key data from PAR; blank the rest of the record.
* DB1 = PAR,CON By name
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVELP1BRCD XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* ** Default to 2 decimal positions.
C Z-ADD2 XAAKNB Decimal positio
C END *FI
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI01
* Only search if key is not beyond range of current elements
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Set search index to first element of array
C Z-ADD1 Y 50
C YD01 LOKUPYK01,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK01,Y YD01
* Compare
C YI0101 IFEQ XAACVX
C YI0102 ANDEQXAAENB
C YI0103 ANDEQXABRCD
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO PDEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL01 ADD 1 Y 50
* Check if element was a previously deleted element
C YK01,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK01,Y YD01
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI01
C ENDIF
* Create(insert) new element
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
C MOVELYD01 YK01,Y
C YI01 OCUR YM01
* Update MODS fields
C MOVELXAACVX WFACVX Loaded from fil
C Z-ADDXAAENB WFAENB Company number
C MOVELXABRCD WFBRCD Currency ID
C MOVELXAA3TX WFA3TX Currency descri
C Z-ADDXAAJNB WFAJNB Exchange rate c
C Z-ADDXAAKNB WFAKNB Decimal positio
C MOVELXAALNB WFALNB AP exchange gai
C MOVELXAAMNB WFAMNB AR exchange gai
C Z-ADDXAABVA WFABVA Price adjustmen
C MOVELXAAALP WFAALP Primary Currenc
* Only sort if element is out of position
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Adjust RTVOBJ index to reflect position of added/removed element
C YR01 IFGT 0
C YR01 ANDLE5
C YK01,YR01 ANDGTYD01
C ADD 1 YR01 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK01
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL01
* Move Currency F fields back
C MOVELWFA3TX WUA3TX Currency descri
C Z-ADDWFAJNB WUAJNB Exchange rate c
C Z-ADDWFAKNB WN0067 Decimal positio
C MOVELWFALNB WUALNB AP exchange gai
C MOVELWFAMNB WUAMNB AR exchange gai
C Z-ADDWFABVA WUABVA Price adjustmen
C MOVELWFAALP WUAALP Primary Currenc
* USER: Processing after Data update
* Load output?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* PAR = DB1 By name
C MOVELXAA3TX WUA3TX Currency descri
C Z-ADDXAAJNB WUAJNB Exchange rate c
C Z-ADDXAAKNB WN0067 Decimal positio
C MOVELXAALNB WUALNB AP exchange gai
C MOVELXAAMNB WUAMNB AR exchange gai
C Z-ADDXAABVA WUABVA Price adjustmen
C MOVELXAAALP WUAALP Primary Currenc
C END *FI
*================================================================
CSR PDEXIT ENDSR
/EJECT
CSR PERVGN BEGSR
*================================================================
* RTV:All information - CURRENCY *
*================================================================
C Z-ADD*ZERO WN0071 20 Company number
C MOVEL*BLANK WN0072 10 Admin division
C MOVEL*BLANK WN0073 3 Currency ID (us
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Check if IFM is installed.
* CASE: *OTHERWISE
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0572 4 Application ali
C WUADVB PARM *BLANK WQ0573 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Adjust company/currency if IFM is installed.
* CASE: WRK.Installed apps - IFM is Installed
C WUADVB IFEQ '1' *IF
* Looking for local currency?
* CASE:
* - c1 AND c2
* |- c1 : PAR.Company number is Zero
* |- c2 : PAR.Currency ID is Blank
* '-
C MOVEL'0' Y0CX01 1
C XAAENB IFEQ *ZERO *IF
C XABRCD IFEQ *BLANK *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* Get MAPICS dflt admin div - IFM Programs *
C CALL 'UAEMXFR' 90 Get MAPICS dflt
C PARM W0RTN WQ0574 7 *Return code
C PARM ZZUSR WQ0575 10 User id (usr)
C WN0072 PARM *BLANK WQ0576 10 Admin division
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UAEMXFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* EXT:COM Get Lcl Currency - IFM Programs *
C CALL 'UA39XFR' 90 EXT:COM Get Lcl
C PARM W0RTN WQ0577 7 *Return code
C PARM WN0072 WQ0578 10 Admin division
C WN0073 PARM *BLANK WQ0579 4 Currency id IFM
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UA39XFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C Z-ADD01 WN0071 Company number
* RTV:All information IFM - CURRENCY *
C EXSR PFRVGN
C GOTO PEEXIT *QUIT
C END *FI
* Adjust Company_number?
* CASE: PAR.Company number is Not equal 01
C XAAENB IFNE 01 *IF
C Z-ADD01 WN0071 Company number
* RTV:All information IFM - CURRENCY *
C EXSR PGRVGN
C GOTO PEEXIT *QUIT
C END *FI
C END *FI
* Define keylist
C KRSPE KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDXAAENB EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSPE CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C Z-ADD*ZERO WN0071 Company number
C MOVEL*BLANK WN0072 Admin division
C MOVEL*BLANK WN0073 Currency ID (us
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO PEEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR PEEXIT ENDSR
/EJECT
CSR PFRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSPF KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0071 EPAENB Company number
C MOVELWN0073 EPBRCD Currency ID
* Establish starting position
C KRSPF CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO PFEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR PFEXIT ENDSR
/EJECT
CSR PGRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSPG KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0071 EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSPG CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO PGEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR PGEXIT ENDSR
/EJECT
CSR PHDLRC BEGSR
*================================================================
* Clear Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Initialize array variables
C MOVEA*HIVAL YK01
* Initialize last used element number
C Z-ADD0 YL01
*================================================================
CSR PHEXIT ENDSR
/EJECT
CSR PICRRC BEGSR
*================================================================
* Load Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL01 IFEQ 5
C MOVEL'Y2U0036' W0RTN 7
* USER: Processing if Data update error
* ** This error indicates the array is full.
* ** The calling function will handle the error.
* ** The array size of 5 was chosen to limit the program's size
* but still handle quite a few currencies before running
* this exception handling.
C MOVEL'Y2U0004' W0RTN *Return code
C GOTO PIEXIT
C ENDIF
C MOVEL*BLANK XAACVX Loaded from fil
C Z-ADD*ZERO XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* Move all fields to Currency File Data
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVELP1BRCD XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* USER: Processing before Data update
* RTV:All information - CURRENCY *
C EXSR PJRVGN
* Set default data for record not found.
* CASE:
* - NOT c1
* |- c1 : PGM.*Return code is *Normal
* '-
C MOVEL'0' Y0CX01 1
C W0RTN IFEQ *BLANK *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL*BLANK W0RTN *Return code
* ** Keep the key data from PAR; blank the rest of the record.
* DB1 = PAR,CON By name
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVELP1BRCD XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* ** Default to 2 decimal positions.
C Z-ADD2 XAAKNB Decimal positio
C END *FI
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI01
* Only search if key is not beyond range of current elements
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Set search index to first element of array
C Z-ADD1 Y 50
C YD01 LOKUPYK01,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK01,Y YD01
* Compare
C YI0101 IFEQ XAACVX
C YI0102 ANDEQXAAENB
C YI0103 ANDEQXABRCD
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO PIEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL01 ADD 1 Y 50
* Check if element was a previously deleted element
C YK01,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK01,Y YD01
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI01
C ENDIF
* Create(insert) new element
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
C MOVELYD01 YK01,Y
C YI01 OCUR YM01
* Update MODS fields
C MOVELXAACVX WFACVX Loaded from fil
C Z-ADDXAAENB WFAENB Company number
C MOVELXABRCD WFBRCD Currency ID
C MOVELXAA3TX WFA3TX Currency descri
C Z-ADDXAAJNB WFAJNB Exchange rate c
C Z-ADDXAAKNB WFAKNB Decimal positio
C MOVELXAALNB WFALNB AP exchange gai
C MOVELXAAMNB WFAMNB AR exchange gai
C Z-ADDXAABVA WFABVA Price adjustmen
C MOVELXAAALP WFAALP Primary Currenc
* Only sort if element is out of position
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Adjust RTVOBJ index to reflect position of added/removed element
C YR01 IFGT 0
C YR01 ANDLE5
C YK01,YR01 ANDGTYD01
C ADD 1 YR01 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK01
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL01
* Move Currency F fields back
C MOVELWFA3TX WUA3TX Currency descri
C Z-ADDWFAJNB WUAJNB Exchange rate c
C Z-ADDWFAKNB WN0067 Decimal positio
C MOVELWFALNB WUALNB AP exchange gai
C MOVELWFAMNB WUAMNB AR exchange gai
C Z-ADDWFABVA WUABVA Price adjustmen
C MOVELWFAALP WUAALP Primary Currenc
* USER: Processing after Data update
* Load output?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* PAR = DB1 By name
C MOVELXAA3TX WUA3TX Currency descri
C Z-ADDXAAJNB WUAJNB Exchange rate c
C Z-ADDXAAKNB WN0067 Decimal positio
C MOVELXAALNB WUALNB AP exchange gai
C MOVELXAAMNB WUAMNB AR exchange gai
C Z-ADDXAABVA WUABVA Price adjustmen
C MOVELXAAALP WUAALP Primary Currenc
C END *FI
*================================================================
CSR PIEXIT ENDSR
/EJECT
CSR PJRVGN BEGSR
*================================================================
* RTV:All information - CURRENCY *
*================================================================
C Z-ADD*ZERO WN0074 20 Company number
C MOVEL*BLANK WN0075 10 Admin division
C MOVEL*BLANK WN0076 3 Currency ID (us
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Check if IFM is installed.
* CASE: *OTHERWISE
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0580 4 Application ali
C WUADVB PARM *BLANK WQ0581 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Adjust company/currency if IFM is installed.
* CASE: WRK.Installed apps - IFM is Installed
C WUADVB IFEQ '1' *IF
* Looking for local currency?
* CASE:
* - c1 AND c2
* |- c1 : PAR.Company number is Zero
* |- c2 : PAR.Currency ID is Blank
* '-
C MOVEL'0' Y0CX01 1
C XAAENB IFEQ *ZERO *IF
C XABRCD IFEQ *BLANK *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* Get MAPICS dflt admin div - IFM Programs *
C CALL 'UAEMXFR' 90 Get MAPICS dflt
C PARM W0RTN WQ0582 7 *Return code
C PARM ZZUSR WQ0583 10 User id (usr)
C WN0075 PARM *BLANK WQ0584 10 Admin division
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UAEMXFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* EXT:COM Get Lcl Currency - IFM Programs *
C CALL 'UA39XFR' 90 EXT:COM Get Lcl
C PARM W0RTN WQ0585 7 *Return code
C PARM WN0075 WQ0586 10 Admin division
C WN0076 PARM *BLANK WQ0587 4 Currency id IFM
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UA39XFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C Z-ADD01 WN0074 Company number
* RTV:All information IFM - CURRENCY *
C EXSR PKRVGN
C GOTO PJEXIT *QUIT
C END *FI
* Adjust Company_number?
* CASE: PAR.Company number is Not equal 01
C XAAENB IFNE 01 *IF
C Z-ADD01 WN0074 Company number
* RTV:All information IFM - CURRENCY *
C EXSR PLRVGN
C GOTO PJEXIT *QUIT
C END *FI
C END *FI
* Define keylist
C KRSPJ KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDXAAENB EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSPJ CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C Z-ADD*ZERO WN0074 Company number
C MOVEL*BLANK WN0075 Admin division
C MOVEL*BLANK WN0076 Currency ID (us
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO PJEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR PJEXIT ENDSR
/EJECT
CSR PKRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSPK KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0074 EPAENB Company number
C MOVELWN0076 EPBRCD Currency ID
* Establish starting position
C KRSPK CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO PKEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR PKEXIT ENDSR
/EJECT
CSR PLRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSPL KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0074 EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSPL CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO PLEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR PLEXIT ENDSR
/EJECT
CSR Q0PRNT BEGSR
*================================================================
* Print report formats
*================================================================
* Select formats to print
C EXSR Q1FSEL
* Calculate length of formats selected for printing
C EXSR Q2PLEN
* Add column heading length to print length
C ADD W0COLN W0FSUM
C W0NEWP IFNE 'Y'
* Signal overflow if requested headings would cause
* detail format to start past the overflow line
C W0FSUM IFGE W0OFL
C MOVE 'Y' W0NEWP
C ELSE
* Signal overflow if requested headings would cause
* Detail format to be printed past end of page
C ADD W0DTLN W0FSUM
C W0FSUM IFGT W0PGL
C MOVE 'Y' W0NEWP
C END
C END
C END
* Print Standard report header of PRT:Acknowledgement
* If it is ready to print, then do so,
C W0NEWP IFEQ 'Y' IF
C EXSR Q3PTNP
C END FI
* Print First Page Format of PRT:Acknowledgement
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0AP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0AP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0AP1P
* Clear first page flag.
C MOVE *BLANK W0AL1P
C END FI
* Print Company number of PRT:Acknowledgement
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0AP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0AP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0AP00
C END FI
* Print Internal header type of PRT:Acknowledgement
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0AP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0AP01 ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of Internal header type format
* RTV:Print EDI acknowlgmnt - EDI trading partner *
C EXSR SBRVGN
* Set EDI if customer is an EDI customer (or EC)
* CASE: PGM.*Return code is *Record already exists
C W0RTN IFEQ 'Y2U0003' *IF
* Setup message data for message
* Retrieve message BACKUP COPY OF DOCUMENT
C MOVELZADFMF ZAMSGF
C CALL 'Y2RVMGC' 90 *
C PARM *BLANK W0RTN 7 Return code
C PARM 'AMB2577' ZAMSID 7 Message ID
C PARM ZAMSGF 10 Message file
C PARM ZAMSDA Message data
C ZBABY1 PARM W0MTX 132 Returned messag
C MOVEL*BLANK ZAMSDA
C MOVEL*BLANK ZAMSGF
C ELSE
* CASE: *OTHERWISE
* RTV:Chk for document send - EC Document/Media XREF *
C EXSR SCRVGN
* CASE: PGM.*Return code is *Record already exists
C W0RTN IFEQ 'Y2U0003' *IF
* Setup message data for message
* Retrieve message BACKUP COPY OF DOCUMENT
C MOVELZADFMF ZAMSGF
C CALL 'Y2RVMGC' 90 *
C PARM *BLANK W0RTN 7 Return code
C PARM 'AMB2577' ZAMSID 7 Message ID
C PARM ZAMSGF 10 Message file
C PARM ZAMSDA Message data
C ZBABY1 PARM W0MTX 132 Returned messag
C MOVEL*BLANK ZAMSDA
C MOVEL*BLANK ZAMSGF
C ELSE
* CASE: *OTHERWISE
C MOVEL*BLANK ZBABY1 Invoice title l
C END *FI
C END *FI
C Z-ADDZZJDT ZBAA7C Date (USR)
C ADD 1 WUABC5 Page number for
C Z-ADDWUABC5 ZBABC5 Page number for
C MOVEL*BLANK ZBAA9V Quote/Order num
* Quote/Order number DRV
* RTV:External header type - Header Type *
C EXSR SDRVGN
C Z-ADD*ZEROS ZQ 50
C WUAAHZ CAT ZBCVNB:ZQ ZBAA9V P Quote/Order num
* Retrieves IFM best terms data, if IFM installed, else COM terms d
* RTV:Get All Terms Info. - Terms *
C EXSR SERVGN
* Default terms description if installment method exists in order.
* CASE: DB1.Installment method id is Present
C C6Z9H4 IFNE *BLANK *IF
* Setup message data for message
* Retrieve message Pay by Installments
C MOVELZADFMF ZAMSGF
C CALL 'Y2RVMGC' 90 *
C PARM *BLANK W0RTN 7 Return code
C PARM 'AMB3404' ZAMSID 7 Message ID
C PARM ZAMSGF 10 Message file
C PARM ZAMSDA Message data
C ZBAAN2 PARM W0MTX 132 Returned messag
C MOVEL*BLANK ZAMSDA
C MOVEL*BLANK ZAMSGF
C END *FI
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
C MOVELWUZ0YH ZBBRCD Currency ID
* Is currency id blank?
* CASE: CUR.Currency ID is Blank
C ZBBRCD IFEQ *BLANK *IF
* EXT:Get local currency - CURRENCY *
C CALL 'AMVUAXFR' 90 EXT:Get local c
C PARM *BLANK W0RTN 7
C ZBBRCD PARM ZBBRCD WQ0095 3 Local currency
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMVUAXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* (CUR)Currency id is the currency label for the header section.
C END *FI
C END *FI
* Get Currency description
* CASE: CUR.Currency ID is Blank
C ZBBRCD IFEQ *BLANK *IF
* RTV:Local description - CURRENCY *
C EXSR SFRVGN
C MOVEL'1' WUAAMK Print details?
C ELSE
* CASE: *OTHERWISE
C MOVEL*BLANK ZBAAAR Currency desc D
* Currency desc DRV
* CASE: PAR.Currency ID is Blank
C ZBBRCD IFEQ *BLANK *IF
C MOVEL*BLANK ZBAAAR Currency desc D
C ELSE
* CASE: *OTHERWISE
* RTV: description - CURRENCY *
C EXSR SGRVGN
C END *FI
C MOVEL'1' WUAAMK Print details?
C END *FI
* RTV:Address format - Customer *
C EXSR SIRVGN
* RTV:Addr Code, Ship Lead - Ship to *
C EXSR SJRVGN
* RTV:Address Details - Address *
C EXSR SKRVGN
* Format ship to address
C EXSR UASUBR Format ship to
* Check for Ship to Override Shipping instructions
* CASE: CUR.Shipping instructions is Blank
C ZBCDTX IFEQ *BLANK *IF
C MOVELWUCDTX ZBCDTX Shipping instru
C END *FI
* Sold to address override?
* CASE: DB1.Sold to override address is Not zero
C C6HECD IFNE *ZERO *IF
* RTV:Address Details - Address *
C EXSR SLRVGN
C ELSE
* CASE: *OTHERWISE
* RTV:Default Cust Address - Address *
C EXSR SMRVGN
C END *FI
* Format sold to address
C EXSR UBSUBR Format sold to
* Set carrier description
* CASE: DB1.Carrier ID is Not Blank
C C6F1CD IFNE *BLANK *IF
C MOVEL*BLANK WUAFJ0 Carrier descrip
* EXT:RTV Carrier desc - Carrier *
C CALL 'AMBMQXFR' 90 EXT:RTV Carrier
C PARM *BLANK W0RTN 7
C PARM C6F1CD WQ0128 10 Carrier ID
C ZBAFJ0 PARM *BLANK WQ0129 35 Carrier descrip
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBMQXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C MOVELZBAFJ0 WUAFJ0 Carrier descrip
C END *FI
* If credit memo retrieve po number.
* CASE: PAR.Internal header type is Credit Memo
C P1DCCD IFEQ '4' *IF
* RTV:Get P.O.No. - Credit Memo Extension *
C EXSR SNRVGN
C END *FI
* If Quote/Order ship lead time exists, use it, otherwise use the s
* CASE: DB1.Ship lead time is Not zero
C C6EENB IFNE *ZERO *IF
C Z-ADDC6EENB WUEENB Ship lead time
C END *FI
C W0PFM IFEQ 'Y'
* Convert fields to external form
* Convert Date (USR) to display format
* Convert date
C 1000000 ADD ZBAA7C XDINDT
C EXSR XDVC2T
C Z-ADDXDEXDT VBAA7C
* Generate internal/external key list
C KINEX KLIST
C KFLD Y2LSNO
C KFLD Y2INVL
* Convert Export designator to external value
C Z-ADD1100209 Y2LSNO
C MOVEL*BLANK Y2INVL
C MOVELZBBNST Y2INVL Export designat
C KINEX CHAIN@Y2INEX 90 *
C N90 MOVELY2EXVL VBBNST Export designat
C MOVEL'0' *IN79
C WUAFJ0 IFEQ *BLANK *IF
C MOVEL'1' *IN79
C END *FI
C MOVEL'0' *IN78
C P1DCCD IFNE '4' *IF
C MOVEL'1' *IN78
C END *FI
* If we are already passed the nominated
* Start line for this format
C @$CLN IFGE 4
C EXSR Q3PTNP
C END
* Print format
C WRITEZBKEYHDR
* Set column headings flag
C MOVE 'Y' W0ACDT
C END FI
* Reset format print flag
C MOVE 'P' W0AP01
C END FI
* Print Detail line. of PRT:Acknowledgement
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0ACDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0APDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0APDT ANDEQ'P'
* Mention hidden format
C 99N99 WRITEZCDTLRCD
* Reset format print flag
C MOVE *BLANK W0APDT
C END FI
* Print First Page Format of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0BP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0BP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0BP1P
* Clear first page flag.
C MOVE *BLANK W0BL1P
C END FI
* Print Company number of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0BP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0BP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0BP00
C END FI
* Print Invoice number of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0BP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0BP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0BP01
C END FI
* Print Invoice sequence of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0BP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0BP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0BP02
C END FI
* Print Internal header type of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0BP03 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0BP03 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0BP03
C END FI
* Print Quote/order number of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0BP04 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0BP04 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0BP04
C END FI
* Print Comment user reference of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0BP05 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0BP05 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0BP05
C END FI
* Print Comment line sequence no. of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0BP06 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0BP06 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0BP06
C END FI
* Print Invoice comment detail of PRO:Invoice Hdr comments
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0BCDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0BPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0BPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
C MOVEL'0' WUAAMK Print details?
C MOVEL*BLANK ZDAFD5 Text Line Descr
C MOVELWBHDTX ZDAFD5 Text Line Descr
* Check if IFM terms History records for a Invoice
* If line seq # is negative, comments are IFM terms comments
* CASE:
* - c1 AND c2
* |- c1 : DB1.Comment line sequence no. is GT -998
* |- c2 : DB1.Comment line sequence no. is Less than -100
* '-
C MOVEL'0' Y0CX01 1
C WBKBNB IFGT -998 *IF
C WBKBNB IFLT -100 *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* Greater than -100, less than zero is Complementary Invoice commen
C WBKBNB ADD 1 WUKBNB Comment line se
* History comment records are read in pairs before printing
* RTV:Header Commnt - History Comment *
C EXSR SPRVGN
* Make unit pos. of seq # a plus value
C Z-ADD*ZERO WUABGP Work Number (1.
C SUB WUKBNB WUABGP Work Number (1.
* If line seq unit # is even, comment is 'Due date Amt due' values
* If printing 'Due date Amt due' values, set up print fields.
* CASE:
* - c2 OR c3 OR c4 OR c5 OR c6
* |- c2 : WRK.Work Number (1.0) is Zero
* |- c3 : WRK.Work Number (1.0) is 2
* |- c4 : WRK.Work Number (1.0) is 4
* |- c5 : WRK.Work Number (1.0) is 6
* |- c6 : WRK.Work Number (1.0) is 8
* '-
C WUABGP IFEQ *ZERO *IF
C WUABGP OREQ 2 *OR
C WUABGP OREQ 4 *OR
C WUABGP OREQ 6 *OR
C WUABGP OREQ 8 *OR
C Z-ADD7 YRSW00
C Z-ADD1 ZQ 50
C YRSW00 IFLT 1
C ZQ ORLT 1
C YRSW00 ORGT 00025
C ZQ ORGT 00025
C MOVEL'Y2U0510' W0RTN
C ELSE
C YRSW00 SUBSTWUHDTX:ZQ WUAA09 P 90 Date parameter
C 90 MOVEL'Y2U0510' W0RTN
C END
C MOVE WUAA09 ZDACCS Date Effective
C Z-ADD13 YRSW00
C Z-ADD13 ZQ 50
C YRSW00 IFLT 1
C ZQ ORLT 1
C YRSW00 ORGT 00025
C ZQ ORGT 00025
C MOVEL'Y2U0510' W0RTN
C ELSE
C YRSW00 SUBSTWUHDTX:ZQ WUADX9 P 90 work field 13 c
C 90 MOVEL'Y2U0510' W0RTN
C END
C MOVE WUADX9 ZDAC87 Total Invoice A
C MOVEL'1' WUAAMK Print details?
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
* EXT:Cnvt to alt (13.2) - Z-Generic Programs *
C CALL 'AMBUYXFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM ZDAENB WQ0130 20 Company number
C PARM WUAAM5 WQ0131 3 Currency ID
C ZDAC87 PARM ZDAC87 WQ0132 132 &Amount (13.2)
C PARM WUZ0YH WQ0133 3 Alternate curre
C WUAAKC PARM *BLANK WQ0134 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBUYXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C END *FI
C ELSE
* CASE: *OTHERWISE
C MOVEL*BLANK ZDAFD5 Text Line Descr
C END *FI
C END *FI
* Positive line item sequence (non IFM)
* CASE: DB1.Comment line sequence no. is Greater than -100
C WBKBNB IFGT -100 *IF
* Greater than -100, less than zero is Complementary Invoice commen
* If 2 or 3 lines up, concat comments
* CASE: DB1.Text line print control is 2 or 3 lines up
C WBAD1N IFEQ '2' *IF
C WBAD1N OREQ '3'
C ZDKBNB ADD 1 WUKBNB Comment line se
* RTV:Build lines up header - History Comment *
C EXSR SQRVGN
* Reposition the history comment file
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* CASE: WRK.Comment line seq no. USR is Zero
C WUAFD6 IFEQ *ZERO *IF
C Z-ADDZDKBNB WUAFD6 Comment line se
C END *FI
* RTV:Reposition ptr - History Comment *
C EXSR SRRVGN
C END *FI
C END *FI
C END *FI
C W0PFM IFEQ 'Y'
* Convert fields to external form
* Convert Date Effective USR to display format
* Convert date
C 1000000 ADD ZDACCS XDINDT
C EXSR XDVC2T
C Z-ADDXDEXDT VDACCS
C MOVEL'0' *IN79
C WUAAMK IFEQ '0' *IF
C MOVEL'1' *IN79
C END *FI
* Print column headings if required
C W0BCDT IFEQ 'Y'
C WRITEZDCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0BCDT
C END FI
* Print format
C WRITEZDDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0BPDT
C END FI
* Print First Page Format of PRO:Acknowledgement Lines
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0CP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0CP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0CP1P
* Clear first page flag.
C MOVE *BLANK W0CL1P
C END FI
* Print Company number of PRO:Acknowledgement Lines
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0CP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0CP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0CP00
C END FI
* Print Internal header type of PRO:Acknowledgement Lines
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0CP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0CP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0CP01
C END FI
* Print Quote/order number of PRO:Acknowledgement Lines
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0CP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0CP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0CP02
C END FI
* Print User entered sequence no. of PRO:Acknowledgement Lines
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0CP03 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0CP03 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0CP03
C END FI
* Print System sequence # of PRO:Acknowledgement Lines
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0CP04 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0CP04 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0CP04
C END FI
* Print Detail line. of PRO:Acknowledgement Lines
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0CCDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0CPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0CPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
* RTV:Ext. Doc. Print Opt. - Substitution XREF *
C EXSR STRVGN
* Set up substitution line
* CASE: CUR.Original item number is Not Blank
C ZFAALM IFNE *BLANK *IF
* CASE: WRK.External doc print option is Print original item only
C WUHIST IFEQ '2' *IF
C MOVELZFAALM ZFAITX Item number
C MOVEL*BLANK ZFAALM Original item n
* RTV:Item Description - ITEM MASTER *
* Move input parameters to subroutine local variables.
C MOVELZFAITX WL0001 P Item number
C EXSR SURVGN
* Move subroutine local variables to output parameters.
C MOVELWL0002 ZFALTX P Item descriptio
C ELSE
* CASE: WRK.External doc print option is Print sub item only
C WUHIST IFEQ '3' *IF
C MOVEL*BLANK ZFAALM Original item n
C END *FI
C END *FI
C END *FI
* Display kit message if applicable
* CASE: CUR.Kit item is Yes
C ZFH2ST IFEQ '1' *IF
C MOVEL'1' WUILST Kit/component i
C MOVEL'0' WUILST Kit/component i
* RTV:Kit Ext Doc Print Opt - Item Master Extension *
C EXSR SVRVGN
C END *FI
* Get non-inventory information if necessary, otherwise - warehouse
* CASE: CUR.Item number is Blank
C ZFAITX IFEQ *BLANK *IF
* RTV:Get Itm info- ack/qte - Non-Inventoried Item *
C EXSR SWRVGN
C MOVELCDAAYB ZFABA5 Location in war
C ELSE
* CASE: *OTHERWISE
* RTV:Stock Location - ITEM BALANCE *
C EXSR SXRVGN
* RTV:Description & U/M - ITEM MASTER *
C EXSR SYRVGN
C END *FI
* Set up the customer or industry item number.
* CASE: CUR.Customer item number is Not Blank
C ZFHJTX IFNE *BLANK *IF
C MOVEL*BLANK ZFAAWM Customer/item d
* Customer/item desc. DRV
* EXT:Get customer/item dsc - Customer/Item XREF *
C CALL 'AMBM3XFR' 90 EXT:Get custome
C PARM *BLANK W0RTN 7
C PARM ZFAENB WQ0135 20 Company number
C PARM ZFCANB WQ0136 80 Customer number
C PARM ZFHJTX WQ0137 30 Customer item n
C ZFAAWM PARM *BLANK WQ0138 30 Customer item d
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBM3XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* this was moved into the external because of # of file limitation.
C ELSE
* CASE: DB1.Industry item number is Not Blank
C CDH2TX IFNE *BLANK *IF
C MOVELCDH2TX ZFHJTX Customer item n
* RTV:Industry Item Desc - Item/Industry Class XREF *
C EXSR SZRVGN
C END *FI
C END *FI
* Set the foreign description if necessary.
* CASE: DB1.Language code is Default local language
C CDAKCD IFEQ '001' *IF
C MOVELZFALTX ZFABZW Foreign descrip
C ELSE
* CASE: *OTHERWISE
* Only for inventoried items.
* CASE: DB1.Item number is Not Blank
C CDAITX IFNE *BLANK *IF
C MOVEL*BLANK ZFABZW Foreign descrip
* Foreign description USR
* RTV: Item foreign desc - ITEM FOREIGN LANGUAGE *
C EXSR TARVGN
* If blank, use foreign default.
* CASE: CUR.Foreign description USR is Blank
C ZFABZW IFEQ *BLANK *IF
C MOVEL*BLANK ZFABZW Foreign descrip
* Foreign description USR
* RTV: Item foreign desc - ITEM FOREIGN LANGUAGE *
C EXSR TBRVGN
* If blank, use local.
* CASE: CUR.Foreign description USR is Blank
C ZFABZW IFEQ *BLANK *IF
C MOVELZFALTX ZFABZW Foreign descrip
C END *FI
C END *FI
C END *FI
C END *FI
* If foreign language only, blank out the local.
* CASE: Blank out one language desc. if necessary.
* - c1 OR c2
* |- c1 : PAR.Invoice language format is Foreign language only
* |- c2 : DB1.Language code is Default local language
* '-
C C6BDST IFEQ '1' *IF
C CDAKCD OREQ '001' *OR
C MOVEL*BLANK ZFALTX Item descriptio
C END *FI
* Has the line item ship to been overridden?
* CASE: CUR.Ship to number override is Not blank
C ZFABAZ IFNE *BLANK *IF
* ** Get Alpha_sort_name and Shipment_lead_time.
* RTV: All fields - Ship to *
C EXSR TCRVGN
C ELSE
* CASE: *OTHERWISE
C MOVEL*BLANK ZFAA66 Ship to name US
C Z-ADDWUEENB WN0015 Shipment lead t
C END *FI
* Price conversion necessary?
* CASE: CUR.Unit of measure code NE CUR.Pricing unit of measure 1
C ZFCQCD IFNE ZFDGCD *IF
C MOVEL'1' WUACLA Price conversio
C Z-ADDZFKHVA ZFACRM Selling price p
* EXT:U/M Convs'n Text Dflt - Item U/M Conversion Text *
C CALL 'AMBFPXFR' 90 EXT:U/M Convs'n
C PARM *BLANK W0RTN 7
C PARM CDAKCD WQ0139 3 Language code
C PARM ZFAITX WQ0140 15 Item number
C PARM ZFDGCD WQ0141 2 Dimension U/M
C PARM ZFCQCD WQ0142 2 To unit of meas
C ZFABYZ PARM *BLANK WQ0143 30 Item U/M conver
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBFPXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
* EXT:Cnvt to alt (15.3) - Z-Generic Programs *
C CALL 'AMBUWXFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM ZFAENB WQ0144 20 Company number
C PARM CDBRCD WQ0145 3 Currency ID
C ZFACRM PARM ZFACRM WQ0146 153 &Price
C PARM WUZ0YH WQ0147 3 Alternate curre
C WUAAKC PARM *BLANK WQ0148 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBUWXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C END *FI
C ELSE
* CASE: *OTHERWISE
C Z-ADD*ZERO ZFACRM Selling price p
C MOVEL'0' WUACLA Price conversio
C END *FI
* RTV:Dates 1st open rlse - Release *
C EXSR TDRVGN
* Load dates from release file.
* CASE: *OTHERWISE
C Z-ADDWUBJDT ZFAA35 Request date (u
* ** The Promise_date_(usr) field prints next to the title
* 'SHIP' on the acknowledgement. The 'shipment date' is
* really the 'promise date' less the customer's Ship to's
* shipment lead time.
C Z-ADD*ZERO WN0018 70 Manufacture due
C MOVEL*BLANK WN0019 1 Manuf due date
C MOVEL*BLANK WN0020 2 Calendar ID
C Z-ADD*ZERO WN0021 70 To calendar dat
C MOVEL*BLANK WN0022 1 Add days return
* INT:MfgDueDte from Reqst
* ** The entire processing is enclosed in a sequence so that if
* a calendar error is encountered, the processing can *QUIT to
* the end of this routine. In such a case, the output
* manufacturing due date is set equal to the request date.
* Processing
C EXSR UESUBR Processing
* If the ship date is less than today, make it today.
* CASE: CUR.Promise date (usr) LT JOB.*Job date
C ZFAAT0 IFLT ZZJDT *IF
C Z-ADDZZJDT ZFAAT0 Promise date (u
C END *FI
* Set the quantity to print on the acknowledgement.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Test to see if re-calculation is necessary.
* RTV:Existence check - end - Shipment Header *
C EXSR TIRVGN
* Calculate open quantity?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* ** Calculate the quantity remaining available for
* shipment and print this on the report
C Z-ADD*ZERO WUACS7 Open release qt
* RTV:Total Open Rlse Qty - Release *
C EXSR TJRVGN
* ** Convert the open quantity from the Stocking U/M to the
* order U/M.
C Z-ADD*ZERO WN0026 95 From quantity
C Z-ADD*ZERO WN0027 95 To quantity
C MOVEL*BLANK WN0028 1 Rounding option
C MOVEL*BLANK WN0029256 +P#MSDT Edit Me
C MOVEL*BLANK WN0030 65 +P#MSFL Edit Me
* INT:Quantity Cnv 3:3
* Program information.
* CASE: *OTHERWISE
* ** The 3:3 refers to the decimal places of the input and output.
* ** Conversion is between 10.3 quantity fields.
* Multiply by a 9.5 and divide by a 9.5 to get there.
* ** Intermediate result of the multiplication:
* A 10.3 times a 9.5 has a result with 7+4=11 to the left
* of the decimal, and 3+5=8 to the right; result is 19.8.
* ** The division to calculate the output field will be performed
* into a work field with 4 decimal places, truncated.
* The work field will be rounded as necessary into the 10.3 fiel
* ** The 4th decimal position is
* sufficient for "round to nearest", and is by design sufficient
* for the "round up" rounding option.
* Explanation of calculation.
* CASE: *OTHERWISE
* ** (In the discussion, "from qty" and "to qty" make up the
* conversion ratio retrieved from the conversion files.)
* ** From qty:To qty = 1 box:10 each = conversion from: conv.t
* ** QUANTITY math is like this:
* Cross-multiplication from qty x conv to = to qty x conv fr
* So, conv to = ( to qty x conv from ) / ( from qty )
* To determine the quantity, in boxes, of 200 each,
* 20 boxes = ( 1 box x 200 each ) / ( 10 each )
* ** WEIGHT conversion is a quantity conversion.
* ** PRICE conversion is a "per quantity" conversion; a different
* function (very similar to this one) does that calculation.
C MOVEL'0' WUACV9 Overflow? USR
* If the from u/m code is blank, set it to the to u/m code.
* CASE: PAR.Unit of measure code is Blank
C CDDHCD IFEQ *BLANK *IF
C MOVELZFCQCD WUCQCD Dimension U/M
C ELSE
* CASE: *OTHERWISE
C MOVELCDDHCD WUCQCD Dimension U/M
C END *FI
* Perform calculations?
* CASE: PAR.To unit of measure 3 NE WRK.Unit of measure code
C ZFCQCD IFNE WUCQCD *IF
* EXT:Get CnvRatio, Rnd Opt - Item U/M Conversion *
C CALL 'AMBJ6XFR' 90 EXT:Get CnvRati
C PARM *BLANK W0RTN 7
C PARM ZFAITX WQ0151 15 Item number
C PARM WUCQCD WQ0152 2 Dimension U/M
C PARM ZFCQCD WQ0153 2 To unit of meas
C WN0026 PARM *ZERO WQ0154 95 From quantity
C WN0027 PARM *ZERO WQ0155 95 To quantity
C WN0028 PARM *BLANK WQ0156 1 Rounding option
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBJ6XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* Apply conversion ratio?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* ** Multiply and divide; result to be rounded.
C WN0027 MULT WUACS7 WUKTVA &Amount 19.8
C WUKTVA DIV WN0026 WUACWQ Work number 20.
* Overflows the 10.3 output field?
* CASE: OVERFLOW:
* - c1 OR c2
* |- c1 : WRK.Work number 20.4 USR is Overflows 10.3 positive
* |- c2 : WRK.Work number 20.4 USR is Overflows 10.3 negative
* '-
C WUACWQ IFGT @C01,01 *IF
C WUACWQ ORLT @C01,02 *OR
C MOVEL'1' WUACV9 Overflow? USR
* ** Overflow is initialized to No at function initialization.
C END *FI
* Decimal precision and rounding.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Calulate into a WRK field to assure the proper size field is
* used for the result. Since this is an Internal, the field fro
* the CALLING function is actually used for the PAR, and it may
* be a different size from the declared PAR for this function.
* Load to WRK field using specified rounding option.
* CASE: PAR.Rounding option is No Rounding
C WN0028 IFEQ '0' *IF
C Z-ADDWUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: PAR.Rounding option is Round Up
C WN0028 IFEQ '2' *IF
* Load field which can bump up the result's 3rd decimal position.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Scale up the 4th decimal position to a value from 0 to 9.
C WUACWQ MULT 10000 WUABGP Work Number (1.
* Set the "round up" work field.
* CASE: WRK.Work Number (1.0) is Zero
C WUABGP IFEQ *ZERO *IF
C Z-ADD*ZERO WUWD *Synon (17,7) w
C ELSE
* CASE: *OTHERWISE
C Z-ADD0.001 WUWD *Synon (17,7) w
C END *FI
C END *FI
C WUWD ADD WUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: *OTHERWISE
* ** Otherwise round to nearest.
C WUACWQ MULT 1 WUACWA H Convert to 10.3
C END *FI
C END *FI
C Z-ADDWUACWA ZFACQT Convert to 10.3
C END *FI
* Send message?
* CASE: PAR.Message for good cnv USR is Informational
C '0' IFEQ '2' *IF
* ** No completion message has been defined.
C END *FI
C ELSE
* CASE: *OTHERWISE
* ** Otherwise the requested conversion has not been defined.
C Z-ADDWUACS7 ZFACQT Convert to 10.3
* Send message?
* CASE: PAR.Message for undfn cnv USR is Error
C '0' IFEQ '1' *IF
* Issue/Write error message.
* CASE: PAR.+P#PFPR Perform Process? is *Blanks
C *BLANK IFEQ *BLANK *IF
* Setup message data for message
C MOVELZFAITX ZA0001 Item number
C MOVELCDDHCD ZA0002 Dimension U/M
C MOVELZFCQCD ZA0003 To unit of meas
* Send message 'U/M cnv undefn for item'
C MOVEL'AMB2242' ZAMSID
C EXSR ZASNMS
C SETON 99 *
C ELSE
* CASE: *OTHERWISE
* Get value of the field and field name used by client.
* CASE: *OTHERWISE
* +INT: Init msg file/dta
* PAR = CON By name
C MOVEL*BLANK WN0029 +P#MSDT Edit Me
C MOVEL*BLANK WN0030 +P#MSFL Edit Me
C Z-ADD*ZERO ZQ 50
C WN0029 CAT ' ':ZQ WN0029 P +P#MSDT Edit Me
C Z-ADD*ZERO ZQ 50
C WN0030 CAT ' ':ZQ WN0030 P +P#MSFL Edit Me
* Message Service program - Z-Generic Programs *
C CALL 'AXPEMP1R' 90 Message Service
C PARM *BLANK WQ0157 8 +P#PFPR Perform
C PARM *BLANK WQ0158 8 +P#SHDN Shutdow
C PARM *BLANK WQ0159 10 +P#TSTK Task To
C PARM 'AMB2242' WQ0160 7 +P1MSID Edit Me
C PARM WN0029 WQ0161256 +P#MSDT Edit Me
C PARM 'MBMESSGE'WQ0162 10 +P#MSFN Edit Me
C PARM '*ERROR' WQ0163 8 +P#MSCL Edit Me
C PARM WN0030 WQ0164 65 +P#MSFL Edit Me
C PARM *BLANK WQ0165 7 +P#MSID Message
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AXPEMP1R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C MOVEL'1' WUABNV +P#ERED Found E
C END *FI
C ELSE
* CASE: PAR.Message for undfn cnv USR is Informational
C '0' IFEQ '2' *IF
* Issue/Write infor message.
* CASE: PAR.+P#PFPR Perform Process? is *Blanks
C *BLANK IFEQ *BLANK *IF
* Setup message data for message
C MOVELZFAITX ZA0004 Item number
C MOVELCDDHCD ZA0005 Dimension U/M
C MOVELZFCQCD ZA0006 To unit of meas
* Send message 'U/M cnv undefn for item I'
C MOVEL'AMB2243' ZAMSID
C MOVEL'*INFO ' ZAMSTP Message type
C EXSR ZASNMS
C ELSE
* CASE: *OTHERWISE
* Get value of the field and field name used by client.
* CASE: *OTHERWISE
* +INT: Init msg file/dta
* PAR = CON By name
C MOVEL*BLANK WN0029 +P#MSDT Edit Me
C MOVEL*BLANK WN0030 +P#MSFL Edit Me
C Z-ADD*ZERO ZQ 50
C WN0029 CAT ' ':ZQ WN0029 P +P#MSDT Edit Me
C Z-ADD*ZERO ZQ 50
C WN0030 CAT ' ':ZQ WN0030 P +P#MSFL Edit Me
* Message Service program - Z-Generic Programs *
C CALL 'AXPEMP1R' 90 Message Service
C PARM *BLANK WQ0166 8 +P#PFPR Perform
C PARM *BLANK WQ0167 8 +P#SHDN Shutdow
C PARM *BLANK WQ0168 10 +P#TSTK Task To
C PARM 'AMB2243' WQ0169 7 +P1MSID Edit Me
C PARM WN0029 WQ0170256 +P#MSDT Edit Me
C PARM 'MBMESSGE'WQ0171 10 +P#MSFN Edit Me
C PARM '*WARNING'WQ0172 8 +P#MSCL Edit Me
C PARM WN0030 WQ0173 65 +P#MSFL Edit Me
C PARM *BLANK WQ0174 7 +P#MSID Message
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AXPEMP1R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C END *FI
C END *FI
C END *FI
C END *FI
C ELSE
* CASE: *OTHERWISE
* ** Otherwise the U/Ms are the same.
C Z-ADDWUACS7 ZFACQT Convert to 10.3
C END *FI
* ** PGM.*Return code will indicate if the conversion was undefined
C ELSE
* CASE: *OTHERWISE
C Z-ADDCDACQT ZFACQT Order qty in or
C END *FI
C END *FI
* Set the Selling_price/Net_sales.
* CASE: *OTHERWISE
* Selling price in order u/m.
* CASE: PAR.Tax in price flag is Tax in price - list
C P5Z9JB IFEQ '1' *IF
C Z-ADDZFZ9QK ZFACK0 Sel-prc ord u/m
C ELSE
* CASE: *OTHERWISE
C Z-ADDZFDOVA ZFACK0 Sel-prc ord u/m
C END *FI
* Net sales amount.
* CASE: PAR.Tax in price flag is Tax in price - list
C P5Z9JB IFEQ '1' *IF
C Z-ADDZFZ9QH WUDPVA Net sales amoun
C ELSE
* CASE: *OTHERWISE
C Z-ADDZFDPVA WUDPVA Net sales amoun
C END *FI
* Calculate new Net_sales_amount?
* CASE: CUR.Order qty in order u/m EQ DB1.Order qty in order u/m
C ZFACQT IFEQ CDACQT *IF
* ** No activity - no re-calculations.
C WUDPVA MULT 1 ZFACRN H Net sales amoun
C ADD ZFACRN WUAB1X Net sales amoun
C Z-ADDWUAB1X WUAB1X Net sales amoun
C ELSE
* CASE: CUR.Order qty in order u/m is Not zero
C ZFACQT IFNE *ZERO *IF
* ** No need for local currency calculation.
C Z-ADD*ZERO WN0031 103 Open release qt
C Z-ADD*ZERO WN0032 103 Order qty in or
C Z-ADD*ZERO WN0033 177 Converted selli
C Z-ADD*ZERO WN0034 194 Conversion from
* INT:Re-calc Net Sales Amt
* Calculate the open quantity.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** If some shipment activity has taken place against this
* Line Item then calculate the quantity available for
* shipment.
* ** Retrieve/calculate the open quantity in the stocking U/M.
C Z-ADD*ZERO WN0031 Open release qt
* RTV:Total Open Rlse Qty - Release *
C EXSR TKRVGN
* ** Convert quantity from the Stocking UM to Order UM.
C Z-ADD*ZERO WN0035 95 From quantity
C Z-ADD*ZERO WN0036 95 To quantity
C MOVEL*BLANK WN0037 1 Rounding option
C MOVEL*BLANK WN0038256 +P#MSDT Edit Me
C MOVEL*BLANK WN0039 65 +P#MSFL Edit Me
* INT:Quantity Cnv 3:3
* Program information.
* CASE: *OTHERWISE
* ** The 3:3 refers to the decimal places of the input and output.
* ** Conversion is between 10.3 quantity fields.
* Multiply by a 9.5 and divide by a 9.5 to get there.
* ** Intermediate result of the multiplication:
* A 10.3 times a 9.5 has a result with 7+4=11 to the left
* of the decimal, and 3+5=8 to the right; result is 19.8.
* ** The division to calculate the output field will be performed
* into a work field with 4 decimal places, truncated.
* The work field will be rounded as necessary into the 10.3 fiel
* ** The 4th decimal position is
* sufficient for "round to nearest", and is by design sufficient
* for the "round up" rounding option.
* Explanation of calculation.
* CASE: *OTHERWISE
* ** (In the discussion, "from qty" and "to qty" make up the
* conversion ratio retrieved from the conversion files.)
* ** From qty:To qty = 1 box:10 each = conversion from: conv.t
* ** QUANTITY math is like this:
* Cross-multiplication from qty x conv to = to qty x conv fr
* So, conv to = ( to qty x conv from ) / ( from qty )
* To determine the quantity, in boxes, of 200 each,
* 20 boxes = ( 1 box x 200 each ) / ( 10 each )
* ** WEIGHT conversion is a quantity conversion.
* ** PRICE conversion is a "per quantity" conversion; a different
* function (very similar to this one) does that calculation.
C MOVEL'0' WUACV9 Overflow? USR
* If the from u/m code is blank, set it to the to u/m code.
* CASE: PAR.Unit of measure code is Blank
C CDDHCD IFEQ *BLANK *IF
C MOVELZFCQCD WUCQCD Dimension U/M
C ELSE
* CASE: *OTHERWISE
C MOVELCDDHCD WUCQCD Dimension U/M
C END *FI
* Perform calculations?
* CASE: PAR.To unit of measure 3 NE WRK.Unit of measure code
C ZFCQCD IFNE WUCQCD *IF
* EXT:Get CnvRatio, Rnd Opt - Item U/M Conversion *
C CALL 'AMBJ6XFR' 90 EXT:Get CnvRati
C PARM *BLANK W0RTN 7
C PARM ZFAITX WQ0175 15 Item number
C PARM WUCQCD WQ0176 2 Dimension U/M
C PARM ZFCQCD WQ0177 2 To unit of meas
C WN0035 PARM *ZERO WQ0178 95 From quantity
C WN0036 PARM *ZERO WQ0179 95 To quantity
C WN0037 PARM *BLANK WQ0180 1 Rounding option
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBJ6XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* Apply conversion ratio?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* ** Multiply and divide; result to be rounded.
C WN0036 MULT WN0031 WUKTVA &Amount 19.8
C WUKTVA DIV WN0035 WUACWQ Work number 20.
* Overflows the 10.3 output field?
* CASE: OVERFLOW:
* - c1 OR c2
* |- c1 : WRK.Work number 20.4 USR is Overflows 10.3 positive
* |- c2 : WRK.Work number 20.4 USR is Overflows 10.3 negative
* '-
C WUACWQ IFGT @C01,01 *IF
C WUACWQ ORLT @C01,02 *OR
C MOVEL'1' WUACV9 Overflow? USR
* ** Overflow is initialized to No at function initialization.
C END *FI
* Decimal precision and rounding.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Calulate into a WRK field to assure the proper size field is
* used for the result. Since this is an Internal, the field fro
* the CALLING function is actually used for the PAR, and it may
* be a different size from the declared PAR for this function.
* Load to WRK field using specified rounding option.
* CASE: PAR.Rounding option is No Rounding
C WN0037 IFEQ '0' *IF
C Z-ADDWUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: PAR.Rounding option is Round Up
C WN0037 IFEQ '2' *IF
* Load field which can bump up the result's 3rd decimal position.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Scale up the 4th decimal position to a value from 0 to 9.
C WUACWQ MULT 10000 WUABGP Work Number (1.
* Set the "round up" work field.
* CASE: WRK.Work Number (1.0) is Zero
C WUABGP IFEQ *ZERO *IF
C Z-ADD*ZERO WUWD *Synon (17,7) w
C ELSE
* CASE: *OTHERWISE
C Z-ADD0.001 WUWD *Synon (17,7) w
C END *FI
C END *FI
C WUWD ADD WUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: *OTHERWISE
* ** Otherwise round to nearest.
C WUACWQ MULT 1 WUACWA H Convert to 10.3
C END *FI
C END *FI
C Z-ADDWUACWA WN0032 Convert to 10.3
C END *FI
* Send message?
* CASE: PAR.Message for good cnv USR is Informational
C '0' IFEQ '2' *IF
* ** No completion message has been defined.
C END *FI
C ELSE
* CASE: *OTHERWISE
* ** Otherwise the requested conversion has not been defined.
C Z-ADDWN0031 WN0032 Convert to 10.3
* Send message?
* CASE: PAR.Message for undfn cnv USR is Error
C '0' IFEQ '1' *IF
* Issue/Write error message.
* CASE: PAR.+P#PFPR Perform Process? is *Blanks
C *BLANK IFEQ *BLANK *IF
* Setup message data for message
C MOVELZFAITX ZA0007 Item number
C MOVELCDDHCD ZA0008 Dimension U/M
C MOVELZFCQCD ZA0009 To unit of meas
* Send message 'U/M cnv undefn for item'
C MOVEL'AMB2242' ZAMSID
C EXSR ZASNMS
C SETON 99 *
C ELSE
* CASE: *OTHERWISE
* Get value of the field and field name used by client.
* CASE: *OTHERWISE
* +INT: Init msg file/dta
* PAR = CON By name
C MOVEL*BLANK WN0038 +P#MSDT Edit Me
C MOVEL*BLANK WN0039 +P#MSFL Edit Me
C Z-ADD*ZERO ZQ 50
C WN0038 CAT ' ':ZQ WN0038 P +P#MSDT Edit Me
C Z-ADD*ZERO ZQ 50
C WN0039 CAT ' ':ZQ WN0039 P +P#MSFL Edit Me
* Message Service program - Z-Generic Programs *
C CALL 'AXPEMP1R' 90 Message Service
C PARM *BLANK WQ0181 8 +P#PFPR Perform
C PARM *BLANK WQ0182 8 +P#SHDN Shutdow
C PARM *BLANK WQ0183 10 +P#TSTK Task To
C PARM 'AMB2242' WQ0184 7 +P1MSID Edit Me
C PARM WN0038 WQ0185256 +P#MSDT Edit Me
C PARM 'MBMESSGE'WQ0186 10 +P#MSFN Edit Me
C PARM '*ERROR' WQ0187 8 +P#MSCL Edit Me
C PARM WN0039 WQ0188 65 +P#MSFL Edit Me
C PARM *BLANK WQ0189 7 +P#MSID Message
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AXPEMP1R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C MOVEL'1' WUABNV +P#ERED Found E
C END *FI
C ELSE
* CASE: PAR.Message for undfn cnv USR is Informational
C '0' IFEQ '2' *IF
* Issue/Write infor message.
* CASE: PAR.+P#PFPR Perform Process? is *Blanks
C *BLANK IFEQ *BLANK *IF
* Setup message data for message
C MOVELZFAITX ZA0010 Item number
C MOVELCDDHCD ZA0011 Dimension U/M
C MOVELZFCQCD ZA0012 To unit of meas
* Send message 'U/M cnv undefn for item I'
C MOVEL'AMB2243' ZAMSID
C MOVEL'*INFO ' ZAMSTP Message type
C EXSR ZASNMS
C ELSE
* CASE: *OTHERWISE
* Get value of the field and field name used by client.
* CASE: *OTHERWISE
* +INT: Init msg file/dta
* PAR = CON By name
C MOVEL*BLANK WN0038 +P#MSDT Edit Me
C MOVEL*BLANK WN0039 +P#MSFL Edit Me
C Z-ADD*ZERO ZQ 50
C WN0038 CAT ' ':ZQ WN0038 P +P#MSDT Edit Me
C Z-ADD*ZERO ZQ 50
C WN0039 CAT ' ':ZQ WN0039 P +P#MSFL Edit Me
* Message Service program - Z-Generic Programs *
C CALL 'AXPEMP1R' 90 Message Service
C PARM *BLANK WQ0190 8 +P#PFPR Perform
C PARM *BLANK WQ0191 8 +P#SHDN Shutdow
C PARM *BLANK WQ0192 10 +P#TSTK Task To
C PARM 'AMB2243' WQ0193 7 +P1MSID Edit Me
C PARM WN0038 WQ0194256 +P#MSDT Edit Me
C PARM 'MBMESSGE'WQ0195 10 +P#MSFN Edit Me
C PARM '*WARNING'WQ0196 8 +P#MSCL Edit Me
C PARM WN0039 WQ0197 65 +P#MSFL Edit Me
C PARM *BLANK WQ0198 7 +P#MSID Message
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AXPEMP1R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C END *FI
C END *FI
C END *FI
C END *FI
C ELSE
* CASE: *OTHERWISE
* ** Otherwise the U/Ms are the same.
C Z-ADDWN0031 WN0032 Convert to 10.3
C END *FI
* ** PGM.*Return code will indicate if the conversion was undefined
C END *FI
* Calculate new Net_sales_amount?
* CASE: PAR.Ord ship not inv flg USR is Yes
C WUZ9DA IFEQ '1' *IF
* CASE: PAR.Order qty in ord U/M USR is Not zero
C WN0032 IFNE *ZERO *IF
* ** Partially shipped - re-calculate.
* Determine the Selling_price_in_ord_U/M.
* CASE: PAR.Price source code is Net sales overridden
C CDH4ST IFEQ '4' *IF
* RTV:Non-Invoiced Rlse Qty - Release *
C EXSR TLRVGN
* ** Convert quantity from the Stocking UM to the Order UM.
C Z-ADD*ZERO WN0040 95 From quantity
C Z-ADD*ZERO WN0041 95 To quantity
C MOVEL*BLANK WN0042 1 Rounding option
C MOVEL*BLANK WN0043256 +P#MSDT Edit Me
C MOVEL*BLANK WN0044 65 +P#MSFL Edit Me
* INT:Quantity Cnv 3:3
* Program information.
* CASE: *OTHERWISE
* ** The 3:3 refers to the decimal places of the input and output.
* ** Conversion is between 10.3 quantity fields.
* Multiply by a 9.5 and divide by a 9.5 to get there.
* ** Intermediate result of the multiplication:
* A 10.3 times a 9.5 has a result with 7+4=11 to the left
* of the decimal, and 3+5=8 to the right; result is 19.8.
* ** The division to calculate the output field will be performed
* into a work field with 4 decimal places, truncated.
* The work field will be rounded as necessary into the 10.3 fiel
* ** The 4th decimal position is
* sufficient for "round to nearest", and is by design sufficient
* for the "round up" rounding option.
* Explanation of calculation.
* CASE: *OTHERWISE
* ** (In the discussion, "from qty" and "to qty" make up the
* conversion ratio retrieved from the conversion files.)
* ** From qty:To qty = 1 box:10 each = conversion from: conv.t
* ** QUANTITY math is like this:
* Cross-multiplication from qty x conv to = to qty x conv fr
* So, conv to = ( to qty x conv from ) / ( from qty )
* To determine the quantity, in boxes, of 200 each,
* 20 boxes = ( 1 box x 200 each ) / ( 10 each )
* ** WEIGHT conversion is a quantity conversion.
* ** PRICE conversion is a "per quantity" conversion; a different
* function (very similar to this one) does that calculation.
C MOVEL'0' WUACV9 Overflow? USR
* If the from u/m code is blank, set it to the to u/m code.
* CASE: PAR.Unit of measure code is Blank
C CDDHCD IFEQ *BLANK *IF
C MOVELZFCQCD WUCQCD Dimension U/M
C ELSE
* CASE: *OTHERWISE
C MOVELCDDHCD WUCQCD Dimension U/M
C END *FI
* Perform calculations?
* CASE: PAR.To unit of measure 3 NE WRK.Unit of measure code
C ZFCQCD IFNE WUCQCD *IF
* EXT:Get CnvRatio, Rnd Opt - Item U/M Conversion *
C CALL 'AMBJ6XFR' 90 EXT:Get CnvRati
C PARM *BLANK W0RTN 7
C PARM ZFAITX WQ0199 15 Item number
C PARM WUCQCD WQ0200 2 Dimension U/M
C PARM ZFCQCD WQ0201 2 To unit of meas
C WN0040 PARM *ZERO WQ0202 95 From quantity
C WN0041 PARM *ZERO WQ0203 95 To quantity
C WN0042 PARM *BLANK WQ0204 1 Rounding option
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBJ6XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* Apply conversion ratio?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* ** Multiply and divide; result to be rounded.
C WN0041 MULT WN0031 WUKTVA &Amount 19.8
C WUKTVA DIV WN0040 WUACWQ Work number 20.
* Overflows the 10.3 output field?
* CASE: OVERFLOW:
* - c1 OR c2
* |- c1 : WRK.Work number 20.4 USR is Overflows 10.3 positive
* |- c2 : WRK.Work number 20.4 USR is Overflows 10.3 negative
* '-
C WUACWQ IFGT @C01,01 *IF
C WUACWQ ORLT @C01,02 *OR
C MOVEL'1' WUACV9 Overflow? USR
* ** Overflow is initialized to No at function initialization.
C END *FI
* Decimal precision and rounding.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Calulate into a WRK field to assure the proper size field is
* used for the result. Since this is an Internal, the field fro
* the CALLING function is actually used for the PAR, and it may
* be a different size from the declared PAR for this function.
* Load to WRK field using specified rounding option.
* CASE: PAR.Rounding option is No Rounding
C WN0042 IFEQ '0' *IF
C Z-ADDWUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: PAR.Rounding option is Round Up
C WN0042 IFEQ '2' *IF
* Load field which can bump up the result's 3rd decimal position.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Scale up the 4th decimal position to a value from 0 to 9.
C WUACWQ MULT 10000 WUABGP Work Number (1.
* Set the "round up" work field.
* CASE: WRK.Work Number (1.0) is Zero
C WUABGP IFEQ *ZERO *IF
C Z-ADD*ZERO WUWD *Synon (17,7) w
C ELSE
* CASE: *OTHERWISE
C Z-ADD0.001 WUWD *Synon (17,7) w
C END *FI
C END *FI
C WUWD ADD WUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: *OTHERWISE
* ** Otherwise round to nearest.
C WUACWQ MULT 1 WUACWA H Convert to 10.3
C END *FI
C END *FI
C Z-ADDWUACWA WN0031 Convert to 10.3
C END *FI
* Send message?
* CASE: PAR.Message for good cnv USR is Informational
C '0' IFEQ '2' *IF
* ** No completion message has been defined.
C END *FI
C ELSE
* CASE: *OTHERWISE
* ** Otherwise the requested conversion has not been defined.
C Z-ADDWN0031 WN0031 Convert to 10.3
* Send message?
* CASE: PAR.Message for undfn cnv USR is Error
C '0' IFEQ '1' *IF
* Issue/Write error message.
* CASE: PAR.+P#PFPR Perform Process? is *Blanks
C *BLANK IFEQ *BLANK *IF
* Setup message data for message
C MOVELZFAITX ZA0013 Item number
C MOVELCDDHCD ZA0014 Dimension U/M
C MOVELZFCQCD ZA0015 To unit of meas
* Send message 'U/M cnv undefn for item'
C MOVEL'AMB2242' ZAMSID
C EXSR ZASNMS
C SETON 99 *
C ELSE
* CASE: *OTHERWISE
* Get value of the field and field name used by client.
* CASE: *OTHERWISE
* +INT: Init msg file/dta
* PAR = CON By name
C MOVEL*BLANK WN0043 +P#MSDT Edit Me
C MOVEL*BLANK WN0044 +P#MSFL Edit Me
C Z-ADD*ZERO ZQ 50
C WN0043 CAT ' ':ZQ WN0043 P +P#MSDT Edit Me
C Z-ADD*ZERO ZQ 50
C WN0044 CAT ' ':ZQ WN0044 P +P#MSFL Edit Me
* Message Service program - Z-Generic Programs *
C CALL 'AXPEMP1R' 90 Message Service
C PARM *BLANK WQ0205 8 +P#PFPR Perform
C PARM *BLANK WQ0206 8 +P#SHDN Shutdow
C PARM *BLANK WQ0207 10 +P#TSTK Task To
C PARM 'AMB2242' WQ0208 7 +P1MSID Edit Me
C PARM WN0043 WQ0209256 +P#MSDT Edit Me
C PARM 'MBMESSGE'WQ0210 10 +P#MSFN Edit Me
C PARM '*ERROR' WQ0211 8 +P#MSCL Edit Me
C PARM WN0044 WQ0212 65 +P#MSFL Edit Me
C PARM *BLANK WQ0213 7 +P#MSID Message
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AXPEMP1R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C MOVEL'1' WUABNV +P#ERED Found E
C END *FI
C ELSE
* CASE: PAR.Message for undfn cnv USR is Informational
C '0' IFEQ '2' *IF
* Issue/Write infor message.
* CASE: PAR.+P#PFPR Perform Process? is *Blanks
C *BLANK IFEQ *BLANK *IF
* Setup message data for message
C MOVELZFAITX ZA0016 Item number
C MOVELCDDHCD ZA0017 Dimension U/M
C MOVELZFCQCD ZA0018 To unit of meas
* Send message 'U/M cnv undefn for item I'
C MOVEL'AMB2243' ZAMSID
C MOVEL'*INFO ' ZAMSTP Message type
C EXSR ZASNMS
C ELSE
* CASE: *OTHERWISE
* Get value of the field and field name used by client.
* CASE: *OTHERWISE
* +INT: Init msg file/dta
* PAR = CON By name
C MOVEL*BLANK WN0043 +P#MSDT Edit Me
C MOVEL*BLANK WN0044 +P#MSFL Edit Me
C Z-ADD*ZERO ZQ 50
C WN0043 CAT ' ':ZQ WN0043 P +P#MSDT Edit Me
C Z-ADD*ZERO ZQ 50
C WN0044 CAT ' ':ZQ WN0044 P +P#MSFL Edit Me
* Message Service program - Z-Generic Programs *
C CALL 'AXPEMP1R' 90 Message Service
C PARM *BLANK WQ0214 8 +P#PFPR Perform
C PARM *BLANK WQ0215 8 +P#SHDN Shutdow
C PARM *BLANK WQ0216 10 +P#TSTK Task To
C PARM 'AMB2243' WQ0217 7 +P1MSID Edit Me
C PARM WN0043 WQ0218256 +P#MSDT Edit Me
C PARM 'MBMESSGE'WQ0219 10 +P#MSFN Edit Me
C PARM '*WARNING'WQ0220 8 +P#MSCL Edit Me
C PARM WN0044 WQ0221 65 +P#MSFL Edit Me
C PARM *BLANK WQ0222 7 +P#MSID Message
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AXPEMP1R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C END *FI
C END *FI
C END *FI
C END *FI
C ELSE
* CASE: *OTHERWISE
* ** Otherwise the U/Ms are the same.
C Z-ADDWN0031 WN0031 Convert to 10.3
C END *FI
* ** PGM.*Return code will indicate if the conversion was undefined
* Avoid divide by zero.
* CASE: PAR.Open release qty tot USR is Zero
C WN0031 IFEQ *ZERO *IF
C WUDPVA DIV ZFACQT WN0033 Converted selli
C ELSE
* CASE: *OTHERWISE
C WUDPVA DIV WN0031 WN0033 H Converted selli
C END *FI
C ELSE
* CASE: *OTHERWISE
C Z-ADDZFACK0 WN0033 Converted selli
C END *FI
* Compute Net_sales_amount.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C WN0032 MULT WN0033 WUDPVA H Net sales amoun
C END *FI
* Set Net_sales_amount to correct decimal positions.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C Z-ADD*ZERO WN0045 10 Decimal positio
C Z-ADD*ZERO WN0046 20 Company number
C Z-ADD*ZERO WN0047 150 Price 15.0 USR
C Z-ADD*ZERO WN0048 152 Price 15.2 USR
* INT:Set Prc to Cur Dec Ps
* ** Depending on the currency in question the Price (15.3)
* field can either have:
* (a) two decimal places
* (b) no decimal places.
* Set Company_number for Currency retrieve.
* CASE: PAR.Currency ID is Blank
C *BLANK IFEQ *BLANK *IF
C Z-ADD*ZERO WN0046 Company number
C ELSE
* CASE: *OTHERWISE
C Z-ADDZFAENB WN0046 Company number
C END *FI
* INT:Get Currency Array
* ** The intent of this function is to reduce I/O to the Currency
* file by storing the data in a Synon array. The data
* is not only available within the program but also persists
* through invocations of the program, until the program is close
* ** This technique is similar to the one used to reduce SYSCTL I/O
* *** If IFM installed, only company 01 records exist.
C Z-ADDWN0046 WUAAQR Company number
* Check if IFM installed?
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0223 4 Application ali
C WUADVB PARM *BLANK WQ0224 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* If IFM installed, Currency file only has company 01 records.
* CASE:
* - c1 AND c2
* |- c1 : WRK.Installed apps - IFM is Installed
* |- c2 : WRK.Company number USR is Not equal 01
* '-
C MOVEL'0' Y0CX01 1
C WUADVB IFEQ '1' *IF
C WUAAQR IFNE 01 *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C Z-ADD01 WUAAQR Company number
C END *FI
* RTV:Currency File Array - *Arrays *
C EXSR TMRVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* Load Currency File Array - *Arrays *
C EXSR TNCRRC
* Retry the load?
* CASE:
* - NOT c1
* |- c1 : PGM.*Return code is *Normal
* '-
C MOVEL'0' Y0CX01 1
C W0RTN IFEQ *BLANK *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
* ** This error indicates the array is full.
* ** So, the foreign currency array elements are cleared to
* make room.
* ** The array size of 5 was chosen to limit the program's size
* but still handle quite a few currencies before running
* this exception handling.
* Clear Currency File Array - *Arrays *
C EXSR TRDLRC
* Load Currency File Array - *Arrays *
C EXSR TSCRRC
C END *FI
C END *FI
C MOVEL*BLANK W0RTN *Return code
* Set Price.
* CASE: PAR.Decimal positions is 0
C WN0045 IFEQ *ZERO *IF
C WUDPVA MULT 1 WN0047 H Price 15.0 USR
C WN0047 MULT 1 WUDPVA &Price
C ELSE
* CASE: PAR.Decimal positions is 2
C WN0045 IFEQ 2 *IF
C WUDPVA MULT 1 WN0048 H Price 15.2 USR
C WN0048 MULT 1 WUDPVA &Price
C END *FI
C END *FI
C END *FI
* Convert Net_sales_amount to local currency?
* CASE: PAR.Currency ID is Blank
C *BLANK IFEQ *BLANK *IF
C Z-ADDWUDPVA WUDUVA LC - net sales
C ELSE
* CASE: *OTHERWISE
* CASE: PAR.Net sales amount is Zero
C WUDPVA IFEQ *ZERO *IF
C Z-ADDWUDPVA WUDUVA LC - net sales
C ELSE
* CASE: *OTHERWISE
* Set fields for currency conversion.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C Z-ADD*ZERO WUD0NB Request date
C Z-ADD*ZERO WUGAVA Exchange rate 1
C MOVEL'1' WUAAKD Function (USR)
* Exchange rate (or Exchange rate date) overridden?
* CASE: PAR.Override exchange rate is Not zero
C *ZERO IFNE *ZERO *IF
C Z-ADD*ZERO WUD0NB Request date
C Z-ADD*ZERO WUGAVA Exchange rate 1
C MOVEL'2' WUAAKD Function (USR)
C ELSE
* CASE: *OTHERWISE
* Exchange rate date overridden?
* CASE: PAR.Override exch rate date is Not zero
C *ZERO IFNE *ZERO *IF
C Z-ADD*ZERO WUD0NB Request date
C Z-ADD*ZERO WUGAVA Exchange rate 1
C MOVEL'1' WUAAKD Function (USR)
C END *FI
C END *FI
C END *FI
* Convert currency.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* Currency Conversion AXZ40 - Z-Generic Programs *for LC-Net_sale
C CALL 'AXZ40' 90 Currency Conver
C PARM WUAAKD WQ0241 1 Function (USR)
C PARM ZFAENB WQ0242 20 Company number
C PARM *BLANK WQ0243 3 Currency ID
C PARM *ZERO WQ0244 70 Request date
C PARM '1' WQ0245 1 Conversion type
C PARM WUDPVA WQ0246 194 Amount converte
C WUAAKC PARM *BLANK WQ0247 1 Return code (US
C WUGAVA PARM WUGAVA WQ0248 116 Exchange rate 1
C WUAJNB PARM *ZERO WQ0249 10 Exchange rate c
C WUIKNB PARM *ZERO WQ0250 70 Effective date
C WUALNB PARM *BLANK WQ0251 15 AP exchange gai
C WUAMNB PARM *BLANK WQ0252 15 AR exchange gai
C WUA3TX PARM *BLANK WQ0253 15 Currency descri
C WUAGCD PARM *BLANK WQ0254 3 Primary currenc
C WUAKNB PARM *ZERO WQ0255 10 Decimal positio
C WN0034 PARM WN0034 WQ0256 194 Conversion from
C WUAAKG PARM *ZERO WQ0257 172 Rounded amount
C WUABVA PARM *ZERO WQ0258 52 Price adjustmen
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AXZ40' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Currency conversion overflow error?
* CASE: PAR.Conversion from (19.4) is Within 15.3 range
C WN0034 IFGE @C02,01 *IF
C WN0034 ANDLE@C02,02
* ** Don't round here, the number of decimal places is changed
* to be two or zero after this currency conversion.
C WN0034 MULT 1 WUDUVA LC - net sales
C ELSE
* CASE: *OTHERWISE
* Positive overflow.
* CASE: PAR.Conversion from (19.4) is 15.3 Overflow positive
C WN0034 IFGT @C02,02 *IF
C Z-ADD@C03,01 WUDUVA LC - net sales
C END *FI
* Negative overflow.
* CASE: PAR.Conversion from (19.4) is 15.3 Overflow negative
C WN0034 IFLT @C02,01 *IF
C Z-ADD@C03,02 WUDUVA LC - net sales
C END *FI
C MOVEL'1' WUACGL Currency conv o
* Send message 'Overflow - LC net sales'
C MOVEL'AMB1800' ZAMSID
C EXSR ZASNMS
C SETON 99 *
C END *FI
C END *FI
C END *FI
C END *FI
* Set LC_-_Net_sales_amount to correct decimal positions.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C Z-ADD*ZERO WN0055 10 Decimal positio
C Z-ADD*ZERO WN0056 20 Company number
C Z-ADD*ZERO WN0057 150 Price 15.0 USR
C Z-ADD*ZERO WN0058 152 Price 15.2 USR
* INT:Set Prc to Cur Dec Ps
* ** Depending on the currency in question the Price (15.3)
* field can either have:
* (a) two decimal places
* (b) no decimal places.
* Set Company_number for Currency retrieve.
* CASE: PAR.Currency ID is Blank
C *BLANK IFEQ *BLANK *IF
C Z-ADD*ZERO WN0056 Company number
C ELSE
* CASE: *OTHERWISE
C Z-ADDZFAENB WN0056 Company number
C END *FI
* INT:Get Currency Array
* ** The intent of this function is to reduce I/O to the Currency
* file by storing the data in a Synon array. The data
* is not only available within the program but also persists
* through invocations of the program, until the program is close
* ** This technique is similar to the one used to reduce SYSCTL I/O
* *** If IFM installed, only company 01 records exist.
C Z-ADDWN0056 WUAAQR Company number
* Check if IFM installed?
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0259 4 Application ali
C WUADVB PARM *BLANK WQ0260 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* If IFM installed, Currency file only has company 01 records.
* CASE:
* - c1 AND c2
* |- c1 : WRK.Installed apps - IFM is Installed
* |- c2 : WRK.Company number USR is Not equal 01
* '-
C MOVEL'0' Y0CX01 1
C WUADVB IFEQ '1' *IF
C WUAAQR IFNE 01 *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C Z-ADD01 WUAAQR Company number
C END *FI
* RTV:Currency File Array - *Arrays *
C EXSR TWRVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* Load Currency File Array - *Arrays *
C EXSR TXCRRC
* Retry the load?
* CASE:
* - NOT c1
* |- c1 : PGM.*Return code is *Normal
* '-
C MOVEL'0' Y0CX01 1
C W0RTN IFEQ *BLANK *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
* ** This error indicates the array is full.
* ** So, the foreign currency array elements are cleared to
* make room.
* ** The array size of 5 was chosen to limit the program's size
* but still handle quite a few currencies before running
* this exception handling.
* Clear Currency File Array - *Arrays *
C EXSR NBDLRC
* Load Currency File Array - *Arrays *
C EXSR NCCRRC
C END *FI
C END *FI
C MOVEL*BLANK W0RTN *Return code
* Set Price.
* CASE: PAR.Decimal positions is 0
C WN0055 IFEQ *ZERO *IF
C WUDUVA MULT 1 WN0057 H Price 15.0 USR
C WN0057 MULT 1 WUDUVA &Price
C ELSE
* CASE: PAR.Decimal positions is 2
C WN0055 IFEQ 2 *IF
C WUDUVA MULT 1 WN0058 H Price 15.2 USR
C WN0058 MULT 1 WUDUVA &Price
C END *FI
C END *FI
C END *FI
* Reset the order quantity to the calculated value.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C Z-ADDWN0032 ZFACQT Order qty in or
C END *FI
C ELSE
* CASE: *OTHERWISE
* Fully shipped - no re-calculations.
* CASE: *OTHERWISE
C Z-ADD*ZERO WUDPVA Net sales amoun
C Z-ADD*ZERO WUDUVA LC - net sales
C Z-ADD*ZERO ZFACQT Order qty in or
C END *FI
C END *FI
C WUDPVA MULT 1 ZFACRN H Net sales amoun
C ADD ZFACRN WUAB1X Net sales amoun
C Z-ADDWUAB1X WUAB1X Net sales amoun
C ELSE
* CASE: *OTHERWISE
* ** Fully shipped - DO NOT PRINT.
C MOVEL'N' W0PFM *Print format
C END *FI
C END *FI
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
* Convert to alternate currency.
* CASE: *OTHERWISE
* Sel-prc ord u/m 15.3 USR
* CASE: *OTHERWISE
* EXT:Cnvt to alt (15.3) - Z-Generic Programs *
C CALL 'AMBUWXFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM ZFAENB WQ0277 20 Company number
C PARM CDBRCD WQ0278 3 Currency ID
C ZFACK0 PARM ZFACK0 WQ0279 153 &Price
C PARM WUZ0YH WQ0280 3 Alternate curre
C WUAAKC PARM *BLANK WQ0281 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBUWXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* Net sales amount 14.2 USR
* CASE: *OTHERWISE
* EXT:Cnvt to alt (14.2) - Z-Generic Programs *
C CALL 'AMBUXXFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM ZFAENB WQ0282 20 Company number
C PARM CDBRCD WQ0283 3 Currency ID
C ZFACRN PARM ZFACRN WQ0284 142 Net sales amoun
C PARM WUZ0YH WQ0285 3 Alternate curre
C WUAAKC PARM *BLANK WQ0286 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBUXXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* Accumulate alternate currency total.
* CASE: *OTHERWISE
* Accumulate alternate amounts and pass back to avoid rounding
* error between alternate total and alternate details.
C ADD ZFACRN WUZ04P Alt net sles am
C Z-ADDWUZ04P WUZ04P Alt net sles am
C END *FI
C W0PFM IFEQ 'Y'
* Convert fields to external form
* Convert Request date (usr) to display format
* Convert date
C 1000000 ADD ZFAA35 XDINDT
C EXSR XDVC2T
C Z-ADDXDEXDT VFAA35
* Convert Promise date (usr) to display format
* Convert date
C 1000000 ADD ZFAAT0 XDINDT
C EXSR XDVC2T
C Z-ADDXDEXDT VFAAT0
C MOVEL'0' *IN79
C ZFALTX IFEQ *BLANK *IF
C MOVEL'1' *IN79
C END *FI
C MOVEL'0' *IN78
C ZFAA66 IFEQ *BLANK *IF
C MOVEL'1' *IN78
C END *FI
C MOVEL'0' *IN77
C ZFHJTX IFEQ *BLANK *IF
C MOVEL'1' *IN77
C END *FI
C MOVEL'0' *IN76
C ZFAAWM IFEQ *BLANK *IF
C MOVEL'1' *IN76
C END *FI
C MOVEL'0' *IN75
C ZFAA35 IFEQ *ZERO *IF
C MOVEL'1' *IN75
C END *FI
C MOVEL'0' *IN74
C ZFESST IFEQ 'A' *IF
C ZFESST OREQ 'R'
C MOVEL'1' *IN74
C END *FI
C MOVEL'0' *IN73
C ZFA3CD IFEQ *BLANK *IF
C MOVEL'1' *IN73
C END *FI
C MOVEL'0' *IN72
C ZFABA5 IFEQ *BLANK *IF
C MOVEL'1' *IN72
C END *FI
C MOVEL'0' *IN71
C WUACLA IFEQ '0' *IF
C MOVEL'1' *IN71
C END *FI
C MOVEL'0' *IN70
C ZFAALM IFEQ *BLANK *IF
C MOVEL'1' *IN70
C END *FI
* Print column headings if required
C W0CCDT IFEQ 'Y'
C WRITEZFCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0CCDT
C END FI
* Print format
C WRITEZFDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0CPDT
C END FI
* Print First Page Format of PRO:ACK/QTE item F/O
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0DP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0DP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0DP1P
* Clear first page flag.
C MOVE *BLANK W0DL1P
C END FI
* Print Company number of PRO:ACK/QTE item F/O
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0DP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0DP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0DP00
C END FI
* Print Internal header type of PRO:ACK/QTE item F/O
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0DP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0DP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0DP01
C END FI
* Print Quote/order number of PRO:ACK/QTE item F/O
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0DP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0DP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0DP02
C END FI
* Print Line item sequence of PRO:ACK/QTE item F/O
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0DP03 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0DP03 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0DP03
C END FI
* Print Detail line. of PRO:ACK/QTE item F/O
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0DCDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0DPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0DPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
* Set the descriptions properly.
* CASE: CUR.Invoice language item des is Blank
C ZGB5TX IFEQ *BLANK *IF
C MOVELZGALTX ZGB5TX Invoice languag
C END *FI
* Blank local description if not printing both languages
* CASE:
* - c1 OR c2
* |- c1 : PAR.Document language format is Foreign text only
* |- c2 : PAR.Language code is Default local language
* '-
C C6BDST IFEQ '1' *IF
C CDAKCD OREQ '001' *OR
C MOVEL*BLANK ZGALTX Item descriptio
C END *FI
C W0PFM IFEQ 'Y'
C MOVEL'0' *IN79
C ZGALTX IFEQ *BLANK *IF
C MOVEL'1' *IN79
C END *FI
* Print column headings if required
C W0DCDT IFEQ 'Y'
C WRITEZGCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0DCDT
C END FI
* Print format
C WRITEZGDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0DPDT
C END FI
* Print First Page Format of PRO:Kit Components
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0EP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0EP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0EP1P
* Clear first page flag.
C MOVE *BLANK W0EL1P
C END FI
* Print Item number of PRO:Kit Components
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0EP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0EP00 ANDEQ'P'
* Print format
C WRITEZIKEYHDR
* Set column headings flag
C MOVE 'Y' W0ECDT
* Reset format print flag
C MOVE *BLANK W0EP00
C END FI
* Print Detail line. of PRO:Kit Components
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0ECDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0EPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0EPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
* RTV:Desc,Unit of Measure - ITEM MASTER *
C EXSR NGRVGN
* Get foreign language if necessary and set description print.
* CASE: PAR.Language code is Default local language
C CDAKCD IFEQ '001' *IF
C MOVELZJAAR1 ZJACLQ Item Descriptio
C MOVEL*BLANK ZJAAR1 Item descriptio
C ELSE
* CASE: *OTHERWISE
* RTV: Item foreign desc - ITEM FOREIGN LANGUAGE *
C EXSR NHRVGN
* If blank, try the foreign default.
* CASE: CUR.Item Description USR1 is Blank
C ZJACLQ IFEQ *BLANK *IF
* RTV: Item foreign desc - ITEM FOREIGN LANGUAGE *
C EXSR NIRVGN
* If still blank, use local.
* CASE: CUR.Item Description USR1 is Blank
C ZJACLQ IFEQ *BLANK *IF
C MOVELZJAAR1 ZJACLQ Item Descriptio
C END *FI
C END *FI
* If foreign print only, blank out the local.
* CASE: PAR.Invoice language format is Foreign language only
C C6BDST IFEQ '1' *IF
C MOVEL*BLANK ZJAAR1 Item descriptio
C END *FI
C END *FI
* Calculate kit component quantity
C ZJJ6NB MULT ZFACQT ZJABD2 Shipped quantit
C W0PFM IFEQ 'Y'
C MOVEL'0' *IN79
C ZJAAR1 IFEQ *BLANK *IF
C MOVEL'1' *IN79
C END *FI
* Print column headings if required
C W0ECDT IFEQ 'Y'
C WRITEZJCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0ECDT
C END FI
* Print format
C WRITEZJDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0EPDT
C END FI
* Print First Page Format of PRO:Quote/Order Releases
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0FP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0FP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0FP1P
* Clear first page flag.
C MOVE *BLANK W0FL1P
C END FI
* Print Company number of PRO:Quote/Order Releases
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0FP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0FP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0FP00
C END FI
* Print Internal header type of PRO:Quote/Order Releases
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0FP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0FP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0FP01
C END FI
* Print Quote/order number of PRO:Quote/Order Releases
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0FP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0FP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0FP02
C END FI
* Print Line item sequence of PRO:Quote/Order Releases
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0FP03 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0FP03 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0FP03
C END FI
* Print Release number of PRO:Quote/Order Releases
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0FP04 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0FP04 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0FP04
C END FI
* Print Detail line. of PRO:Quote/Order Releases
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0FCDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0FPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0FPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
* Set ordered quantity for report?
* CASE: JOB.*PROGRAM EQ WRK.*PROGRAM
C ZZPGM IFEQ WUPGM *IF
* Acknowledgement print processing.
* CASE: DB1.Open to pick/MBO quantity is Non Zero
C WHAQQT IFNE *ZERO *IF
* EXT:Get CnvRatio, Rnd Opt - Item U/M Conversion *
C CALL 'AMBJ6XFR' 90 EXT:Get CnvRati
C PARM *BLANK W0RTN 7
C PARM WHAITX WQ0287 15 Item number
C PARM CDDHCD WQ0288 2 Dimension U/M
C PARM ZFCQCD WQ0289 2 To unit of meas
C WUACYW PARM *ZERO WQ0290 95 From quantity
C WUACYX PARM *ZERO WQ0291 95 To quantity
C WUFEST PARM *BLANK WQ0292 1 Rounding option
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBJ6XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* ** Save open quantity for unit of measure conversion.
C Z-ADDWHAQQT WUAQQT Open to pick/MB
* INT:Qty Cnv Calc Only 3:3
* Program information.
* CASE: *OTHERWISE
* ** The 3:3 refers to the decimal places of the input and output.
* ** Conversion is between 10.3 quantity fields.
* Multiply by a 9.5 and divide by a 9.5 to get there.
* ** Intermediate result of the multiplication:
* A 10.3 times a 9.5 has a result with 7+4=11 to the left
* of the decimal, and 3+5=8 to the right; result is 19.8.
* ** The division to calculate the output field will be performed
* into a work field with 4 decimal places, truncated.
* The work field will be rounded as necessary into the 10.3 fiel
* ** The 4th decimal position is
* sufficient for "round to nearest", and is by design sufficient
* for the "round up" rounding option.
* Explanation of calculation.
* CASE: *OTHERWISE
* ** QUANTITY math is like this:
* Input quantity conversion ratio:from
* ---------------- = ---------------------
* Output quantity conversion ratio:to
* So, out qty = ( in qty x conv:to ) / ( conv:from)
* ** WEIGHT conversion is a quantity conversion.
* ** PRICE conversion is a "per quantity" conversion.
* This function could be used for price conversion by reversing
* the conversion ratio before feeding it in.
* However, the field size for pricing is seldom 10.3 to 10.3.
C MOVEL'0' WUACV9 Overflow? USR
* Perform calculations?
* CASE: VALID CONVERSION RATIO:
* - c1 AND c2 AND c3
* |- c1 : PAR.Conversion ratio:from USR is Not zero
* |- c2 : PAR.conversion ratio:to USR is Not zero
* |- c3 : PAR.Conversion ratio:from USR NE PAR.conversion rati
* '-
C MOVEL'0' Y0CX01 1
C WUACYW IFNE *ZERO *IF
C WUACYX IFNE *ZERO *IF
C WUACYW IFNE WUACYX *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* ** Multiply and divide; result to be rounded.
C WUACYX MULT WUAQQT WUKTVA &Amount 19.8
C WUKTVA DIV WUACYW WUACWQ Work number 20.
* Overflows the 10.3 output field?
* CASE: OVERFLOW:
* - c1 OR c2
* |- c1 : WRK.Work number 20.4 USR is Overflows 10.3 positive
* |- c2 : WRK.Work number 20.4 USR is Overflows 10.3 negative
* '-
C WUACWQ IFGT @C01,01 *IF
C WUACWQ ORLT @C01,02 *OR
C MOVEL'1' WUACV9 Overflow? USR
* ** Overflow is initialized to No at function initialization.
C END *FI
* Decimal precision and rounding.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Calulate into a WRK field to assure the proper size field is
* used for the result. Since this is an Internal, the field fro
* the CALLING function is actually used for the PAR, and it may
* be a different size from the declared PAR for this function.
* Load to WRK field using specified rounding option.
* CASE: PAR.Rounding option is No Rounding
C '1' IFEQ '0' *IF
C Z-ADDWUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: PAR.Rounding option is Round Up
C '1' IFEQ '2' *IF
* Load field which can bump up the result's 3rd decimal position.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Scale up the 4th decimal position to a value from 0 to 9.
C WUACWQ MULT 10000 WUABGP Work Number (1.
* Set the "round up" work field.
* CASE: WRK.Work Number (1.0) is Zero
C WUABGP IFEQ *ZERO *IF
C Z-ADD*ZERO WUWD *Synon (17,7) w
C ELSE
* CASE: *OTHERWISE
C Z-ADD0.001 WUWD *Synon (17,7) w
C END *FI
C END *FI
C WUWD ADD WUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: *OTHERWISE
* ** Otherwise round to nearest.
C WUACWQ MULT 1 WUACWA H Convert to 10.3
C END *FI
C END *FI
C Z-ADDWUACWA WUAQQT Quantity USR
C END *FI
C ELSE
* CASE: *OTHERWISE
* ** Otherwise no conversion occurs.
C END *FI
* ** Print converted open amount on report.
C Z-ADDWUAQQT ZLDZVA Release quantit
C ELSE
* CASE: *OTHERWISE
C Z-ADD*ZERO ZLDZVA Release quantit
C END *FI
C ELSE
* CASE: *OTHERWISE
* Quote print processing.
* CASE: CUR.Release quantity - stock is Non Zero
C ZLDZVA IFNE *ZERO *IF
* EXT:Get CnvRatio, Rnd Opt - Item U/M Conversion *
C CALL 'AMBJ6XFR' 90 EXT:Get CnvRati
C PARM *BLANK W0RTN 7
C PARM WHAITX WQ0293 15 Item number
C PARM CDDHCD WQ0294 2 Dimension U/M
C PARM ZFCQCD WQ0295 2 To unit of meas
C WUACYW PARM *ZERO WQ0296 95 From quantity
C WUACYW PARM *ZERO WQ0297 95 To quantity
C WUFEST PARM *BLANK WQ0298 1 Rounding option
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBJ6XFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* INT:Qty Cnv Calc Only 3:3
* Program information.
* CASE: *OTHERWISE
* ** The 3:3 refers to the decimal places of the input and output.
* ** Conversion is between 10.3 quantity fields.
* Multiply by a 9.5 and divide by a 9.5 to get there.
* ** Intermediate result of the multiplication:
* A 10.3 times a 9.5 has a result with 7+4=11 to the left
* of the decimal, and 3+5=8 to the right; result is 19.8.
* ** The division to calculate the output field will be performed
* into a work field with 4 decimal places, truncated.
* The work field will be rounded as necessary into the 10.3 fiel
* ** The 4th decimal position is
* sufficient for "round to nearest", and is by design sufficient
* for the "round up" rounding option.
* Explanation of calculation.
* CASE: *OTHERWISE
* ** QUANTITY math is like this:
* Input quantity conversion ratio:from
* ---------------- = ---------------------
* Output quantity conversion ratio:to
* So, out qty = ( in qty x conv:to ) / ( conv:from)
* ** WEIGHT conversion is a quantity conversion.
* ** PRICE conversion is a "per quantity" conversion.
* This function could be used for price conversion by reversing
* the conversion ratio before feeding it in.
* However, the field size for pricing is seldom 10.3 to 10.3.
C MOVEL'0' WUACV9 Overflow? USR
* Perform calculations?
* CASE: VALID CONVERSION RATIO:
* - c1 AND c2 AND c3
* |- c1 : PAR.Conversion ratio:from USR is Not zero
* |- c2 : PAR.conversion ratio:to USR is Not zero
* |- c3 : PAR.Conversion ratio:from USR NE PAR.conversion rati
* '-
C MOVEL'0' Y0CX01 1
C WUACYW IFNE *ZERO *IF
C WUACYX IFNE *ZERO *IF
C WUACYW IFNE WUACYX *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* ** Multiply and divide; result to be rounded.
C WUACYX MULT ZLDZVA WUKTVA &Amount 19.8
C WUKTVA DIV WUACYW WUACWQ Work number 20.
* Overflows the 10.3 output field?
* CASE: OVERFLOW:
* - c1 OR c2
* |- c1 : WRK.Work number 20.4 USR is Overflows 10.3 positive
* |- c2 : WRK.Work number 20.4 USR is Overflows 10.3 negative
* '-
C WUACWQ IFGT @C01,01 *IF
C WUACWQ ORLT @C01,02 *OR
C MOVEL'1' WUACV9 Overflow? USR
* ** Overflow is initialized to No at function initialization.
C END *FI
* Decimal precision and rounding.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Calulate into a WRK field to assure the proper size field is
* used for the result. Since this is an Internal, the field fro
* the CALLING function is actually used for the PAR, and it may
* be a different size from the declared PAR for this function.
* Load to WRK field using specified rounding option.
* CASE: PAR.Rounding option is No Rounding
C '1' IFEQ '0' *IF
C Z-ADDWUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: PAR.Rounding option is Round Up
C '1' IFEQ '2' *IF
* Load field which can bump up the result's 3rd decimal position.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* ** Scale up the 4th decimal position to a value from 0 to 9.
C WUACWQ MULT 10000 WUABGP Work Number (1.
* Set the "round up" work field.
* CASE: WRK.Work Number (1.0) is Zero
C WUABGP IFEQ *ZERO *IF
C Z-ADD*ZERO WUWD *Synon (17,7) w
C ELSE
* CASE: *OTHERWISE
C Z-ADD0.001 WUWD *Synon (17,7) w
C END *FI
C END *FI
C WUWD ADD WUACWQ WUACWA Convert to 10.3
C ELSE
* CASE: *OTHERWISE
* ** Otherwise round to nearest.
C WUACWQ MULT 1 WUACWA H Convert to 10.3
C END *FI
C END *FI
C Z-ADDWUACWA ZLDZVA Quantity USR
C END *FI
C ELSE
* CASE: *OTHERWISE
* ** Otherwise no conversion occurs.
C END *FI
C END *FI
C END *FI
C W0PFM IFEQ 'Y'
* Convert fields to external form
* Convert Latest request date to display format
* Convert date
C 1000000 ADD ZLBJDT XDINDT
C EXSR XDVC2T
C Z-ADDXDEXDT VLBJDT
* Convert Latest promise date to display format
* Convert date
C 1000000 ADD ZLBIDT XDINDT
C EXSR XDVC2T
C Z-ADDXDEXDT VLBIDT
* Convert Manufacturing due date to display format
* Convert date
C 1000000 ADD ZLAKDT XDINDT
C EXSR XDVC2T
C Z-ADDXDEXDT VLAKDT
* Print column headings if required
C W0FCDT IFEQ 'Y'
C WRITEZLCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0FCDT
C END FI
* Print format
C WRITEZLDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0FPDT
C END FI
* Print First Page Format of PRO:Invoice Item comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0GP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0GP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0GP1P
* Clear first page flag.
C MOVE *BLANK W0GL1P
C END FI
* Print Company number of PRO:Invoice Item comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0GP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0GP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0GP00
C END FI
* Print Invoice number of PRO:Invoice Item comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0GP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0GP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0GP01
C END FI
* Print Invoice sequence of PRO:Invoice Item comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0GP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0GP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0GP02
C END FI
* Print Comment line sequence no. of PRO:Invoice Item comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0GP03 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0GP03 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0GP03
C END FI
* Print Invoice comment detail of PRO:Invoice Item comments
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0GCDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0GPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0GPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
C MOVEL*BLANK ZNAFD5 Text Line Descr
C MOVELWCHDTX ZNAFD5 Text Line Descr
* For 2 or 3 lines up, concat comments
* CASE: DB1.Text line print control is 2 or 3 lines up
C WCAD1N IFEQ '2' *IF
C WCAD1N OREQ '3'
C ZNKBNB ADD 1 WUKBNB Comment line se
* RTV:Build lines up detail - History Comment *
C EXSR NMRVGN
* Reposition the history comment file
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* CASE: WRK.Comment line seq no. USR is Zero
C WUAFD6 IFEQ *ZERO *IF
C Z-ADDZNKBNB WUAFD6 Comment line se
C END *FI
* RTV:Reposition pointer - History Comment *
C EXSR NNRVGN
C END *FI
C END *FI
C W0PFM IFEQ 'Y'
* Print column headings if required
C W0GCDT IFEQ 'Y'
C WRITEZNCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0GCDT
C END FI
* Print format
C WRITEZNDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0GPDT
C END FI
* Print First Page Format of PRO:Invoice item tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0HP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0HP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0HP1P
* Clear first page flag.
C MOVE *BLANK W0HL1P
C END FI
* Print Company number of PRO:Invoice item tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0HP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0HP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0HP00
C END FI
* Print Internal header type of PRO:Invoice item tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0HP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0HP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0HP01
C END FI
* Print Quote/order number of PRO:Invoice item tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0HP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0HP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0HP02
C END FI
* Print Shipment header number of PRO:Invoice item tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0HP03 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0HP03 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0HP03
C END FI
* Print Ship release sequence of PRO:Invoice item tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0HP04 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0HP04 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0HP04
C END FI
* Print Kit release sequence of PRO:Invoice item tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0HP05 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0HP05 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0HP05
C END FI
* Print Tax sequence of PRO:Invoice item tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0HP06 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0HP06 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0HP06
C END FI
* Print Detail line. of PRO:Invoice item tax
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0HCDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0HPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0HPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
* CASE: DO NOT INVOICE TAX:
* - c1 AND c2
* |- c1 : WRK.IFM AR interface is Activated
* |- c2 : DB1.Tax is invoiced flag is No
* '-
C MOVEL'0' Y0CX01 1
C WUADKP IFEQ '2' *IF
C GFZ9VK IFEQ '0' *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'N' W0PFM *Print format
C ELSE
* CASE: *OTHERWISE
C MOVEL'Y' W0PFM *Print format
* Set the description if foreign language print only.
* CASE: Document is foreign format or local lang order
* - c1 OR c2
* |- c1 : PAR.Document language format is Foreign text only
* |- c2 : PAR.Language code 1 is Local default
* '-
C C6BDST IFEQ '1' *IF
C CDAKCD OREQ '001' *OR
C MOVEL*BLANK ZPACHH Tax invoice tex
C END *FI
C END *FI
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
* EXT:Cnvt to alt (13.2) - Z-Generic Programs *
C CALL 'AMBUYXFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM ZPAENB WQ0371 20 Company number
C PARM CDBRCD WQ0372 3 Currency ID
C ZPGYVA PARM ZPGYVA WQ0373 132 &Amount (13.2)
C PARM WUZ0YH WQ0374 3 Alternate curre
C WUAAKC PARM *BLANK WQ0375 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBUYXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C END *FI
C W0PFM IFEQ 'Y'
C MOVEL'0' *IN79
C ZPACHH IFEQ *BLANK *IF
C MOVEL'1' *IN79
C END *FI
* Print column headings if required
C W0HCDT IFEQ 'Y'
C WRITEZPCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0HCDT
C END FI
* Print format
C WRITEZPDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0HPDT
C END FI
* Print First Page Format of PRO:Invoice special charg
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0IP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0IP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0IP1P
* Clear first page flag.
C MOVE *BLANK W0IL1P
C END FI
* Print Company number of PRO:Invoice special charg
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0IP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0IP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0IP00
C END FI
* Print Invoice number of PRO:Invoice special charg
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0IP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0IP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0IP01
C END FI
* Print Invoice sequence of PRO:Invoice special charg
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0IP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0IP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0IP02
C END FI
* Print Special charge detail of PRO:Invoice special charg
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0ICDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0IPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0IPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
* Load fields from WRK context
C MOVELWUAA73 ZRAA73 Foreign descrip
C MOVELWUBXTX ZRBXTX Special charge
* Set Special charge amount.
* CASE: PAR.Tax in price flag is Tax in price - list
C P5Z9JB IFEQ '1' *IF
C Z-ADDWUZ9QF ZRDDVA Special charge
C ELSE
* CASE: *OTHERWISE
C Z-ADDWUDDVA ZRDDVA Special charge
C END *FI
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
* EXT:Cnvt to alt (13.2) - Z-Generic Programs *
C CALL 'AMBUYXFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM ZRAENB WQ0376 20 Company number
C PARM WUAAM5 WQ0377 3 Currency ID
C ZRDDVA PARM ZRDDVA WQ0378 132 &Amount (13.2)
C PARM WUZ0YH WQ0379 3 Alternate curre
C WUAAKC PARM *BLANK WQ0380 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBUYXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* Accumulate alternate currency misc. and freight charges.
* CASE:
* - c1 OR c2 OR c3
* |- c1 : DB1.Special charge code is Charge only; no cost
* |- c2 : DB1.Special charge code is Charge with cost
* |- c3 : DB1.Surcharge code 1 is Not blank
* '-
C F9BLST IFEQ '2' *IF
C F9BLST OREQ '3' *OR
C F9AAD7 ORNE *BLANK *OR
C ADD ZRDDVA WUZ04Z Total alt speci
C ELSE
* CASE: DB1.Special charge code is Freight; no cost
C F9BLST IFEQ '1' *IF
C ADD ZRDDVA WUZ041 Total alt speci
C END *FI
C END *FI
C END *FI
* Move these fields to make it less confusing on the print objects.
C Z-ADDWUAAD2 ZRAAD2 Special charge
C MOVELWUAAD7 ZRAAD7 Surcharge code
C MOVELWUAAD8 ZRAAD8 Surcharge detai
C MOVELWUBLST ZRBLST Special charge
* Set the language correctly for foreign print only.
* CASE:
* - c1 OR c2
* |- c1 : PAR.Document language format is Foreign text only
* |- c2 : PAR.Language code 1 is Local default
* '-
C C6BDST IFEQ '1' *IF
C C6AKCD OREQ '001' *OR
* Don't print local text if 'Foreign only' or the order is
* in the local language.
C MOVEL*BLANK ZRBXTX Special charge
C END *FI
C W0PFM IFEQ 'Y'
C MOVEL'0' *IN79
C WUBLST IFEQ '0' *IF
C MOVEL'1' *IN79
C END *FI
C MOVEL'0' *IN78
C ZRBXTX IFEQ *BLANK *IF
C MOVEL'1' *IN78
C END *FI
* Print column headings if required
C W0ICDT IFEQ 'Y'
C WRITEZRCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0ICDT
C END FI
* Print format
C WRITEZRDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0IPDT
C END FI
* Print First Page Format of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0JP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0JP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0JP1P
* Clear first page flag.
C MOVE *BLANK W0JL1P
C END FI
* Print Company number of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0JP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0JP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0JP00
C END FI
* Print Invoice number of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0JP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0JP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0JP01
C END FI
* Print Invoice sequence of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0JP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0JP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0JP02
C END FI
* Print Internal header type of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0JP03 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0JP03 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0JP03
C END FI
* Print Quote/order number of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0JP04 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0JP04 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0JP04
C END FI
* Print Comment user reference of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0JP05 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0JP05 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0JP05
C END FI
* Print Comment line sequence no. of PRO:Invoice Hdr comments
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0JP06 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0JP06 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0JP06
C END FI
* Print Invoice comment detail of PRO:Invoice Hdr comments
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0JCDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0JPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0JPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
C MOVEL'0' WUAAMK Print details?
C MOVEL*BLANK ZSAFD5 Text Line Descr
C MOVELWBHDTX ZSAFD5 Text Line Descr
* Check if IFM terms History records for a Invoice
* If line seq # is negative, comments are IFM terms comments
* CASE:
* - c1 AND c2
* |- c1 : DB1.Comment line sequence no. is GT -998
* |- c2 : DB1.Comment line sequence no. is Less than -100
* '-
C MOVEL'0' Y0CX01 1
C WBKBNB IFGT -998 *IF
C WBKBNB IFLT -100 *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* Greater than -100, less than zero is Complementary Invoice commen
C WBKBNB ADD 1 WUKBNB Comment line se
* History comment records are read in pairs before printing
* RTV:Header Commnt - History Comment *
C EXSR NURVGN
* Make unit pos. of seq # a plus value
C Z-ADD*ZERO WUABGP Work Number (1.
C SUB WUKBNB WUABGP Work Number (1.
* If line seq unit # is even, comment is 'Due date Amt due' values
* If printing 'Due date Amt due' values, set up print fields.
* CASE:
* - c2 OR c3 OR c4 OR c5 OR c6
* |- c2 : WRK.Work Number (1.0) is Zero
* |- c3 : WRK.Work Number (1.0) is 2
* |- c4 : WRK.Work Number (1.0) is 4
* |- c5 : WRK.Work Number (1.0) is 6
* |- c6 : WRK.Work Number (1.0) is 8
* '-
C WUABGP IFEQ *ZERO *IF
C WUABGP OREQ 2 *OR
C WUABGP OREQ 4 *OR
C WUABGP OREQ 6 *OR
C WUABGP OREQ 8 *OR
C Z-ADD7 YRSW00
C Z-ADD1 ZQ 50
C YRSW00 IFLT 1
C ZQ ORLT 1
C YRSW00 ORGT 00025
C ZQ ORGT 00025
C MOVEL'Y2U0510' W0RTN
C ELSE
C YRSW00 SUBSTWUHDTX:ZQ WUAA09 P 90 Date parameter
C 90 MOVEL'Y2U0510' W0RTN
C END
C MOVE WUAA09 ZSACCS Date Effective
C Z-ADD13 YRSW00
C Z-ADD13 ZQ 50
C YRSW00 IFLT 1
C ZQ ORLT 1
C YRSW00 ORGT 00025
C ZQ ORGT 00025
C MOVEL'Y2U0510' W0RTN
C ELSE
C YRSW00 SUBSTWUHDTX:ZQ WUADX9 P 90 work field 13 c
C 90 MOVEL'Y2U0510' W0RTN
C END
C MOVE WUADX9 ZSAC87 Total Invoice A
C MOVEL'1' WUAAMK Print details?
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
* EXT:Cnvt to alt (13.2) - Z-Generic Programs *
C CALL 'AMBUYXFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM ZSAENB WQ0381 20 Company number
C PARM WUAAM5 WQ0382 3 Currency ID
C ZSAC87 PARM ZSAC87 WQ0383 132 &Amount (13.2)
C PARM WUZ0YH WQ0384 3 Alternate curre
C WUAAKC PARM *BLANK WQ0385 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBUYXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C END *FI
C ELSE
* CASE: *OTHERWISE
C MOVEL*BLANK ZSAFD5 Text Line Descr
C END *FI
C END *FI
* Positive line item sequence (non IFM)
* CASE: DB1.Comment line sequence no. is Greater than -100
C WBKBNB IFGT -100 *IF
* Greater than -100, less than zero is Complementary Invoice commen
* If 2 or 3 lines up, concat comments
* CASE: DB1.Text line print control is 2 or 3 lines up
C WBAD1N IFEQ '2' *IF
C WBAD1N OREQ '3'
C ZSKBNB ADD 1 WUKBNB Comment line se
* RTV:Build lines up header - History Comment *
C EXSR NVRVGN
* Reposition the history comment file
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* CASE: WRK.Comment line seq no. USR is Zero
C WUAFD6 IFEQ *ZERO *IF
C Z-ADDZSKBNB WUAFD6 Comment line se
C END *FI
* RTV:Reposition ptr - History Comment *
C EXSR NWRVGN
C END *FI
C END *FI
C END *FI
C W0PFM IFEQ 'Y'
* Convert fields to external form
* Convert Date Effective USR to display format
* Convert date
C 1000000 ADD ZSACCS XDINDT
C EXSR XDVC2T
C Z-ADDXDEXDT VSACCS
C MOVEL'0' *IN79
C WUAAMK IFEQ '0' *IF
C MOVEL'1' *IN79
C END *FI
* Print column headings if required
C W0JCDT IFEQ 'Y'
C WRITEZSCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0JCDT
C END FI
* Print format
C WRITEZSDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0JPDT
C END FI
* Print First Page Format of PRO:Invoice spc chg tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0KP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0KP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0KP1P
* Clear first page flag.
C MOVE *BLANK W0KL1P
C END FI
* Print Company number of PRO:Invoice spc chg tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0KP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0KP00 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0KP00
C END FI
* Print Invoice number of PRO:Invoice spc chg tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0KP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0KP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0KP01
C END FI
* Print Invoice sequence of PRO:Invoice spc chg tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0KP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0KP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0KP02
C END FI
* Print Special charge sequence # of PRO:Invoice spc chg tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0KP03 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0KP03 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0KP03
C END FI
* Print Tax sequence of PRO:Invoice spc chg tax
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0KP04 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0KP04 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0KP04
C END FI
* Print Detail line. of PRO:Invoice spc chg tax
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0KCDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0KPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0KPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
* CASE: DO NOT INVOICE TAX:
* - c1 AND c2
* |- c1 : WRK.IFM AR interface is Activated
* |- c2 : DB1.Tax is invoiced flag is No
* '-
C MOVEL'0' Y0CX01 1
C WUADKP IFEQ '2' *IF
C WRZ9VK IFEQ '0' *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'N' W0PFM *Print format
C ELSE
* CASE: *OTHERWISE
C MOVEL'Y' W0PFM *Print format
* If this is for a surcharge, move the work fields to report fields
* CASE: PAR.Special charge sequence # is Zero
C ZRAAD2 IFEQ *ZERO *IF
C Z-ADDWUGYVA ZUGYVA Tax amount
C MOVELWUACHH ZUACHH Tax invoice tex
C MOVELWUACHJ ZUACHJ Inv lang tax in
C END *FI
* Set descriptions correctly based on doc. language format.
* CASE:
* - c1 OR c2
* |- c1 : PAR.Document language format is Foreign text only
* |- c2 : PAR.Language code 1 is Local default
* '-
C C6BDST IFEQ '1' *IF
C C6AKCD OREQ '001' *OR
C MOVEL*BLANK ZUACHH Tax invoice tex
C END *FI
C END *FI
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
* EXT:Cnvt to alt (13.2) - Z-Generic Programs *
C CALL 'AMBUYXFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM ZUAENB WQ0458 20 Company number
C PARM WUAAM5 WQ0459 3 Currency ID
C ZUGYVA PARM ZUGYVA WQ0460 132 &Amount (13.2)
C PARM WUZ0YH WQ0461 3 Alternate curre
C WUAAKC PARM *BLANK WQ0462 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBUYXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C END *FI
C W0PFM IFEQ 'Y'
C MOVEL'0' *IN79
C ZUACHH IFEQ *BLANK *IF
C MOVEL'1' *IN79
C END *FI
* Print column headings if required
C W0KCDT IFEQ 'Y'
C WRITEZUCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0KCDT
C END FI
* Print format
C WRITEZUDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0KPDT
C END FI
* Print First Page Format of PRO:Invoice Tax Summary
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0LP1P IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0LP1P ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0LP1P
* Clear first page flag.
C MOVE *BLANK W0LL1P
C END FI
* Print Company number of PRO:Invoice Tax Summary
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0LP00 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0LP00 ANDEQ'P'
* Print format
C WRITEZWKEYHDR
* Set column headings flag
C MOVE 'Y' W0LCDT
* Reset format print flag
C MOVE *BLANK W0LP00
C END FI
* Print Invoice number of PRO:Invoice Tax Summary
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0LP01 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0LP01 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0LP01
C END FI
* Print Invoice sequence of PRO:Invoice Tax Summary
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0LP02 IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0LP02 ANDEQ'P'
* Reset format print flag
C MOVE *BLANK W0LP02
C END FI
* Print Detail line. of PRO:Invoice Tax Summary
* If new page then set column headings active
C W0NEWP IFEQ 'Y'
C MOVE 'Y' W0LCDT 1
C END
* If it is ready to print, then do so,
* or if new page & print on new page selected &
* active then set print format flag
C W0LPDT IFEQ 'Y' IF
C W0NEWP OREQ 'Y'
C W0LPDT ANDEQ'P'
C MOVEL'Y' W0PFM
* USER: On print of detail format
* CASE: DO NOT INVOICE TAX:
* - c1 AND c2
* |- c1 : WRK.IFM AR interface is Activated
* |- c2 : DB1.Tax is invoiced flag is No
* '-
C MOVEL'0' Y0CX01 1
C WUADKP IFEQ '2' *IF
C WVZ9VK IFEQ '0' *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'N' W0PFM *Print format
C ELSE
* CASE: *OTHERWISE
C MOVEL'Y' W0PFM *Print format
* Load details from work context.
* CASE: *OTHERWISE
C MOVELWUACHJ ZXACHJ Inv lang tax in
C MOVELWUACHH ZXACHH Tax invoice tex
C Z-ADDWUGYVA ZXGYVA Tax amount
* Set the description for foreign print only.
* CASE:
* - c1 OR c2
* |- c1 : PAR.Document language format is Foreign text only
* |- c2 : PAR.Language code 1 is Local default
* '-
C C6BDST IFEQ '1' *IF
C C6AKCD OREQ '001' *OR
C MOVEL*BLANK ZXACHH Tax invoice tex
C END *FI
* Print in alternate currency?
* CASE: WRK.Prtd in alternate ccy USR is Line detail and total
C WUZ04D IFEQ 'D' *IF
* EXT:Cnvt to alt (13.2) - Z-Generic Programs *
C CALL 'AMBUYXFR' 90 EXT:Cnvt to alt
C PARM *BLANK W0RTN 7
C PARM ZXAENB WQ0535 20 Company number
C PARM WUAAM5 WQ0536 3 Currency ID
C ZXGYVA PARM ZXGYVA WQ0537 132 &Amount (13.2)
C PARM WUZ0YH WQ0538 3 Alternate curre
C WUAAKC PARM *BLANK WQ0539 1 Return code (US
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBUYXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C ADD ZXGYVA WUZ04Y Tax amount alte
C END *FI
C END *FI
C W0PFM IFEQ 'Y'
C MOVEL'0' *IN79
C ZXACHH IFEQ *BLANK *IF
C MOVEL'1' *IN79
C END *FI
* Print column headings if required
C W0LCDT IFEQ 'Y'
C WRITEZXCOLHDG
* Clear column headings control flag
C MOVE *BLANK W0LCDT
C END FI
* Print format
C WRITEZXDTLRCD
C END FI
* Reset format print flag
C MOVE *BLANK W0LPDT
C END FI
* Clear new page flag
C MOVE *BLANK W0NEWP
*================================================================
CSR Q0EXIT ENDSR
/EJECT
CSR Q1FSEL BEGSR
*================================================================
* Format select
*================================================================
*================================================================
CSR Q1EXIT ENDSR
/EJECT
CSR Q2PLEN BEGSR
*================================================================
* Evaluate print length
*================================================================
C *LIKE DEFN @$CLN W0FSUM
C *LIKE DEFN @$CLN W0DTLN
C *LIKE DEFN @$CLN W0COLN
C Z-ADD@$CLN W0FSUM
C Z-ADD*ZERO W0DTLN
C Z-ADD*ZERO W0COLN
* * First Page Format of PRT:Acknowledgement
C W0AP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRT:Acknowledgement
C W0AP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Internal header type of PRT:Acknowledgement
C W0AP01 IFEQ 'Y'
C W0FSUM IFGT 4
* Signal new page required
C MOVE 'Y' W0NEWP
C GOTO Q2EXIT
C ELSE
C Z-ADD31 W0FSUM
C END FI
C END FI
* * Detail line. of PRT:Acknowledgement
C W0APDT IFEQ 'Y'
C Z-ADD0 W0DTLN
C W0ACDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Invoice Hdr comments
C W0BP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:Invoice Hdr comments
C W0BP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice number of PRO:Invoice Hdr comments
C W0BP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice sequence of PRO:Invoice Hdr comments
C W0BP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Internal header type of PRO:Invoice Hdr comments
C W0BP03 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Quote/order number of PRO:Invoice Hdr comments
C W0BP04 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Comment user reference of PRO:Invoice Hdr comments
C W0BP05 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Comment line sequence no. of PRO:Invoice Hdr comments
C W0BP06 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice comment detail of PRO:Invoice Hdr comments
C W0BPDT IFEQ 'Y'
C Z-ADD3 W0DTLN
C W0BCDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Acknowledgement Lines
C W0CP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:Acknowledgement Lines
C W0CP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Internal header type of PRO:Acknowledgement Lines
C W0CP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Quote/order number of PRO:Acknowledgement Lines
C W0CP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * User entered sequence no. of PRO:Acknowledgement Lines
C W0CP03 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * System sequence # of PRO:Acknowledgement Lines
C W0CP04 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Detail line. of PRO:Acknowledgement Lines
C W0CPDT IFEQ 'Y'
C Z-ADD11 W0DTLN
C W0CCDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:ACK/QTE item F/O
C W0DP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:ACK/QTE item F/O
C W0DP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Internal header type of PRO:ACK/QTE item F/O
C W0DP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Quote/order number of PRO:ACK/QTE item F/O
C W0DP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Line item sequence of PRO:ACK/QTE item F/O
C W0DP03 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Detail line. of PRO:ACK/QTE item F/O
C W0DPDT IFEQ 'Y'
C Z-ADD3 W0DTLN
C W0DCDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Kit Components
C W0EP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Item number of PRO:Kit Components
C W0EP00 IFEQ 'Y'
C ADD 1 W0FSUM
C END FI
* * Detail line. of PRO:Kit Components
C W0EPDT IFEQ 'Y'
C Z-ADD3 W0DTLN
C W0ECDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Quote/Order Releases
C W0FP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:Quote/Order Releases
C W0FP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Internal header type of PRO:Quote/Order Releases
C W0FP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Quote/order number of PRO:Quote/Order Releases
C W0FP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Line item sequence of PRO:Quote/Order Releases
C W0FP03 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Release number of PRO:Quote/Order Releases
C W0FP04 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Detail line. of PRO:Quote/Order Releases
C W0FPDT IFEQ 'Y'
C Z-ADD1 W0DTLN
C W0FCDT IFEQ 'Y'
C Z-ADD2 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Invoice Item comments
C W0GP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:Invoice Item comments
C W0GP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice number of PRO:Invoice Item comments
C W0GP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice sequence of PRO:Invoice Item comments
C W0GP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Comment line sequence no. of PRO:Invoice Item comments
C W0GP03 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice comment detail of PRO:Invoice Item comments
C W0GPDT IFEQ 'Y'
C Z-ADD1 W0DTLN
C W0GCDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Invoice item tax
C W0HP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:Invoice item tax
C W0HP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Internal header type of PRO:Invoice item tax
C W0HP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Quote/order number of PRO:Invoice item tax
C W0HP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Shipment header number of PRO:Invoice item tax
C W0HP03 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Ship release sequence of PRO:Invoice item tax
C W0HP04 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Kit release sequence of PRO:Invoice item tax
C W0HP05 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Tax sequence of PRO:Invoice item tax
C W0HP06 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Detail line. of PRO:Invoice item tax
C W0HPDT IFEQ 'Y'
C Z-ADD2 W0DTLN
C W0HCDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Invoice special charg
C W0IP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:Invoice special charg
C W0IP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice number of PRO:Invoice special charg
C W0IP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice sequence of PRO:Invoice special charg
C W0IP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Special charge detail of PRO:Invoice special charg
C W0IPDT IFEQ 'Y'
C Z-ADD4 W0DTLN
C W0ICDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Invoice Hdr comments
C W0JP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:Invoice Hdr comments
C W0JP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice number of PRO:Invoice Hdr comments
C W0JP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice sequence of PRO:Invoice Hdr comments
C W0JP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Internal header type of PRO:Invoice Hdr comments
C W0JP03 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Quote/order number of PRO:Invoice Hdr comments
C W0JP04 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Comment user reference of PRO:Invoice Hdr comments
C W0JP05 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Comment line sequence no. of PRO:Invoice Hdr comments
C W0JP06 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice comment detail of PRO:Invoice Hdr comments
C W0JPDT IFEQ 'Y'
C Z-ADD3 W0DTLN
C W0JCDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Invoice spc chg tax
C W0KP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:Invoice spc chg tax
C W0KP00 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice number of PRO:Invoice spc chg tax
C W0KP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice sequence of PRO:Invoice spc chg tax
C W0KP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Special charge sequence # of PRO:Invoice spc chg tax
C W0KP03 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Tax sequence of PRO:Invoice spc chg tax
C W0KP04 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Detail line. of PRO:Invoice spc chg tax
C W0KPDT IFEQ 'Y'
C Z-ADD2 W0DTLN
C W0KCDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
* * First Page Format of PRO:Invoice Tax Summary
C W0LP1P IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Company number of PRO:Invoice Tax Summary
C W0LP00 IFEQ 'Y'
C ADD 1 W0FSUM
C END FI
* * Invoice number of PRO:Invoice Tax Summary
C W0LP01 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Invoice sequence of PRO:Invoice Tax Summary
C W0LP02 IFEQ 'Y'
C ADD 0 W0FSUM
C END FI
* * Detail line. of PRO:Invoice Tax Summary
C W0LPDT IFEQ 'Y'
C Z-ADD2 W0DTLN
C W0LCDT IFEQ 'Y'
C Z-ADD0 W0COLN
C END FI
C END FI
*================================================================
CSR Q2EXIT ENDSR
/EJECT
CSR Q3PTNP BEGSR
*================================================================
* Format select
*================================================================
C WRITEZAPAGHDR
* Clear page overflow indicator
C SETOF 97 *
*================================================================
CSR Q3EXIT ENDSR
/EJECT
CSR SARVGN BEGSR
*================================================================
* RTV:Tax in Price Flag - Company *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSA KLIST
C KFLD A5AENB Company number
* Setup key
C Z-ADDP1AENB A5AENB Company number
* Establish starting position
C KRSSA CHAINFA0REC5 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0266' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK P5Z9JB Tax in price fl
C GOTO SAEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELA5Z9JB P5Z9JB Tax in price fl
C ENDIF
*================================================================
CSR SAEXIT ENDSR
/EJECT
CSR SBRVGN BEGSR
*================================================================
* RTV:Print EDI acknowlgmnt - EDI trading partner *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSB KLIST
C KFLD IWABML COMPANY NUMBER
C KFLD IWABMM CUSTOMER NUMBER
C KFLD IWTYPX Send or Receive
C KFLD IWDIDX Document Type I
* Setup key
C Z-ADDP1AENB IWABML COMPANY NUMBER
C Z-ADDP1CANB IWABMM CUSTOMER NUMBER
C MOVEL'S' IWTYPX Send or Receive
C MOVE *BLANK IWDIDX Document Type I
C MOVEL'855' IWDIDX Document Type I
* Establish starting position
C KRSSB CHAINFIWREDP 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMZ2134' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SBEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* See if we need to print the document.
* CASE: DB1.Print document? is Yes
C IWACRX IFEQ '1' *IF
C MOVEL'Y2U0003' W0RTN *Return code
C ELSE
* CASE: *OTHERWISE
C MOVEL*BLANK W0RTN *Return code
C END *FI
C ENDIF
*================================================================
CSR SBEXIT ENDSR
/EJECT
CSR SCRVGN BEGSR
*================================================================
* RTV:Chk for document send - EC Document/Media XREF *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSC KLIST
C KFLD JUAENB Company number
C KFLD JUCANB Customer number
C KFLD JUAD08 EC Document Typ
C KFLD JUAD06 EC Media type I
* Setup key
C Z-ADDZBAENB JUAENB Company number
C Z-ADDZBCANB JUCANB Customer number
C MOVEL'006' JUAD08 EC Document Typ
C MOVEL'E' JUAD06 EC Media type I
* Establish starting position
C KRSSC CHAINFJUREI4 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB3084' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SCEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
C MOVEL'Y2U0003' W0RTN *Return code
C ENDIF
*================================================================
CSR SCEXIT ENDSR
/EJECT
CSR SDRVGN BEGSR
*================================================================
* RTV:External header type - Header Type *
*================================================================
C MOVEL*BLANK WN0001 25 Internal header
C MOVEL*BLANK WN0002 25 Header type des
C MOVEL*BLANK WN0003 1 Exit request st
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C MOVEL*BLANK WN0004 1 Internal header
C MOVEL*BLANK WN0005 25 Description (25
C MOVEL*BLANK WN0006 25 Header type des
C MOVEL*BLANK WN0007 2 External header
* INT:RTV Hdr Typ Arr
C MOVELZBDCCD WN0004 Internal header
* EXT:CRT/RTV Hdr Typ Arr - Header Type *
C CALL 'AMBQDXFR' 90 EXT:CRT/RTV Hdr
C PARM *BLANK W0RTN 7
C PARM '1' WQ0075 1 Prc hdr typ opt
C WN0004 PARM WN0004 WQ0076 1 Internal header
C WN0005 PARM WN0005 WQ0077 25 Internal header
C WN0006 PARM WN0006 WQ0078 25 Header type des
C WN0007 PARM WN0007 WQ0079 2 External header
C WN0003 PARM WN0003 WQ0080 1 Exit request st
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBQDXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C MOVELWN0005 WN0001 Internal header
C MOVELWN0006 WN0002 Header type des
C MOVELWN0007 WUAAHZ External header
* Check if record in array. (QUIT)
* CASE: PAR.Exit request status (USR) is Error
C WN0003 IFEQ 'E' *IF
* ** No record in the array.
* Read the record and write to the array.
C ELSE
* CASE: *OTHERWISE
* ** Record found.
* No need to read the file.
C GOTO SDEXIT *QUIT
C END *FI
* Define keylist
C KRSSD KLIST
C KFLD BVDCCD Internal header
* Setup key
C MOVELZBDCCD BVDCCD Internal header
* Establish starting position
C KRSSD CHAINFC0REGT 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0414' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WN0001 Internal header
C MOVEL*BLANK WN0002 Header type des
C MOVEL*BLANK WUAAHZ External header
C MOVEL*BLANK WN0003 Exit request st
C GOTO SDEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELBVDNTX WN0001 Internal header
C MOVELBVCVTX WN0002 Header type des
C MOVELBVAAHZ WUAAHZ External header
C MOVEL*BLANK WN0008 1 Internal header
C MOVEL*BLANK WN0009 1 Exit request st
C MOVEL*BLANK WN0010 25 Description (25
C MOVEL*BLANK WN0011 25 Header type des
C MOVEL*BLANK WN0012 2 External header
* INT:CRT Hdr Typ Arr
C MOVELBVDCCD WN0008 Internal header
C MOVELBVDNTX WN0010 Description (25
C MOVELBVCVTX WN0011 Header type des
C MOVELBVAAHZ WN0012 External header
* EXT:CRT/RTV Hdr Typ Arr - Header Type *
C CALL 'AMBQDXFR' 90 EXT:CRT/RTV Hdr
C PARM *BLANK W0RTN 7
C PARM '0' WQ0081 1 Prc hdr typ opt
C WN0008 PARM WN0008 WQ0082 1 Internal header
C WN0010 PARM WN0010 WQ0083 25 Internal header
C WN0011 PARM WN0011 WQ0084 25 Header type des
C WN0012 PARM WN0012 WQ0085 2 External header
C WN0009 PARM WN0009 WQ0086 1 Exit request st
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBQDXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
C GOTO SDEXIT *QUIT
C ENDIF
*================================================================
CSR SDEXIT ENDSR
/EJECT
CSR SERVGN BEGSR
*================================================================
* RTV:Get All Terms Info. - Terms *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Check for IFM is installed
* RTV:SYSCTL Installed app - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0087 4 Application ali
C WUADRB PARM *BLANK WQ0088 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* CASE: WRK.Installed apps conditions is Installed
C WUADRB IFEQ '1' *IF
C MOVELZBBLCD WUACKW Terms code (USR
* Get IFM best terms info - IFM Programs *
C CALL 'UAFUXFR' 90 Get IFM best te
C W0RTN PARM W0RTN WQ0089 7 Return code IFM
C PARM WUACKW WQ0090 2 Terms code (USR
C WUADLL PARM *ZERO WQ0091 52 Discount percen
C WUCXNB PARM *ZERO WQ0092 30 Terms discount
C WUCYNB PARM *ZERO WQ0093 30 Terms net due d
C ZBAAN2 PARM *BLANK WQ0094 25 Terms descripti
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UAFUXFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Check for IFM terms code not found
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* PAR = CON By name
C MOVEL*BLANK ZBAAN2 Terms descripti
C Z-ADD*ZERO WUCXNB Terms discount
C Z-ADD*ZERO WUCYNB Terms net due d
C Z-ADD*ZERO WUABPC Terms percent
C ELSE
* CASE: *OTHERWISE
* Note; COM percent is 7.3 field, IFM percent is 5.2 field
C Z-ADD*ZERO WUABPC Terms percent
C ADD WUADLL WUABPC Terms percent
C END *FI
C GOTO SEEXIT *QUIT
C END *FI
* Define keylist
C KRSSE KLIST
C KFLD DYBLCD Terms code
* Setup key
C MOVELZBBLCD DYBLCD Terms code
* Establish starting position
C KRSSE CHAINFA2REDC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0270' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZBAAN2 Terms descripti
C Z-ADD*ZERO WUCXNB Terms discount
C Z-ADD*ZERO WUCYNB Terms net due d
C Z-ADD*ZERO WUABPC Terms percent
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SEEXIT *QUIT
C GOTO SEEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELDYA2TX ZBAAN2 Terms descripti
C Z-ADDDYCXNB WUCXNB Terms discount
C Z-ADDDYCYNB WUCYNB Terms net due d
C Z-ADDDYABPC WUABPC Terms percent
C ENDIF
*================================================================
CSR SEEXIT ENDSR
/EJECT
CSR SFRVGN BEGSR
*================================================================
* RTV:Local description - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* This function is used STRICTLY to retrieve the 00 company
* record, this will contain the local currency even when IFM
* is installed.
* Define keylist
C KRSSF KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADD*ZERO EPAENB Company number
C MOVELZBBRCD EPBRCD Currency ID
* Establish starting position
C KRSSF CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZBAAAR Currency descri
C GOTO SFEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX ZBAAAR Currency descri
C ENDIF
*================================================================
CSR SFEXIT ENDSR
/EJECT
CSR SGRVGN BEGSR
*================================================================
* RTV: description - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Check if IFM is installed?
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0096 4 Application ali
C WUADVB PARM *BLANK WQ0097 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* If IFM installed, Currency file only has Company 01 records.
* CASE:
* - c1 AND c2
* |- c1 : WRK.Installed apps - IFM is Installed
* |- c2 : PAR.Company number is Not equal 01
* '-
C MOVEL'0' Y0CX01 1
C WUADVB IFEQ '1' *IF
C ZBAENB IFNE 01 *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C Z-ADD01 WUAAQR Company number
* RTV:All information IFM - CURRENCY *
C EXSR SHRVGN
C GOTO SGEXIT *QUIT
C END *FI
* Define keylist
C KRSSG KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDZBAENB EPAENB Company number
C MOVELZBBRCD EPBRCD Currency ID
* Establish starting position
C KRSSG CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZBAAAR Currency descri
C GOTO SGEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX ZBAAAR Currency descri
C ENDIF
*================================================================
CSR SGEXIT ENDSR
/EJECT
CSR SHRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSH KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWUAAQR EPAENB Company number
C MOVELZBBRCD EPBRCD Currency ID
* Establish starting position
C KRSSH CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZBAAAR Currency descri
C MOVEL*BLANK WUAALP Primary Currenc
C Z-ADD*ZERO WUAJNB Exchange rate c
C Z-ADD*ZERO WUAKNB Decimal positio
C MOVEL*BLANK WUALNB AP exchange gai
C MOVEL*BLANK WUAMNB AR exchange gai
C Z-ADD*ZERO WUABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SHEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX ZBAAAR Currency descri
C MOVELEPAALP WUAALP Primary Currenc
C Z-ADDEPAJNB WUAJNB Exchange rate c
C Z-ADDEPAKNB WUAKNB Decimal positio
C MOVELEPALNB WUALNB AP exchange gai
C MOVELEPAMNB WUAMNB AR exchange gai
C Z-ADDEPABVA WUABVA Price adjustmen
C ENDIF
*================================================================
CSR SHEXIT ENDSR
/EJECT
CSR SIRVGN BEGSR
*================================================================
* RTV:Address format - Customer *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSI KLIST
C KFLD BFAENB Company number
C KFLD BFCANB Customer number
* Setup key
C Z-ADDP1AENB BFAENB Company number
C Z-ADDP1CANB BFCANB Customer number
* Establish starting position
C KRSSI CHAINFGRREMF 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0690' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
* PAR = CON By name
C MOVEL*BLANK WUHYST Address format
C GOTO SIEXIT *QUIT
C GOTO SIEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELBFHYST WUHYST Address format
C ENDIF
*================================================================
CSR SIEXIT ENDSR
/EJECT
CSR SJRVGN BEGSR
*================================================================
* RTV:Addr Code, Ship Lead - Ship to *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN DEAENB WQSJ01 Company number
C *LIKE DEFN DECANB WQSJ02 Customer number
C *LIKE DEFN DEB9CD WQSJ03 Ship to number
* Define keylist
C KRSSJ KLIST
C KFLD WQSJ01 Company number
C KFLD WQSJ02 Customer number
C KFLD WQSJ03 Ship to number
* Setup key
C Z-ADDP1AENB WQSJ01 Company number
C Z-ADDP1CANB WQSJ02 Customer number
C MOVELC6B9CD WQSJ03 Ship to number
* Establish starting position
C KRSSJ SETLLFDEREC0 *
C KRSSJ READEFDEREC0 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0332' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C Z-ADD*ZERO WUEENB Shipment lead t
C Z-ADD*ZERO WUCUCD Address code
C GOTO SJEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* PAR = DB1 By name
C Z-ADDDECPNB WUEENB Shipment lead t
C Z-ADDDECUCD WUCUCD Address code
C KRSSJ READEFDEREC0 90*
C ENDDO
*================================================================
CSR SJEXIT ENDSR
/EJECT
CSR SKRVGN BEGSR
*================================================================
* RTV:Address Details - Address *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSK KLIST
C KFLD ALAENB Company number
C KFLD ALCANB Customer number
C KFLD ALCUCD Address code
* Setup key
C Z-ADDP1AENB ALAENB Company number
C Z-ADDP1CANB ALCANB Customer number
C Z-ADDWUCUCD ALCUCD Address code
* Establish starting position
C KRSSK CHAINFBZREDK 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0336' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZBZ9KP Addressee name
C MOVEL*BLANK WUCMTX Address line 1
C MOVEL*BLANK WUCNTX Address line 2
C MOVEL*BLANK WUCOTX Address line 3
C MOVEL*BLANK WUZ9HH Address line 4
C MOVEL*BLANK WUZ9HG Address line 5
C MOVEL*BLANK P2CVCD Postal code
C MOVEL*BLANK P2CPTX City
C MOVEL*BLANK WUCQTX Contact name
C MOVEL*BLANK WUCRTX Telephone numbe
C MOVEL*BLANK WUCSTX Fax number
C MOVEL*BLANK WUCDTX Shipping instru
C MOVEL*BLANK P2COCD Country code
C MOVEL*BLANK P2BYCD State code (key
C MOVEL*BLANK WUG5CD Ship to locatio
C MOVEL*BLANK WUBKCD Zone
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SKEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELALCLTX ZBZ9KP Addressee name
C MOVELALCMTX WUCMTX Address line 1
C MOVELALCNTX WUCNTX Address line 2
C MOVELALCOTX WUCOTX Address line 3
C MOVELALZ9HH WUZ9HH Address line 4
C MOVELALZ9HG WUZ9HG Address line 5
C MOVELALCVCD P2CVCD Postal code
C MOVELALCPTX P2CPTX City
C MOVELALCQTX WUCQTX Contact name
C MOVELALCRTX WUCRTX Telephone numbe
C MOVELALCSTX WUCSTX Fax number
C MOVELALCDTX WUCDTX Shipping instru
C MOVELALCOCD P2COCD Country code
C MOVELALBYCD P2BYCD State code (key
C MOVELALG5CD WUG5CD Ship to locatio
C MOVELALBKCD WUBKCD Zone
C GOTO SKEXIT *QUIT
C ENDIF
*================================================================
CSR SKEXIT ENDSR
/EJECT
CSR SLRVGN BEGSR
*================================================================
* RTV:Address Details - Address *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSL KLIST
C KFLD ALAENB Company number
C KFLD ALCANB Customer number
C KFLD ALCUCD Address code
* Setup key
C Z-ADDP1AENB ALAENB Company number
C Z-ADDP1CANB ALCANB Customer number
C Z-ADDC6HECD ALCUCD Address code
* Establish starting position
C KRSSL CHAINFBZREDK 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0336' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZBZ9KQ Addressee name
C MOVEL*BLANK WUCMTX Address line 1
C MOVEL*BLANK WUCNTX Address line 2
C MOVEL*BLANK WUCOTX Address line 3
C MOVEL*BLANK WUZ9HH Address line 4
C MOVEL*BLANK WUZ9HG Address line 5
C MOVEL*BLANK WUCVCD Postal code
C MOVEL*BLANK WUCPTX City
C MOVEL*BLANK WUCQTX Contact name
C MOVEL*BLANK WUCRTX Telephone numbe
C MOVEL*BLANK WUCSTX Fax number
C MOVEL*BLANK WUCDTX Shipping instru
C MOVEL*BLANK WUCOCD Country code
C MOVEL*BLANK WUBYCD State code (key
C MOVEL*BLANK WUG5CD Ship to locatio
C MOVEL*BLANK WUBKCD Zone
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SLEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELALCLTX ZBZ9KQ Addressee name
C MOVELALCMTX WUCMTX Address line 1
C MOVELALCNTX WUCNTX Address line 2
C MOVELALCOTX WUCOTX Address line 3
C MOVELALZ9HH WUZ9HH Address line 4
C MOVELALZ9HG WUZ9HG Address line 5
C MOVELALCVCD WUCVCD Postal code
C MOVELALCPTX WUCPTX City
C MOVELALCQTX WUCQTX Contact name
C MOVELALCRTX WUCRTX Telephone numbe
C MOVELALCSTX WUCSTX Fax number
C MOVELALCDTX WUCDTX Shipping instru
C MOVELALCOCD WUCOCD Country code
C MOVELALBYCD WUBYCD State code (key
C MOVELALG5CD WUG5CD Ship to locatio
C MOVELALBKCD WUBKCD Zone
C GOTO SLEXIT *QUIT
C ENDIF
*================================================================
CSR SLEXIT ENDSR
/EJECT
CSR SMRVGN BEGSR
*================================================================
* RTV:Default Cust Address - Address *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WAAENB WQSM01 Company number
C *LIKE DEFN WACANB WQSM02 Customer number
C *LIKE DEFN WAE2ST WQSM03 Address type (k
* Define keylist
C KRSSM KLIST
C KFLD WQSM01 Company number
C KFLD WQSM02 Customer number
C KFLD WQSM03 Address type (k
* Setup key
C Z-ADDP1AENB WQSM01 Company number
C Z-ADDP1CANB WQSM02 Customer number
C MOVEL'1' WQSM03 Address type (k
* Establish starting position
C KRSSM SETLLFALREZM *
C KRSSM READEFALREZM 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0336' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SMEXIT *QUIT
C GOTO SMEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* PAR = DB1 By name
C Z-ADDWACUCD WUCUCD Address code
C MOVELWACLTX ZBZ9KQ Addressee name
C MOVELWACMTX WUCMTX Address line 1
C MOVELWACNTX WUCNTX Address line 2
C MOVELWACOTX WUCOTX Address line 3
C MOVELWAZ9HH WUZ9HH Address line 4
C MOVELWAZ9HG WUZ9HG Address line 5
C MOVELWACVCD WUCVCD Postal code
C MOVELWACPTX WUCPTX City
C MOVELWACQTX WUCQTX Contact name
C MOVELWACRTX WUCRTX Telephone numbe
C MOVELWACSTX WUCSTX Fax number
C MOVELWACDTX WUCDTX Shipping instru
C MOVELWACOCD WUCOCD Country code
C MOVELWABYCD WUBYCD State code (key
C MOVELWAG5CD WUG5CD Ship to locatio
C MOVELWABKCD WUBKCD Zone
C GOTO SMEXIT *QUIT
C KRSSM READEFALREZM 90*
C ENDDO
*================================================================
CSR SMEXIT ENDSR
/EJECT
CSR SNRVGN BEGSR
*================================================================
* RTV:Get P.O.No. - Credit Memo Extension *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSN KLIST
C KFLD BCAENB Company number
C KFLD BCDCCD Internal header
C KFLD BCCVNB Quote/order num
* Setup key
C Z-ADDP1AENB BCAENB Company number
C MOVELP1DCCD BCDCCD Internal header
C MOVELP1CVNB BCCVNB Quote/order num
* Establish starting position
C KRSSN CHAINFGQCPLS 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0688' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZBCBTX Purchase order
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SNEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELBCCBTX ZBCBTX Purchase order
C MOVEL*BLANK W0RTN *Return code
C ENDIF
*================================================================
CSR SNEXIT ENDSR
/EJECT
CSR SORVGN BEGSR
*================================================================
* RTV:Order Comments Exist - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN GAAENB WQSO01 Company number
C *LIKE DEFN GADCCD WQSO02 Internal header
C *LIKE DEFN GACVNB WQSO03 Quote/order num
* Define keylist
C KRSSO KLIST
C KFLD WQSO01 Company number
C KFLD WQSO02 Internal header
C KFLD WQSO03 Quote/order num
* Setup key
C Z-ADDC6AENB WQSO01 Company number
C MOVELZCDCCD WQSO02 Internal header
C MOVELZCCVNB WQSO03 Quote/order num
* Establish starting position
C KRSSO SETLLFGACPRJ *
C KRSSO READEFGACPRJ 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0798' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SOEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE:
* - c1 AND c2
* |- c1 : DB1.Ship release sequence is Zero
* |- c2 : DB1.Special charge sequence # is Zero
* '-
C MOVEL'0' Y0CX01 1
C GALCNB IFEQ *ZERO *IF
C GAAAD2 IFEQ *ZERO *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL'Y2U0003' W0RTN *Return code
C GOTO SOEXIT *QUIT
C ELSE
* CASE: *OTHERWISE
C MOVEL'Y2U0005' W0RTN *Return code
C END *FI
C KRSSO READEFGACPRJ 90*
C ENDDO
*================================================================
CSR SOEXIT ENDSR
/EJECT
CSR SPRVGN BEGSR
*================================================================
* RTV:Header Commnt - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSP KLIST
C KFLD WCAENB Company number
C KFLD WCGGNB Invoice number
C KFLD WCHYNB Invoice sequenc
C KFLD WCKBNB Comment line se
C KFLD WCAKCD Language code
* Setup key
C Z-ADDZDAENB WCAENB Company number
C Z-ADDZDGGNB WCGGNB Invoice number
C Z-ADDZDHYNB WCHYNB Invoice sequenc
C Z-ADDWUKBNB WCKBNB Comment line se
C MOVELZDAKCD WCAKCD Language code
* Establish starting position
C KRSSP CHAINFGACPYO 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0798' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUHDTX Comment line te
C GOTO SPEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELWCHDTX WUHDTX Comment line te
C GOTO SPEXIT *QUIT
C ENDIF
*================================================================
CSR SPEXIT ENDSR
/EJECT
CSR SQRVGN BEGSR
*================================================================
* RTV:Build lines up header - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD1 WUAAJH Counter
C MOVELZDAKCD WUHVCD Language code U
C Z-ADD*ZERO WUAFD6 Comment line se
* Declare restrictor key work fields
C *LIKE DEFN WCAENB WQSQ01 Company number
C *LIKE DEFN WCGGNB WQSQ02 Invoice number
C *LIKE DEFN WCHYNB WQSQ03 Invoice sequenc
* Define keylist
C KPSSQ KLIST
C KFLD WQSQ01 Company number
C KFLD WQSQ02 Invoice number
C KFLD WQSQ03 Invoice sequenc
C KFLD WCKBNB Comment line se
* Define keylist
C KRSSQ KLIST
C KFLD WQSQ01 Company number
C KFLD WQSQ02 Invoice number
C KFLD WQSQ03 Invoice sequenc
* Setup key
C Z-ADDZDAENB WQSQ01 Company number
C Z-ADDZDGGNB WQSQ02 Invoice number
C Z-ADDZDHYNB WQSQ03 Invoice sequenc
C Z-ADDWUKBNB WCKBNB Comment line se
* Establish starting position
C KPSSQ SETLLFGACPYO *
C KRSSQ READEFGACPYO 90*
* Data record not found
C 90 MOVEL'AMB0798' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
C MOVEL'1' WUAA04 Continue?
* Make sure this is not a line item comment and it is supposed to p
* CASE: DB1.Internal print only? is Yes
C WCAAD9 IFEQ '1' *IF
C MOVEL'0' WUAA04 Continue?
C ELSE
* CASE: DB1.Ship release sequence is Not Zero
C WCLCNB IFNE *ZERO *IF
* Do not print comments for line items
C MOVEL'0' WUAA04 Continue?
C END *FI
C END *FI
* Par special charge seq NE DB1 special charge seq, then print=no
* CASE: PAR.Special charge sequence # NE DB1.Special charge sequenc
C ZDAAD2 IFNE WCAAD2 *IF
C MOVEL'0' WUAA04 Continue?
C END *FI
* set up 2up or 3up
* CASE: WRK.Continue? is Yes
C WUAA04 IFEQ '1' *IF
* CASE: If Print Control,Reference,and Language equal PAR
* - c1 AND c2 AND c3
* |- c1 : DB1.Text line print control EQ PAR.Text line print c
* |- c2 : DB1.Comment user reference EQ PAR.Comment user refer
* |- c3 : DB1.Language code EQ PAR.Language code
* '-
C MOVEL'0' Y0CX01 1
C WCAD1N IFEQ ZDAD1N *IF
C WCHXCD IFEQ ZDHXCD *IF
C WCAKCD IFEQ ZDAKCD *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* 2 lines up process:
* CASE: DB1.Text line print control is 2 lines up
C WCAD1N IFEQ '2' *IF
C Z-ADDWCKBNB WUAFD6 Comment line se
C MOVELWCAKCD WUHVCD Language code U
C Z-ADD1 ZQ 50
C ZDAFD5 CAT WCHDTX:ZQ ZDAFD5 P Text Line Descr
C GOTO SQEXIT *QUIT
C END *FI
* 3 lines up process:
* CASE: DB1.Text line print control is 3 lines up
C WCAD1N IFEQ '3' *IF
C ADD 1 WUAAJH Counter
* CASE: WRK.Counter is EQ 2
C WUAAJH IFEQ 2 *IF
C Z-ADDWCKBNB WUAFD6 Comment line se
C MOVELWCAKCD WUHVCD Language code U
C Z-ADD1 ZQ 50
C ZDAFD5 CAT WCHDTX:ZQ ZDAFD5 P Text Line Descr
C ELSE
* CASE: WRK.Counter is EQ 3
C WUAAJH IFEQ 3 *IF
* ** test if room allows for 3 across comments
C Z-ADD1 ZQ 50
C ZDAFD5 CAT WCHDTX:ZQ WUAFD7 P Text line 77 US
C Z-ADD2 YRSW00
C Z-ADD76 ZQ 50
C YRSW00 IFLT 1
C ZQ ORLT 1
C YRSW00 ORGT 00077
C ZQ ORGT 00077
C MOVEL'Y2U0510' W0RTN
C ELSE
C YRSW00 SUBSTWUAFD7:ZQ WUACC3 P 90 &Alpha 2 USR
C 90 MOVEL'Y2U0510' W0RTN
C END
* If characters are in the last 2 postions quite, other concat
* CASE: WRK.&Alpha 2 USR is Not blank
C WUACC3 IFGT *BLANK *IF
C GOTO SQEXIT *QUIT
C ELSE
* CASE: *OTHERWISE
C Z-ADDWCKBNB WUAFD6 Comment line se
C MOVELWCAKCD WUHVCD Language code U
C Z-ADD1 ZQ 50
C ZDAFD5 CAT WCHDTX:ZQ ZDAFD5 P Text Line Descr
C GOTO SQEXIT *QUIT
C END *FI
C END *FI
C END *FI
C END *FI
C ELSE
* CASE: *OTHERWISE
C GOTO SQEXIT *QUIT
C END *FI
C END *FI
C KRSSQ READEFGACPYO 90*
C ENDDO
*================================================================
CSR SQEXIT ENDSR
/EJECT
CSR SRRVGN BEGSR
*================================================================
* RTV:Reposition ptr - History Comment *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN WBAENB WQSR01 Company number
C *LIKE DEFN WBGGNB WQSR02 Invoice number
C *LIKE DEFN WBHYNB WQSR03 Invoice sequenc
C *LIKE DEFN WBDCCD WQSR04 Internal header
C *LIKE DEFN WBCVNB WQSR05 Quote/order num
C *LIKE DEFN WBHXCD WQSR06 Comment user re
C *LIKE DEFN WBKBNB WQSR07 Comment line se
* Define keylist
C KRSSR KLIST
C KFLD WQSR01 Company number
C KFLD WQSR02 Invoice number
C KFLD WQSR03 Invoice sequenc
C KFLD WQSR04 Internal header
C KFLD WQSR05 Quote/order num
C KFLD WQSR06 Comment user re
C KFLD WQSR07 Comment line se
* Setup key
C Z-ADDWBAENB WQSR01 Company number
C Z-ADDWBGGNB WQSR02 Invoice number
C Z-ADDWBHYNB WQSR03 Invoice sequenc
C MOVELWBDCCD WQSR04 Internal header
C MOVELWBCVNB WQSR05 Quote/order num
C MOVELWBHXCD WQSR06 Comment user re
C Z-ADDWUAFD6 WQSR07 Comment line se
* Establish starting position
C KRSSR SETLLFGACPLS *
C KRSSR READEFGACPLS 90*
* Data record not found
C 90 MOVEL'AMB0798' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: PAR.Language code EQ DB1.Language code
C WUHVCD IFEQ WBAKCD *IF
C GOTO SREXIT *QUIT
C END *FI
C KRSSR READEFGACPLS 90*
C ENDDO
*================================================================
CSR SREXIT ENDSR
/EJECT
CSR SSRVGN BEGSR
*================================================================
* RTV:Chk Ord Ship not Inv - Shipment Header *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C MOVEL'0' WUZ9DA Ord ship not in
* Declare restrictor key work fields
C *LIKE DEFN DHAENB WQSS01 Company number
C *LIKE DEFN DHDCCD WQSS02 Internal header
C *LIKE DEFN DHCVNB WQSS03 Quote/order num
* Define keylist
C KRSSS KLIST
C KFLD WQSS01 Company number
C KFLD WQSS02 Internal header
C KFLD WQSS03 Quote/order num
* Setup key
C Z-ADDC6AENB WQSS01 Company number
C MOVELZCDCCD WQSS02 Internal header
C MOVELZCCVNB WQSS03 Quote/order num
* Establish starting position
C KRSSS SETLLFSSHPJH *
C KRSSS READEFSSHPJH 90*
* Data record not found
C 90 MOVEL'AMB0492' W0RTN 7
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Shipment status is in shipping
C DHINST IFEQ '00' *IF
C DHINST OREQ '20'
C MOVEL'1' WUZ9DA Ord ship not in
C GOTO SSEXIT *QUIT
C END *FI
C KRSSS READEFSSHPJH 90*
C ENDDO
* USER: Exit processing
* ** No records matching search criteria.
C MOVEL'Y2U0005' W0RTN *Return code
*================================================================
CSR SSEXIT ENDSR
/EJECT
CSR STRVGN BEGSR
*================================================================
* RTV:Ext. Doc. Print Opt. - Substitution XREF *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSST KLIST
C KFLD DMAITX Item number
C KFLD DMG7TX Substituted ite
C KFLD DMA8DT Substitute effe
* Setup key
C MOVELZFAALM DMAITX Item number
C MOVELZFAITX DMG7TX Substituted ite
C Z-ADDZZJDT DMA8DT Substitute effe
* Establish starting position
C KRSST SETGTFFGCPP3 91 *
C READPFFGCPP3 9190*
* Check high order keys
C N90 ZFAALM IFNE DMAITX Item number
C ZFAITX ORNE DMG7TX Substituted ite
C SETON 90
C END
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0596' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUHIST External doc pr
C GOTO STEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELDMHIST WUHIST External doc pr
C ENDIF
*================================================================
CSR STEXIT ENDSR
/EJECT
CSR SURVGN BEGSR
*================================================================
* RTV:Item Description - ITEM MASTER *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSU KLIST
C KFLD FIAITX Item number
* Setup key
C MOVELWL0001 FIAITX Item number
* Establish starting position
C KRSSU CHAINFEMASAG 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0244' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WL0002 Item descriptio
C GOTO SUEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELFIALTX WL0002 Item descriptio
C ENDIF
*================================================================
CSR SUEXIT ENDSR
/EJECT
CSR SVRVGN BEGSR
*================================================================
* RTV:Kit Ext Doc Print Opt - Item Master Extension *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSV KLIST
C KFLD B2AITX Item number
* Setup key
C MOVELZFAITX B2AITX Item number
* Establish starting position
C KRSSV CHAINFC3CPG6 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0421' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUIQST Kit ext doc pri
C GOTO SVEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELB2IQST WUIQST Kit ext doc pri
C ENDIF
*================================================================
CSR SVEXIT ENDSR
/EJECT
CSR SWRVGN BEGSR
*================================================================
* RTV:Get Itm info- ack/qte - Non-Inventoried Item *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSW KLIST
C KFLD CHAENB Company number
C KFLD CHDCCD Internal header
C KFLD CHCVNB Quote/order num
C KFLD CHFCNB Line item seque
* Setup key
C Z-ADDZFAENB CHAENB Company number
C MOVELZFDCCD CHDCCD Internal header
C MOVELZFCVNB CHCVNB Quote/order num
C Z-ADDZFFCNB CHFCNB Line item seque
* Establish starting position
C KRSSW CHAINFB5REEB 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0348' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZFAITX Non-inventoried
C MOVEL*BLANK ZFALTX Non-inventoried
C MOVEL*BLANK ZFABZW Foreign descrip
C MOVEL*BLANK WUAA80 Dimension U/M
C GOTO SWEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELCHG6CD ZFAITX Non-inventoried
C MOVELCHHPTX ZFALTX Non-inventoried
C MOVELCHAA73 ZFABZW Foreign descrip
C MOVELCHCQCD WUAA80 Dimension U/M
C ENDIF
*================================================================
CSR SWEXIT ENDSR
/EJECT
CSR SXRVGN BEGSR
*================================================================
* RTV:Stock Location - ITEM BALANCE *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSX KLIST
C KFLD FFA3CD Warehouse
C KFLD FFAITX Item number
* Setup key
C MOVELZFA3CD FFA3CD Warehouse
C MOVELZFAITX FFAITX Item number
* Establish starting position
C KRSSX CHAINFEMBLAI 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0248' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZFABA5 Warehouse stock
C GOTO SXEXIT *QUIT
C GOTO SXEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELFFAQCD ZFABA5 Warehouse stock
C ENDIF
*================================================================
CSR SXEXIT ENDSR
/EJECT
CSR SYRVGN BEGSR
*================================================================
* RTV:Description & U/M - ITEM MASTER *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSY KLIST
C KFLD FIAITX Item number
* Setup key
C MOVELZFAITX FIAITX Item number
* Establish starting position
C KRSSY CHAINFEMASAG 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0244' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZFALTX Item descriptio
C MOVEL*BLANK WUZ0NB Dimension U/M
C GOTO SYEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELFIALTX ZFALTX Item descriptio
C MOVELFICQCD WUZ0NB Dimension U/M
C ENDIF
*================================================================
CSR SYEXIT ENDSR
/EJECT
CSR SZRVGN BEGSR
*================================================================
* RTV:Industry Item Desc - Item/Industry Class XREF *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSSZ KLIST
C KFLD B6GMCD Item industry c
C KFLD B6H2TX Industry item n
* Setup key
C MOVELCDGMCD B6GMCD Item industry c
C MOVELCDH2TX B6H2TX Industry item n
* Establish starting position
C KRSSZ CHAINFF8CPOC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0652' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK ZFAAWM Industry item d
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO SZEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELB6H3TX ZFAAWM Industry item d
C ENDIF
*================================================================
CSR SZEXIT ENDSR
/EJECT
CSR TARVGN BEGSR
*================================================================
* RTV: Item foreign desc - ITEM FOREIGN LANGUAGE *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSTA KLIST
C KFLD FGAITX Item number
C KFLD FGAKCD Language code
* Setup key
C MOVELZFAITX FGAITX Item number
C MOVELCDAKCD FGAKCD Language code
* Establish starting position
C KRSTA CHAINFMLANAO 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0240' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUALCD Item descriptio
C MOVEL*BLANK WUAJTX Item descriptio
C MOVEL*BLANK ZFABZW Item descriptio
C GOTO TAEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELFGALCD WUALCD Item descriptio
C MOVELFGAJTX WUAJTX Item descriptio
C MOVELFGAKTX ZFABZW Item descriptio
C ENDIF
*================================================================
CSR TAEXIT ENDSR
/EJECT
CSR TBRVGN BEGSR
*================================================================
* RTV: Item foreign desc - ITEM FOREIGN LANGUAGE *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSTB KLIST
C KFLD FGAITX Item number
C KFLD FGAKCD Language code
* Setup key
C MOVELZFAITX FGAITX Item number
C MOVEL'000' FGAKCD Language code
* Establish starting position
C KRSTB CHAINFMLANAO 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0240' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK WUALCD Item descriptio
C MOVEL*BLANK WUAJTX Item descriptio
C MOVEL*BLANK ZFABZW Item descriptio
C GOTO TBEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELFGALCD WUALCD Item descriptio
C MOVELFGAJTX WUAJTX Item descriptio
C MOVELFGAKTX ZFABZW Item descriptio
C ENDIF
*================================================================
CSR TBEXIT ENDSR
/EJECT
CSR TCRVGN BEGSR
*================================================================
* RTV: All fields - Ship to *
*================================================================
C MOVEL*BLANK WN0016 10 Route - user fi
C MOVEL*BLANK WN0017 10 Stop - user fie
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSTC KLIST
C KFLD WDAENB Company number
C KFLD WDCANB Customer number
C KFLD WDB9CD Ship to number
* Setup key
C Z-ADDZFAENB WDAENB Company number
C Z-ADDZFCANB WDCANB Customer number
C MOVELZFABAZ WDB9CD Ship to number
* Establish starting position
C KRSTC CHAINFPMASB0 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0332' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TCEXIT *QUIT
C GOTO TCEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C Z-ADDWDCPNB WN0015 Shipment lead t
C MOVELWDHITX ZFAA66 Alpha sort name
C Z-ADDWDAPPC WUAPPC Commissionable
C MOVELWDAA9L WUAA9L Default ship to
C MOVELWDE2ST WUE2ST Address type (k
C MOVELWDAD0V YN0001 Packing hierarc
C MOVELWDAD0Z YN0002 Originating shi
C MOVELWDAFCW YN0003 Packing list fo
C MOVELWDUUSA YN0004 User Field - Sw
C MOVELWDUUCA YN0005 User Field - Co
C MOVELWDUUCB YN0006 User Field - Co
C MOVELWDUUCC YN0007 User Field - Co
C Z-ADDWDUUD1 YN0008 User Field - Da
C MOVELWDUU40 YN0009 User Field - Te
C Z-ADDWDAFFA YN0010 GEO Code - SP R
C MOVELWDZ93M YN0011 Stage area
C MOVELWDZ95V WN0016 Route - user fi
C MOVELWDZ95W WN0017 Stop - user fie
C MOVELWDZ0J7 YN0012 Active/inactive
C MOVELWDBNST YN0013 Export designat
C Z-ADDWDCUCD WUCUCD Address code
C MOVELWDBHST WUBHST Sale code
C MOVELWDBXCD WUBXCD Tax suffix (key
C MOVELWDC7CD WUC7CD Customer class
C MOVELWDAAB4 WUAAB4 EEC transaction
C MOVELWDAABZ WUAABZ Transport mode
C MOVELWDAAB6 WUAAB6 Delivery terms
C MOVELWDADR6 YN0014 Market analysis
C MOVELWDF1CD YN0015 Carrier ID
C Z-ADDWDCHNB YN0016 Salesrep number
C MOVELWDA3CD YN0017 Warehouse
C MOVELWDZ0J8 YN0018 Packing languag
C Z-ADDWDALDT YN0019 Create date
C Z-ADDWDABTM YN0020 Create time
C MOVELWDAFVN YN0021 Created by user
C MOVELWDAGVN YN0022 Created by prog
C Z-ADDWDAMDT YN0023 Change date
C Z-ADDWDACTM YN0024 Change time
C MOVELWDAHVN YN0025 Changed by user
C MOVELWDAIVN YN0026 Changed by prog
C MOVEL*BLANK W0RTN *Return code
C GOTO TCEXIT *QUIT
C ENDIF
*================================================================
CSR TCEXIT ENDSR
/EJECT
CSR TDRVGN BEGSR
*================================================================
* RTV:Dates 1st open rlse - Release *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN ADAENB WQTD01 Company number
C *LIKE DEFN ADDCCD WQTD02 Internal header
C *LIKE DEFN ADCVNB WQTD03 Quote/order num
C *LIKE DEFN ADFCNB WQTD04 Line item seque
* Define keylist
C KRSTD KLIST
C KFLD WQTD01 Company number
C KFLD WQTD02 Internal header
C KFLD WQTD03 Quote/order num
C KFLD WQTD04 Line item seque
* Setup key
C Z-ADDZFAENB WQTD01 Company number
C MOVELZFDCCD WQTD02 Internal header
C MOVELZFCVNB WQTD03 Quote/order num
C Z-ADDZFFCNB WQTD04 Line item seque
* Establish starting position
C KRSTD SETLLMBADRE1 *
C KRSTD READEMBADRE1 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0316' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C Z-ADD*ZERO WUBIDT Latest promise
C Z-ADD*ZERO WUBJDT Latest request
C GOTO TDEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE:
* - c1 AND c2
* |- c1 : DB1.Kit release sequence is Zero
* |- c2 : DB1.Release status is Open
* '-
C MOVEL'0' Y0CX01 1
C ADAASZ IFEQ *ZERO *IF
C ADHFCD IFEQ '20' *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* PAR = DB1 By name
C Z-ADDADBIDT WUBIDT Latest promise
C Z-ADDADBJDT WUBJDT Latest request
C GOTO TDEXIT *QUIT
C END *FI
C KRSTD READEMBADRE1 90*
C ENDDO
*================================================================
CSR TDEXIT ENDSR
/EJECT
CSR TERVGN BEGSR
*================================================================
* RTV:Get Calendar ID - WAREHOUSE MASTER *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* This functions gets the Calendar ID
C MOVEL*BLANK WN0020 Calendar ID
* Define keylist
C KRSTE KLIST
C KFLD FTA3CD Warehouse
* Setup key
C MOVELZFA3CD FTA3CD Warehouse
* Establish starting position
C KRSTE CHAINFSMSTAE 90 *
* Data record not found
C 90 MOVEL'AMB0246' W0RTN 7
C *IN90 IFEQ '0'
* USER: Process Data record
C MOVELFTGSCD WN0020 Calendar ID
C ENDIF
*================================================================
CSR TEEXIT ENDSR
/EJECT
CSR TFRVGN BEGSR
*================================================================
* RTV: Sub Calendar Days - Calendar Day *
*================================================================
C Z-ADD*ZERO WN0023 30 Counter
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* This function subtract the user supplied # of calendar days to a
* supplied calendar date and calculates the resulting calendar date
C Z-ADD*ZERO WN0023 Counter
C Z-ADD*ZERO WN0021 To calendar dat
C MOVEL'0' WN0022 Add days return
* Declare restrictor key work fields
C *LIKE DEFN AQGSCD WQTF01 Calendar ID
* Define keylist
C KPSTF KLIST
C KFLD WQTF01 Calendar ID
C KFLD AQC2NB Calendar date
* Define keylist
C KRSTF KLIST
C KFLD WQTF01 Calendar ID
* Setup key
C MOVELWN0020 WQTF01 Calendar ID
C Z-ADDWUBIDT AQC2NB Calendar date
* Establish starting position
C KPSTF SETLLFAQREE9 *
C KRSTF READEFAQREE9 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0590' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'1' WN0022 Add days return
C GOTO TFEXIT *QUIT
C GOTO TFEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: DB1.Calendar day status is No day
C AQHGST IFEQ *BLANK *IF
C ELSE
* CASE: *OTHERWISE
* CASE: PAR.Counter GE PAR.Number of days
C WN0023 IFGE WN0015 *IF
C Z-ADDAQC2NB WN0021 To calendar dat
C GOTO TFEXIT *QUIT
C END *FI
C ADD 1 WN0023 Counter
C END *FI
C KRSTF READEFAQREE9 90*
C ENDDO
* USER: Exit processing
C MOVEL'2' WN0022 Add days return
*================================================================
CSR TFEXIT ENDSR
/EJECT
CSR TGRVGN BEGSR
*================================================================
* RTV: Sub Work Days - Calendar Day *
*================================================================
C Z-ADD*ZERO WN0024 30 Counter
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* This function subtracts the user supplied # of working days to a
* supplied calendar date and calculates the resulting calendar date
C Z-ADD*ZERO WN0024 Counter
C Z-ADD*ZERO WN0018 To calendar dat
C MOVEL'0' WN0022 Add days return
* Declare restrictor key work fields
C *LIKE DEFN WEGSCD WQTG01 Calendar ID
* Define keylist
C KPSTG KLIST
C KFLD WQTG01 Calendar ID
C KFLD WEC2NB Calendar date
* Define keylist
C KRSTG KLIST
C KFLD WQTG01 Calendar ID
* Setup key
C MOVELWN0020 WQTG01 Calendar ID
C Z-ADDWN0021 WEC2NB Calendar date
* Establish starting position
C KPSTG SETLLFAQRELH *
C KRSTG READEFAQRELH 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0590' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'1' WN0022 Add days return
C GOTO TGEXIT *QUIT
C GOTO TGEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: PAR.Counter GE PAR.Number of days
C WN0024 IFGE *ZERO *IF
C Z-ADDWEC2NB WN0018 To calendar dat
C GOTO TGEXIT *QUIT
C END *FI
C ADD 1 WN0024 Counter
C KRSTG READEFAQRELH 90*
C ENDDO
* USER: Exit processing
C MOVEL'2' WN0022 Add days return
*================================================================
CSR TGEXIT ENDSR
/EJECT
CSR THRVGN BEGSR
*================================================================
* RTV: Sub Work Days - CALENDARX (old assim) *
*================================================================
C MOVEL*BLANK WN0025 10 Calendar name
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* This function subtracts the user specified # of work days from a
* supplied date and returns the calculated Shop Calendar date.
C Z-ADD*ZERO WUAAJH Counter
C Z-ADD*ZERO ZFAAT0 To calendar dat
C MOVEL'0' WN0022 Add days return
* Retrieve calendar for primary key
* EXT:Get Cal ID or default - WAREHOUSE MASTER *
C CALL 'AMBWWXFR' 90 EXT:Get Cal ID
C PARM *BLANK W0RTN 7
C PARM ZFA3CD WQ0149 3 Warehouse
C WN0025 PARM WN0025 WQ0150 10 Production Cale
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBWWXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* Move calendar name to output parameter
C MOVELWN0025 WUAB5K Production Cale
* Declare restrictor key work fields
C *LIKE DEFN G3ABPR WQTH01 Calendar name
* Define keylist
C KPSTH KLIST
C KFLD WQTH01 Calendar name
C KFLD G3AAWN Calendar date n
* Define keylist
C KRSTH KLIST
C KFLD WQTH01 Calendar name
* Setup key
C MOVELWN0025 WQTH01 Calendar name
C Z-ADDWN0018 G3AAWN Calendar date n
* Establish starting position
C KPSTH SETLLFLNDRCK *
C KRSTH READEFLNDRCK 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0296' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'2' WN0022 Add days return
C GOTO THEXIT *QUIT
C GOTO THEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: WRK.Counter GE PAR.Number of days
C WUAAJH IFGE *ZERO *IF
C Z-ADDG3AAWN ZFAAT0 To calendar dat
C GOTO THEXIT *QUIT
C END *FI
C ADD 1 WUAAJH Counter
C KRSTH READEFLNDRCK 90*
C ENDDO
* USER: Exit processing
C MOVEL'2' WN0022 Add days return
*================================================================
CSR THEXIT ENDSR
/EJECT
CSR TIRVGN BEGSR
*================================================================
* RTV:Existence check - end - Shipment Header *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
C Z-ADD*ZERO WUAAJH Counter
* Declare restrictor key work fields
C *LIKE DEFN DHAENB WQTI01 Company number
C *LIKE DEFN DHDCCD WQTI02 Internal header
C *LIKE DEFN DHCVNB WQTI03 Quote/order num
* Define keylist
C KRSTI KLIST
C KFLD WQTI01 Company number
C KFLD WQTI02 Internal header
C KFLD WQTI03 Quote/order num
* Setup key
C Z-ADDZFAENB WQTI01 Company number
C MOVELZFDCCD WQTI02 Internal header
C MOVELZFCVNB WQTI03 Quote/order num
* Establish starting position
C KRSTI SETLLFSSHPJH *
C KRSTI READEFSSHPJH 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0492' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C MOVEL*BLANK WUAGVN Created by prog
C Z-ADD*ZERO WUAAJH Counter
C GOTO TIEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
C MOVEL*BLANK W0RTN *Return code
* CASE: DB1.Created by program is AMBF9XFR
C DHAGVN IFEQ 'AMBF9XFR' *IF
C MOVELDHAGVN WUAGVN Created by prog
C ADD 1 WUAAJH Counter
C ELSE
* CASE: *OTHERWISE
C MOVEL*BLANK WUAGVN Created by prog
C Z-ADD*ZERO WUAAJH Counter
C GOTO TIEXIT *QUIT
C END *FI
C KRSTI READEFSSHPJH 90*
C ENDDO
*================================================================
CSR TIEXIT ENDSR
/EJECT
CSR TJRVGN BEGSR
*================================================================
* RTV:Total Open Rlse Qty - Release *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN ADAENB WQTJ01 Company number
C *LIKE DEFN ADDCCD WQTJ02 Internal header
C *LIKE DEFN ADCVNB WQTJ03 Quote/order num
C *LIKE DEFN ADFCNB WQTJ04 Line item seque
* Define keylist
C KRSTJ KLIST
C KFLD WQTJ01 Company number
C KFLD WQTJ02 Internal header
C KFLD WQTJ03 Quote/order num
C KFLD WQTJ04 Line item seque
* Setup key
C Z-ADDZFAENB WQTJ01 Company number
C MOVELZFDCCD WQTJ02 Internal header
C MOVELZFCVNB WQTJ03 Quote/order num
C Z-ADDZFFCNB WQTJ04 Line item seque
* Establish starting position
C KRSTJ SETLLMBADRE1 *
C KRSTJ READEMBADRE1 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0316' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TJEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: NOT A KIT COMPONENT.
* - c1 OR c2
* |- c1 : DB1.Kit/component indicator is Not a kit
* |- c2 : DB1.Kit/component indicator is Kit Parent
* '-
C ADILST IFEQ '0' *IF
C ADILST OREQ '1' *OR
C ADD ADAQQT WUACS7 Open release qt
C END *FI
C Z-ADDADAAN6 WUDHVA Customer order
C KRSTJ READEMBADRE1 90*
C ENDDO
*================================================================
CSR TJEXIT ENDSR
/EJECT
CSR TKRVGN BEGSR
*================================================================
* RTV:Total Open Rlse Qty - Release *
*================================================================
C MOVEL*BLANK W0RTN 7
* Declare restrictor key work fields
C *LIKE DEFN ADAENB WQTK01 Company number
C *LIKE DEFN ADDCCD WQTK02 Internal header
C *LIKE DEFN ADCVNB WQTK03 Quote/order num
C *LIKE DEFN ADFCNB WQTK04 Line item seque
* Define keylist
C KRSTK KLIST
C KFLD WQTK01 Company number
C KFLD WQTK02 Internal header
C KFLD WQTK03 Quote/order num
C KFLD WQTK04 Line item seque
* Setup key
C Z-ADDZFAENB WQTK01 Company number
C MOVELZFDCCD WQTK02 Internal header
C MOVELZFCVNB WQTK03 Quote/order num
C Z-ADDZFFCNB WQTK04 Line item seque
* Establish starting position
C KRSTK SETLLMBADRE1 *
C KRSTK READEMBADRE1 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0316' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TKEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: NOT A KIT COMPONENT.
* - c1 OR c2
* |- c1 : DB1.Kit/component indicator is Not a kit
* |- c2 : DB1.Kit/component indicator is Kit Parent
* '-
C ADILST IFEQ '0' *IF
C ADILST OREQ '1' *OR
C ADD ADAQQT WN0031 Open release qt
C END *FI
C Z-ADDADAAN6 WUDHVA Customer order
C KRSTK READEMBADRE1 90*
C ENDDO
*================================================================
CSR TKEXIT ENDSR
/EJECT
CSR TLRVGN BEGSR
*================================================================
* RTV:Non-Invoiced Rlse Qty - Release *
*================================================================
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* ** Initialize accumulator fields.
C Z-ADD*ZERO WN0031 Open release qt
C Z-ADD*ZERO WUACS7 Open release qt
* Declare restrictor key work fields
C *LIKE DEFN ADAENB WQTL01 Company number
C *LIKE DEFN ADDCCD WQTL02 Internal header
C *LIKE DEFN ADCVNB WQTL03 Quote/order num
C *LIKE DEFN ADFCNB WQTL04 Line item seque
* Define keylist
C KRSTL KLIST
C KFLD WQTL01 Company number
C KFLD WQTL02 Internal header
C KFLD WQTL03 Quote/order num
C KFLD WQTL04 Line item seque
* Setup key
C Z-ADDZFAENB WQTL01 Company number
C MOVELZFDCCD WQTL02 Internal header
C MOVELZFCVNB WQTL03 Quote/order num
C Z-ADDZFFCNB WQTL04 Line item seque
* Establish starting position
C KRSTL SETLLMBADRE1 *
C KRSTL READEMBADRE1 90*
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0316' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TLEXIT
C ENDIF
C *IN90 DOWEQ'0'
* USER: Process Data record
* CASE: NOT A KIT COMPONENT.
* - c1 OR c2
* |- c1 : DB1.Kit/component indicator is Not a kit
* |- c2 : DB1.Kit/component indicator is Kit Parent
* '-
C ADILST IFEQ '0' *IF
C ADILST OREQ '1' *OR
* ** Accumulate totals.
C ADD ADAQQT WUACS7 Open release qt
C Z-ADDWUACS7 WN0031 Open release qt
C END *FI
C KRSTL READEMBADRE1 90*
C ENDDO
*================================================================
CSR TLEXIT ENDSR
/EJECT
CSR TMRVGN BEGSR
*================================================================
* RTV:Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL01 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK01,Y YD01
C YI01 OCUR YM01
* Initialize internal index
C MOVEL*LOVAL YD01
* Move key fields to Currency File Data
C MOVEL'1' YI0101 Loaded from fil
C Z-ADDWUAAQR YI0102 Company number
C MOVEL*BLANK YI0103 Currency ID
* Only search if key is not beyond range of current elements
C YK01,YL01 IFGT YD01
C YD01 LOKUPYK01,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK01,Y YD01
* Compare
C YI0101 IFNE '1'
C YI0102 ORNE WUAAQR
C YI0103 ORNE *BLANK
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TMEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI01 OCUR YM01
* USER: Process Data record
* PAR = DB1 By name
C MOVELWFA3TX WUA3TX Currency descri
C Z-ADDWFAJNB WUAJNB Exchange rate c
C Z-ADDWFAKNB WN0045 Decimal positio
C MOVELWFALNB WUALNB AP exchange gai
C MOVELWFAMNB WUAMNB AR exchange gai
C Z-ADDWFABVA WUABVA Price adjustmen
C MOVELWFAALP WUAALP Primary Currenc
C ENDIF
*================================================================
CSR TMEXIT ENDSR
/EJECT
CSR TNCRRC BEGSR
*================================================================
* Load Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL01 IFEQ 5
C MOVEL'Y2U0036' W0RTN 7
* USER: Processing if Data update error
* ** This error indicates the array is full.
* ** The calling function will handle the error.
* ** The array size of 5 was chosen to limit the program's size
* but still handle quite a few currencies before running
* this exception handling.
C MOVEL'Y2U0004' W0RTN *Return code
C GOTO TNEXIT
C ENDIF
C MOVEL*BLANK XAACVX Loaded from fil
C Z-ADD*ZERO XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* Move all fields to Currency File Data
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* USER: Processing before Data update
* RTV:All information - CURRENCY *
C EXSR TORVGN
* Set default data for record not found.
* CASE:
* - NOT c1
* |- c1 : PGM.*Return code is *Normal
* '-
C MOVEL'0' Y0CX01 1
C W0RTN IFEQ *BLANK *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL*BLANK W0RTN *Return code
* ** Keep the key data from PAR; blank the rest of the record.
* DB1 = PAR,CON By name
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* ** Default to 2 decimal positions.
C Z-ADD2 XAAKNB Decimal positio
C END *FI
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI01
* Only search if key is not beyond range of current elements
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Set search index to first element of array
C Z-ADD1 Y 50
C YD01 LOKUPYK01,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK01,Y YD01
* Compare
C YI0101 IFEQ XAACVX
C YI0102 ANDEQXAAENB
C YI0103 ANDEQXABRCD
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO TNEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL01 ADD 1 Y 50
* Check if element was a previously deleted element
C YK01,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK01,Y YD01
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI01
C ENDIF
* Create(insert) new element
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
C MOVELYD01 YK01,Y
C YI01 OCUR YM01
* Update MODS fields
C MOVELXAACVX WFACVX Loaded from fil
C Z-ADDXAAENB WFAENB Company number
C MOVELXABRCD WFBRCD Currency ID
C MOVELXAA3TX WFA3TX Currency descri
C Z-ADDXAAJNB WFAJNB Exchange rate c
C Z-ADDXAAKNB WFAKNB Decimal positio
C MOVELXAALNB WFALNB AP exchange gai
C MOVELXAAMNB WFAMNB AR exchange gai
C Z-ADDXAABVA WFABVA Price adjustmen
C MOVELXAAALP WFAALP Primary Currenc
* Only sort if element is out of position
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Adjust RTVOBJ index to reflect position of added/removed element
C YR01 IFGT 0
C YR01 ANDLE5
C YK01,YR01 ANDGTYD01
C ADD 1 YR01 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK01
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL01
* Move Currency F fields back
C MOVELWFA3TX WUA3TX Currency descri
C Z-ADDWFAJNB WUAJNB Exchange rate c
C Z-ADDWFAKNB WN0045 Decimal positio
C MOVELWFALNB WUALNB AP exchange gai
C MOVELWFAMNB WUAMNB AR exchange gai
C Z-ADDWFABVA WUABVA Price adjustmen
C MOVELWFAALP WUAALP Primary Currenc
* USER: Processing after Data update
* Load output?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* PAR = DB1 By name
C MOVELXAA3TX WUA3TX Currency descri
C Z-ADDXAAJNB WUAJNB Exchange rate c
C Z-ADDXAAKNB WN0045 Decimal positio
C MOVELXAALNB WUALNB AP exchange gai
C MOVELXAAMNB WUAMNB AR exchange gai
C Z-ADDXAABVA WUABVA Price adjustmen
C MOVELXAAALP WUAALP Primary Currenc
C END *FI
*================================================================
CSR TNEXIT ENDSR
/EJECT
CSR TORVGN BEGSR
*================================================================
* RTV:All information - CURRENCY *
*================================================================
C Z-ADD*ZERO WN0049 20 Company number
C MOVEL*BLANK WN0050 10 Admin division
C MOVEL*BLANK WN0051 3 Currency ID (us
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Check if IFM is installed.
* CASE: *OTHERWISE
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0225 4 Application ali
C WUADVB PARM *BLANK WQ0226 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Adjust company/currency if IFM is installed.
* CASE: WRK.Installed apps - IFM is Installed
C WUADVB IFEQ '1' *IF
* Looking for local currency?
* CASE:
* - c1 AND c2
* |- c1 : PAR.Company number is Zero
* |- c2 : PAR.Currency ID is Blank
* '-
C MOVEL'0' Y0CX01 1
C XAAENB IFEQ *ZERO *IF
C XABRCD IFEQ *BLANK *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* Get MAPICS dflt admin div - IFM Programs *
C CALL 'UAEMXFR' 90 Get MAPICS dflt
C PARM W0RTN WQ0227 7 *Return code
C PARM ZZUSR WQ0228 10 User id (usr)
C WN0050 PARM *BLANK WQ0229 10 Admin division
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UAEMXFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* EXT:COM Get Lcl Currency - IFM Programs *
C CALL 'UA39XFR' 90 EXT:COM Get Lcl
C PARM W0RTN WQ0230 7 *Return code
C PARM WN0050 WQ0231 10 Admin division
C WN0051 PARM *BLANK WQ0232 4 Currency id IFM
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UA39XFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C Z-ADD01 WN0049 Company number
* RTV:All information IFM - CURRENCY *
C EXSR TPRVGN
C GOTO TOEXIT *QUIT
C END *FI
* Adjust Company_number?
* CASE: PAR.Company number is Not equal 01
C XAAENB IFNE 01 *IF
C Z-ADD01 WN0049 Company number
* RTV:All information IFM - CURRENCY *
C EXSR TQRVGN
C GOTO TOEXIT *QUIT
C END *FI
C END *FI
* Define keylist
C KRSTO KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDXAAENB EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSTO CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C Z-ADD*ZERO WN0049 Company number
C MOVEL*BLANK WN0050 Admin division
C MOVEL*BLANK WN0051 Currency ID (us
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TOEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR TOEXIT ENDSR
/EJECT
CSR TPRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSTP KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0049 EPAENB Company number
C MOVELWN0051 EPBRCD Currency ID
* Establish starting position
C KRSTP CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TPEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR TPEXIT ENDSR
/EJECT
CSR TQRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSTQ KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0049 EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSTQ CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TQEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR TQEXIT ENDSR
/EJECT
CSR TRDLRC BEGSR
*================================================================
* Clear Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Initialize array variables
C MOVEA*HIVAL YK01
* Initialize last used element number
C Z-ADD0 YL01
*================================================================
CSR TREXIT ENDSR
/EJECT
CSR TSCRRC BEGSR
*================================================================
* Load Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL01 IFEQ 5
C MOVEL'Y2U0036' W0RTN 7
* USER: Processing if Data update error
* ** This error indicates the array is full.
* ** The calling function will handle the error.
* ** The array size of 5 was chosen to limit the program's size
* but still handle quite a few currencies before running
* this exception handling.
C MOVEL'Y2U0004' W0RTN *Return code
C GOTO TSEXIT
C ENDIF
C MOVEL*BLANK XAACVX Loaded from fil
C Z-ADD*ZERO XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* Move all fields to Currency File Data
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* USER: Processing before Data update
* RTV:All information - CURRENCY *
C EXSR TTRVGN
* Set default data for record not found.
* CASE:
* - NOT c1
* |- c1 : PGM.*Return code is *Normal
* '-
C MOVEL'0' Y0CX01 1
C W0RTN IFEQ *BLANK *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL*BLANK W0RTN *Return code
* ** Keep the key data from PAR; blank the rest of the record.
* DB1 = PAR,CON By name
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* ** Default to 2 decimal positions.
C Z-ADD2 XAAKNB Decimal positio
C END *FI
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI01
* Only search if key is not beyond range of current elements
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Set search index to first element of array
C Z-ADD1 Y 50
C YD01 LOKUPYK01,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK01,Y YD01
* Compare
C YI0101 IFEQ XAACVX
C YI0102 ANDEQXAAENB
C YI0103 ANDEQXABRCD
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO TSEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL01 ADD 1 Y 50
* Check if element was a previously deleted element
C YK01,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK01,Y YD01
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI01
C ENDIF
* Create(insert) new element
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
C MOVELYD01 YK01,Y
C YI01 OCUR YM01
* Update MODS fields
C MOVELXAACVX WFACVX Loaded from fil
C Z-ADDXAAENB WFAENB Company number
C MOVELXABRCD WFBRCD Currency ID
C MOVELXAA3TX WFA3TX Currency descri
C Z-ADDXAAJNB WFAJNB Exchange rate c
C Z-ADDXAAKNB WFAKNB Decimal positio
C MOVELXAALNB WFALNB AP exchange gai
C MOVELXAAMNB WFAMNB AR exchange gai
C Z-ADDXAABVA WFABVA Price adjustmen
C MOVELXAAALP WFAALP Primary Currenc
* Only sort if element is out of position
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Adjust RTVOBJ index to reflect position of added/removed element
C YR01 IFGT 0
C YR01 ANDLE5
C YK01,YR01 ANDGTYD01
C ADD 1 YR01 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK01
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL01
* Move Currency F fields back
C MOVELWFA3TX WUA3TX Currency descri
C Z-ADDWFAJNB WUAJNB Exchange rate c
C Z-ADDWFAKNB WN0045 Decimal positio
C MOVELWFALNB WUALNB AP exchange gai
C MOVELWFAMNB WUAMNB AR exchange gai
C Z-ADDWFABVA WUABVA Price adjustmen
C MOVELWFAALP WUAALP Primary Currenc
* USER: Processing after Data update
* Load output?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* PAR = DB1 By name
C MOVELXAA3TX WUA3TX Currency descri
C Z-ADDXAAJNB WUAJNB Exchange rate c
C Z-ADDXAAKNB WN0045 Decimal positio
C MOVELXAALNB WUALNB AP exchange gai
C MOVELXAAMNB WUAMNB AR exchange gai
C Z-ADDXAABVA WUABVA Price adjustmen
C MOVELXAAALP WUAALP Primary Currenc
C END *FI
*================================================================
CSR TSEXIT ENDSR
/EJECT
CSR TTRVGN BEGSR
*================================================================
* RTV:All information - CURRENCY *
*================================================================
C Z-ADD*ZERO WN0052 20 Company number
C MOVEL*BLANK WN0053 10 Admin division
C MOVEL*BLANK WN0054 3 Currency ID (us
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Check if IFM is installed.
* CASE: *OTHERWISE
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0233 4 Application ali
C WUADVB PARM *BLANK WQ0234 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Adjust company/currency if IFM is installed.
* CASE: WRK.Installed apps - IFM is Installed
C WUADVB IFEQ '1' *IF
* Looking for local currency?
* CASE:
* - c1 AND c2
* |- c1 : PAR.Company number is Zero
* |- c2 : PAR.Currency ID is Blank
* '-
C MOVEL'0' Y0CX01 1
C XAAENB IFEQ *ZERO *IF
C XABRCD IFEQ *BLANK *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* Get MAPICS dflt admin div - IFM Programs *
C CALL 'UAEMXFR' 90 Get MAPICS dflt
C PARM W0RTN WQ0235 7 *Return code
C PARM ZZUSR WQ0236 10 User id (usr)
C WN0053 PARM *BLANK WQ0237 10 Admin division
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UAEMXFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* EXT:COM Get Lcl Currency - IFM Programs *
C CALL 'UA39XFR' 90 EXT:COM Get Lcl
C PARM W0RTN WQ0238 7 *Return code
C PARM WN0053 WQ0239 10 Admin division
C WN0054 PARM *BLANK WQ0240 4 Currency id IFM
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UA39XFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C Z-ADD01 WN0052 Company number
* RTV:All information IFM - CURRENCY *
C EXSR TURVGN
C GOTO TTEXIT *QUIT
C END *FI
* Adjust Company_number?
* CASE: PAR.Company number is Not equal 01
C XAAENB IFNE 01 *IF
C Z-ADD01 WN0052 Company number
* RTV:All information IFM - CURRENCY *
C EXSR TVRVGN
C GOTO TTEXIT *QUIT
C END *FI
C END *FI
* Define keylist
C KRSTT KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDXAAENB EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSTT CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C Z-ADD*ZERO WN0052 Company number
C MOVEL*BLANK WN0053 Admin division
C MOVEL*BLANK WN0054 Currency ID (us
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TTEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR TTEXIT ENDSR
/EJECT
CSR TURVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSTU KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0052 EPAENB Company number
C MOVELWN0054 EPBRCD Currency ID
* Establish starting position
C KRSTU CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TUEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR TUEXIT ENDSR
/EJECT
CSR TVRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSTV KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0052 EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSTV CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TVEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR TVEXIT ENDSR
/EJECT
CSR TWRVGN BEGSR
*================================================================
* RTV:Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
C YL01 IFGT 0
* Set search index to first element of array
C Z-ADD1 Y 50
C MOVELYK01,Y YD01
C YI01 OCUR YM01
* Initialize internal index
C MOVEL*LOVAL YD01
* Move key fields to Currency File Data
C MOVEL'1' YI0101 Loaded from fil
C Z-ADDWUAAQR YI0102 Company number
C MOVEL*BLANK YI0103 Currency ID
* Only search if key is not beyond range of current elements
C YK01,YL01 IFGT YD01
C YD01 LOKUPYK01,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK01,Y YD01
* Compare
C YI0101 IFNE '1'
C YI0102 ORNE WUAAQR
C YI0103 ORNE *BLANK
C SETOF 90 *
C ENDIF
C ENDIF
C *IN90 IFEQ '0'
* Array element not found
C MOVEL'Y2U0005' W0RTN 7
* USER: Processing if Data record not found
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TWEXIT
C ENDIF
C *IN90 IFEQ '1'
C YI01 OCUR YM01
* USER: Process Data record
* PAR = DB1 By name
C MOVELWFA3TX WUA3TX Currency descri
C Z-ADDWFAJNB WUAJNB Exchange rate c
C Z-ADDWFAKNB WN0055 Decimal positio
C MOVELWFALNB WUALNB AP exchange gai
C MOVELWFAMNB WUAMNB AR exchange gai
C Z-ADDWFABVA WUABVA Price adjustmen
C MOVELWFAALP WUAALP Primary Currenc
C ENDIF
*================================================================
CSR TWEXIT ENDSR
/EJECT
CSR TXCRRC BEGSR
*================================================================
* Load Currency File Array - *Arrays *
*================================================================
C MOVEL*BLANK W0RTN 7
* Array full, cannot add any more elements
C YL01 IFEQ 5
C MOVEL'Y2U0036' W0RTN 7
* USER: Processing if Data update error
* ** This error indicates the array is full.
* ** The calling function will handle the error.
* ** The array size of 5 was chosen to limit the program's size
* but still handle quite a few currencies before running
* this exception handling.
C MOVEL'Y2U0004' W0RTN *Return code
C GOTO TXEXIT
C ENDIF
C MOVEL*BLANK XAACVX Loaded from fil
C Z-ADD*ZERO XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* Move all fields to Currency File Data
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* USER: Processing before Data update
* RTV:All information - CURRENCY *
C EXSR TYRVGN
* Set default data for record not found.
* CASE:
* - NOT c1
* |- c1 : PGM.*Return code is *Normal
* '-
C MOVEL'0' Y0CX01 1
C W0RTN IFEQ *BLANK *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVEL*BLANK W0RTN *Return code
* ** Keep the key data from PAR; blank the rest of the record.
* DB1 = PAR,CON By name
C MOVEL'1' XAACVX Loaded from fil
C Z-ADDWUAAQR XAAENB Company number
C MOVEL*BLANK XABRCD Currency ID
C MOVEL*BLANK XAA3TX Currency descri
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL*BLANK XAAALP Primary Currenc
* ** Default to 2 decimal positions.
C Z-ADD2 XAAKNB Decimal positio
C END *FI
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
* Check for duplicate primary key
* Initialize internal index
C Z-ADD*ZERO YI01
* Only search if key is not beyond range of current elements
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Set search index to first element of array
C Z-ADD1 Y 50
C YD01 LOKUPYK01,Y 90 Look for >
C ELSE
C SETOF 90 *
C ENDIF
C *IN90 IFEQ '1'
* Move to data structure for comparison
C MOVELYK01,Y YD01
* Compare
C YI0101 IFEQ XAACVX
C YI0102 ANDEQXAAENB
C YI0103 ANDEQXABRCD
* Array element already exists
C MOVEL'Y2U0003' W0RTN 7
C GOTO TXEXIT
C ENDIF
C ENDIF
* Insert after last used element
C YL01 ADD 1 Y 50
* Check if element was a previously deleted element
C YK01,Y IFNE *HIVAL
* If so, reuse MODS index
C MOVELYK01,Y YD01
C ELSE
* If not, use element number as MODS index
C Z-ADDY YI01
C ENDIF
* Create(insert) new element
* Move key fields to Currency File Data
C MOVELXAACVX YI0101 Loaded from fil
C Z-ADDXAAENB YI0102 Company number
C MOVELXABRCD YI0103 Currency ID
C MOVELYD01 YK01,Y
C YI01 OCUR YM01
* Update MODS fields
C MOVELXAACVX WFACVX Loaded from fil
C Z-ADDXAAENB WFAENB Company number
C MOVELXABRCD WFBRCD Currency ID
C MOVELXAA3TX WFA3TX Currency descri
C Z-ADDXAAJNB WFAJNB Exchange rate c
C Z-ADDXAAKNB WFAKNB Decimal positio
C MOVELXAALNB WFALNB AP exchange gai
C MOVELXAAMNB WFAMNB AR exchange gai
C Z-ADDXAABVA WFABVA Price adjustmen
C MOVELXAAALP WFAALP Primary Currenc
* Only sort if element is out of position
C YL01 IFGT 0
C YK01,YL01 ANDGTYD01
* Adjust RTVOBJ index to reflect position of added/removed element
C YR01 IFGT 0
C YR01 ANDLE5
C YK01,YR01 ANDGTYD01
C ADD 1 YR01 50
C ENDIF
* Sort array to place element in correct position
C SORTAYK01
C ENDIF
* Adjust number of elements currently in array
C ADD 1 YL01
* Move Currency F fields back
C MOVELWFA3TX WUA3TX Currency descri
C Z-ADDWFAJNB WUAJNB Exchange rate c
C Z-ADDWFAKNB WN0055 Decimal positio
C MOVELWFALNB WUALNB AP exchange gai
C MOVELWFAMNB WUAMNB AR exchange gai
C Z-ADDWFABVA WUABVA Price adjustmen
C MOVELWFAALP WUAALP Primary Currenc
* USER: Processing after Data update
* Load output?
* CASE: PGM.*Return code is *Normal
C W0RTN IFEQ *BLANK *IF
* PAR = DB1 By name
C MOVELXAA3TX WUA3TX Currency descri
C Z-ADDXAAJNB WUAJNB Exchange rate c
C Z-ADDXAAKNB WN0055 Decimal positio
C MOVELXAALNB WUALNB AP exchange gai
C MOVELXAAMNB WUAMNB AR exchange gai
C Z-ADDXAABVA WUABVA Price adjustmen
C MOVELXAAALP WUAALP Primary Currenc
C END *FI
*================================================================
CSR TXEXIT ENDSR
/EJECT
CSR TYRVGN BEGSR
*================================================================
* RTV:All information - CURRENCY *
*================================================================
C Z-ADD*ZERO WN0059 20 Company number
C MOVEL*BLANK WN0060 10 Admin division
C MOVEL*BLANK WN0061 3 Currency ID (us
C MOVEL*BLANK W0RTN 7
* USER: Initialize routine
* Check if IFM is installed.
* CASE: *OTHERWISE
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0261 4 Application ali
C WUADVB PARM *BLANK WQ0262 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Adjust company/currency if IFM is installed.
* CASE: WRK.Installed apps - IFM is Installed
C WUADVB IFEQ '1' *IF
* Looking for local currency?
* CASE:
* - c1 AND c2
* |- c1 : PAR.Company number is Zero
* |- c2 : PAR.Currency ID is Blank
* '-
C MOVEL'0' Y0CX01 1
C XAAENB IFEQ *ZERO *IF
C XABRCD IFEQ *BLANK *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
* Get MAPICS dflt admin div - IFM Programs *
C CALL 'UAEMXFR' 90 Get MAPICS dflt
C PARM W0RTN WQ0263 7 *Return code
C PARM ZZUSR WQ0264 10 User id (usr)
C WN0060 PARM *BLANK WQ0265 10 Admin division
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UAEMXFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* EXT:COM Get Lcl Currency - IFM Programs *
C CALL 'UA39XFR' 90 EXT:COM Get Lcl
C PARM W0RTN WQ0266 7 *Return code
C PARM WN0060 WQ0267 10 Admin division
C WN0061 PARM *BLANK WQ0268 4 Currency id IFM
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'UA39XFR' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C Z-ADD01 WN0059 Company number
* RTV:All information IFM - CURRENCY *
C EXSR TZRVGN
C GOTO TYEXIT *QUIT
C END *FI
* Adjust Company_number?
* CASE: PAR.Company number is Not equal 01
C XAAENB IFNE 01 *IF
C Z-ADD01 WN0059 Company number
* RTV:All information IFM - CURRENCY *
C EXSR NARVGN
C GOTO TYEXIT *QUIT
C END *FI
C END *FI
* Define keylist
C KRSTY KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDXAAENB EPAENB Company number
C MOVELXABRCD EPBRCD Currency ID
* Establish starting position
C KRSTY CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C Z-ADD*ZERO WN0059 Company number
C MOVEL*BLANK WN0060 Admin division
C MOVEL*BLANK WN0061 Currency ID (us
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TYEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR TYEXIT ENDSR
/EJECT
CSR TZRVGN BEGSR
*================================================================
* RTV:All information IFM - CURRENCY *
*================================================================
C MOVEL*BLANK W0RTN 7
* Define keylist
C KRSTZ KLIST
C KFLD EPAENB Company number
C KFLD EPBRCD Currency ID
* Setup key
C Z-ADDWN0059 EPAENB Company number
C MOVELWN0061 EPBRCD Currency ID
* Establish starting position
C KRSTZ CHAINFRRIDAC 90 *
C *IN90 IFEQ '1'
* Data record not found
C MOVEL'AMB0236' W0RTN 7
* USER: Processing if Data record not found
* PAR = CON By name
C MOVEL*BLANK XAA3TX Currency descri
C MOVEL*BLANK XAAALP Primary Currenc
C Z-ADD*ZERO XAAJNB Exchange rate c
C Z-ADD*ZERO XAAKNB Decimal positio
C MOVEL*BLANK XAALNB AP exchange gai
C MOVEL*BLANK XAAMNB AR exchange gai
C Z-ADD*ZERO XAABVA Price adjustmen
C MOVEL'Y2U0005' W0RTN *Return code
C GOTO TZEXIT
C ENDIF
C *IN90 IFEQ '0'
* USER: Process Data record
* PAR = DB1 By name
C MOVELEPA3TX XAA3TX Currency descri
C MOVELEPAALP XAAALP Primary Currenc
C Z-ADDEPAJNB XAAJNB Exchange rate c
C Z-ADDEPAKNB XAAKNB Decimal positio
C MOVELEPALNB XAALNB AP exchange gai
C MOVELEPAMNB XAAMNB AR exchange gai
C Z-ADDEPABVA XAABVA Price adjustmen
C ENDIF
*================================================================
CSR TZEXIT ENDSR
/EJECT
CSR UASUBR BEGSR
*================================================================
* Format ship to address
*================================================================
C Z-ADD*ZERO WN0013 10 AMV65 Address f
* INT:Format address
* Clear work output parms
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C MOVEL*BLANK WUX9HA Address line 1
C MOVEL*BLANK WUZ9HB Address line 2
C MOVEL*BLANK WUZ9HC Address line 3
C MOVEL*BLANK WUZ9HD Address line 4
C MOVEL*BLANK WUZ9HF Address line 5
C END *FI
* AMV65 using Purchasing Address formats 0,1 & 2
* COM uses address types 1,2, & 3 (0=1, 1=2, 2=3)
C MOVE WUHYST WUAAKL &Conversion typ
C WUAAKL SUB 1 WN0013 AMV65 Address f
* Use address line 4 for city with address formats 1 & 2
* CASE:
* - NOTc1
* |- c1 : PAR.Address format is 35 by 6
* '-
C MOVEL'0' Y0CX01 1
C WUHYST IFEQ '3' *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVELP2CPTX WUZ9HH Address line 4
C ELSE
* CASE: *OTHERWISE
C MOVELWUZ9HH WUZ9HH Address line 4
C END *FI
* AMV65 - Address format - Z-Generic Programs *
C CALL 'AMV65' 90 AMV65 - Address
C PARM WUCMTX WQ0098 35 Address line 1
C PARM WUCNTX WQ0099 35 Address line 2
C PARM WUCOTX WQ0100 35 Address line 3
C PARM WUZ9HH WQ0101 35 Address line 4
C PARM WUZ9HG WQ0102 35 Address line 5
C PARM P2BYCD WQ0103 2 State code (key
C PARM P2CVCD WQ0104 10 Zip code
C PARM P2COCD WQ0105 3 Country code
C PARM WN0013 WQ0106 10 AMV65 Address f
C WUX9HA PARM *BLANK WQ0107 40 Address line 1
C WUZ9HB PARM *BLANK WQ0108 40 Address line 2
C WUZ9HC PARM *BLANK WQ0109 40 Address line 3
C WUZ9HD PARM *BLANK WQ0110 40 Address line 4
C WUZ9HF PARM *BLANK WQ0111 40 Address line 5
C PARM 40 WQ0112 30 AMV65 output le
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMV65' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* AMV65 compresses blank lines
* Calculate the number of address line to print
* CASE: WRK.Address line 5 - out 40 is Not blank
C WUZ9HF IFNE *BLANK *IF
C Z-ADD5 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
* CASE: WRK.Address line 4 - out 40 is Not blank
C WUZ9HD IFNE *BLANK *IF
C Z-ADD4 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
* CASE: WRK.Address line 3 - out 40 is Not blank
C WUZ9HC IFNE *BLANK *IF
C Z-ADD3 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
* CASE: WRK.Address line 2 - out 40 is Not blank
C WUZ9HB IFNE *BLANK *IF
C Z-ADD2 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
* CASE: WRK.Address line 1 - out 40 is Not blank
C WUX9HA IFNE *BLANK *IF
C Z-ADD1 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
C Z-ADD*ZERO WUZ9HK Address lines t
C END *FI
C END *FI
C END *FI
C END *FI
C END *FI
* Return address parms
* Clear work output parms
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C MOVELWUX9HA ZBZ9KR Address line 1
C MOVELWUZ9HB ZBACFD Address line 2
C MOVELWUZ9HC ZBACKD Address line 3
C MOVELWUZ9HD ZBACKF Address line 4
C MOVELWUZ9HF ZBZ9KS Address line 5
C END *FI
*================================================================
CSR UAEXIT ENDSR
/EJECT
CSR UBSUBR BEGSR
*================================================================
* Format sold to address
*================================================================
C Z-ADD*ZERO WN0014 10 AMV65 Address f
* INT:Format address
* Clear work output parms
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C MOVEL*BLANK WUX9HA Address line 1
C MOVEL*BLANK WUZ9HB Address line 2
C MOVEL*BLANK WUZ9HC Address line 3
C MOVEL*BLANK WUZ9HD Address line 4
C MOVEL*BLANK WUZ9HF Address line 5
C END *FI
* AMV65 using Purchasing Address formats 0,1 & 2
* COM uses address types 1,2, & 3 (0=1, 1=2, 2=3)
C MOVE WUHYST WUAAKL &Conversion typ
C WUAAKL SUB 1 WN0014 AMV65 Address f
* Use address line 4 for city with address formats 1 & 2
* CASE:
* - NOTc1
* |- c1 : PAR.Address format is 35 by 6
* '-
C MOVEL'0' Y0CX01 1
C WUHYST IFEQ '3' *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
C MOVELWUCPTX WUZ9HH Address line 4
C ELSE
* CASE: *OTHERWISE
C MOVELWUZ9HH WUZ9HH Address line 4
C END *FI
* AMV65 - Address format - Z-Generic Programs *
C CALL 'AMV65' 90 AMV65 - Address
C PARM WUCMTX WQ0113 35 Address line 1
C PARM WUCNTX WQ0114 35 Address line 2
C PARM WUCOTX WQ0115 35 Address line 3
C PARM WUZ9HH WQ0116 35 Address line 4
C PARM WUZ9HG WQ0117 35 Address line 5
C PARM WUBYCD WQ0118 2 State code (key
C PARM WUCVCD WQ0119 10 Zip code
C PARM WUCOCD WQ0120 3 Country code
C PARM WN0014 WQ0121 10 AMV65 Address f
C WUX9HA PARM *BLANK WQ0122 40 Address line 1
C WUZ9HB PARM *BLANK WQ0123 40 Address line 2
C WUZ9HC PARM *BLANK WQ0124 40 Address line 3
C WUZ9HD PARM *BLANK WQ0125 40 Address line 4
C WUZ9HF PARM *BLANK WQ0126 40 Address line 5
C PARM 40 WQ0127 30 AMV65 output le
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMV65' W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* AMV65 compresses blank lines
* Calculate the number of address line to print
* CASE: WRK.Address line 5 - out 40 is Not blank
C WUZ9HF IFNE *BLANK *IF
C Z-ADD5 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
* CASE: WRK.Address line 4 - out 40 is Not blank
C WUZ9HD IFNE *BLANK *IF
C Z-ADD4 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
* CASE: WRK.Address line 3 - out 40 is Not blank
C WUZ9HC IFNE *BLANK *IF
C Z-ADD3 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
* CASE: WRK.Address line 2 - out 40 is Not blank
C WUZ9HB IFNE *BLANK *IF
C Z-ADD2 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
* CASE: WRK.Address line 1 - out 40 is Not blank
C WUX9HA IFNE *BLANK *IF
C Z-ADD1 WUZ9HK Address lines t
C ELSE
* CASE: *OTHERWISE
C Z-ADD*ZERO WUZ9HK Address lines t
C END *FI
C END *FI
C END *FI
C END *FI
C END *FI
* Return address parms
* Clear work output parms
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
C MOVELWUX9HA ZBZ9KT Address line 1
C MOVELWUZ9HB ZBACFG Address line 2
C MOVELWUZ9HC ZBACKH Address line 3
C MOVELWUZ9HD ZBACKJ Address line 4
C MOVELWUZ9HF ZBZ9KV Address line 5
C END *FI
*================================================================
CSR UBEXIT ENDSR
/EJECT
CSR UCSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Invoice Hdr comments
*================================================================
* RTV:Order Comments Exist - History Comment *
C EXSR SORVGN
* Quit if no order comments
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
C GOTO UCEXIT *QUIT
C END *FI
* PRO:Invoice Hdr comments: Mainline
C EXSR B0MAIN
*================================================================
CSR UCEXIT ENDSR
/EJECT
CSR UDSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Acknowledgement Lines
*================================================================
* Check if order is 'in shipping'.
* CASE: PGM.*Return code EQ PGM.*Return code
C W0RTN IFEQ W0RTN *IF
* RTV:Chk Ord Ship not Inv - Shipment Header *
C EXSR SSRVGN
C END *FI
* If Quote/Order ship lead time exists, use it, otherwise use the s
* CASE: DB1.Ship lead time is Not zero
C C6EENB IFNE *ZERO *IF
C Z-ADDC6EENB WUEENB Ship lead time
C END *FI
C Z-ADD*ZERO WN0015 20 Shipment lead t
* PRO:Acknowledgement Lines: Mainline
C EXSR C0MAIN
*================================================================
CSR UDEXIT ENDSR
/EJECT
CSR UESUBR BEGSR
*================================================================
* Processing
*================================================================
* RTV:Get Calendar ID - WAREHOUSE MASTER *
C EXSR TERVGN
* ** Subtract shipment lead time from request date.
* RTV: Sub Calendar Days - Calendar Day *
C EXSR TFRVGN
* Error? (and *QUIT)
* CASE: PAR.Add days return code is Everything's OK
C WN0022 IFEQ '0' *IF
C ELSE
* CASE: *OTHERWISE
C Z-ADDWUBIDT ZFAAT0 Manufacturing d
C GOTO UEEXIT *QUIT
C END *FI
* ** Adjust date to a shipping date.
* RTV: Sub Work Days - Calendar Day *
C EXSR TGRVGN
* Error? (and *QUIT)
* CASE: PAR.Add days return code is Everything's OK
C WN0022 IFEQ '0' *IF
C ELSE
* CASE: *OTHERWISE
C Z-ADDWUBIDT ZFAAT0 Manufacturing d
C GOTO UEEXIT *QUIT
C END *FI
* Load output PAR.Manufacturing due date.
* CASE: PAR.Billing & inventory inter is Interfacing
C P4Z9AN IFEQ '2' *IF
* ** Adjust date to mfg date if interfacing to inventory.
* RTV: Sub Work Days - CALENDARX (old assim) *
C EXSR THRVGN
* Error? (and *QUIT)
* CASE: PAR.Add days return code is Everything's OK
C WN0022 IFEQ '0' *IF
C ELSE
* CASE: *OTHERWISE
C Z-ADDWUBIDT ZFAAT0 Manufacturing d
C GOTO UEEXIT *QUIT
C END *FI
C ELSE
* CASE: *OTHERWISE
C Z-ADDWN0018 ZFAAT0 Manufacturing d
C END *FI
*================================================================
CSR UEEXIT ENDSR
/EJECT
CSR UFSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:ACK/QTE item F/O
*================================================================
* Do not print Feature/Options if no S-number.
* CASE: If no S-number, do not print F/O's.
* - c1 OR c2 OR c3
* |- c1 : DB1.S-number is Blank
* |- c2 : DB1.S-number is Zero
* |- c3 : CUR.Order qty in order u/m is Zero
* '-
C CDB6TX IFEQ *BLANK *IF
C CDB6TX OREQ '0' *OR
C ZFACQT OREQ *ZERO *OR
C GOTO UFEXIT *QUIT
C END *FI
* PRO:ACK/QTE item F/O: Mainline
C EXSR D0MAIN
*================================================================
CSR UFEXIT ENDSR
/EJECT
CSR UGSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Kit Components
*================================================================
* See if we need to print kits, Quit if not.
* CASE: Do not print kit items if no kits or flag is no.
* - c1 OR c2
* |- c1 : WRK.Kit ext doc print option is No
* |- c2 : CUR.Kit item is No
* '-
C WUIQST IFEQ '0' *IF
C ZFH2ST OREQ '0' *OR
C GOTO UGEXIT *QUIT
C END *FI
* PRO:Kit Components: Mainline
C EXSR E0MAIN
*================================================================
CSR UGEXIT ENDSR
/EJECT
CSR UHSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Quote/Order Releases
*================================================================
* ** Print if the item has blanket releases
* RTV:No. of Releases - Release *
C EXSR NKRVGN
* Blanket releases?
* CASE: WRK.Release number is Greater than 1
C WUDRNB IFGT 00001 *IF
C ELSE
* CASE: *OTHERWISE
C GOTO UHEXIT *QUIT
C END *FI
* PRO:Quote/Order Releases: Mainline
C EXSR F0MAIN
*================================================================
CSR UHEXIT ENDSR
/EJECT
CSR UISUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Invoice Item comments
*================================================================
* RTV:line itm cmnt ex inv. - History Comment *
C EXSR NLRVGN
* Print comments only if they exist.
* CASE:
* - c1 OR c2
* |- c1 : PGM.*Return code is *Record does not exist
* |- c2 : CUR.Order qty in order u/m is Zero
* '-
C W0RTN IFEQ 'Y2U0005' *IF
C ZFACQT OREQ *ZERO *OR
C GOTO UIEXIT *QUIT
C END *FI
* PRO:Invoice Item comments: Mainline
C EXSR G0MAIN
*================================================================
CSR UIEXIT ENDSR
/EJECT
CSR UJSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Invoice item tax
*================================================================
* Do not print line item tax if not set up to do so.
* CASE: PAR.Print item tax amount is Do not print
C C6BFST IFEQ '0' *IF
C GOTO UJEXIT *QUIT
C END *FI
* PRO:Invoice item tax: Mainline
C EXSR H0MAIN
*================================================================
CSR UJEXIT ENDSR
/EJECT
CSR UKSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Invoice special charg
*================================================================
* PRO:Invoice special charg: Mainline
C EXSR I0MAIN
*================================================================
CSR UKEXIT ENDSR
/EJECT
CSR ULSUBR BEGSR
*================================================================
* Comments on this function
*================================================================
* This function is coded very strange due to SYNON allowing
* only 13 PRTOBJ's in a PRTFIL
* The history special charge file is read as part of the SYNON
* print file cycle only to access the SYNON WRITE format statement.
* There are 2 stages in the process
* 1. Print special charges
* 2. Print bucketed surcharges
*================================================================
CSR ULEXIT ENDSR
/EJECT
CSR UMSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Invoice Hdr comments
*================================================================
* RTV:Spec Chg Commnt Exist - History Comment *
C EXSR NTRVGN
* Do not print if no comments exist.
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
C GOTO UMEXIT *QUIT
C END *FI
* PRO:Invoice Hdr comments: Mainline
C EXSR J0MAIN
*================================================================
CSR UMEXIT ENDSR
/EJECT
CSR UNSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Invoice spc chg tax
*================================================================
* Quit if do not print item tax amount.
* CASE: PAR.Print item tax amount is Do not print
C C6BFST IFEQ '0' *IF
C GOTO UNEXIT *QUIT
C END *FI
* If special charge code is blank, set the seq # to blank for surch
* CASE: CUR.Special charge code is Blank
C ZRBLST IFEQ *BLANK *IF
C Z-ADD*ZERO ZRAAD2 Special charge
C END *FI
* PRO:Invoice spc chg tax: Mainline
C EXSR K0MAIN
*================================================================
CSR UNEXIT ENDSR
/EJECT
CSR UOSUBR BEGSR
*================================================================
* Embedded PRTOBJ : PRO:Invoice spc chg tax
*================================================================
* PRO:Invoice Tax Summary: Mainline
C EXSR L0MAIN
*================================================================
CSR UOEXIT ENDSR
/EJECT
CSR UPSUBR BEGSR
*================================================================
* Calculate totals
*================================================================
* Accumulate the total order value.
C MOVEL'0' WUACWW Place order hol
C MOVEL'0' WUACV9 Overflow? USR
C Z-ADDWUAB1X YAAB1X Net sales amoun
* RTV:Invoice ttl discount? - Customer *
C EXSR OXRVGN
* Include special charges and their surcharges?
* CASE: WRK.Ord ship not inv flg USR is Yes
C WUZ9DA IFEQ '1' *IF
* ** If the order is between shipping and invoicing do not
* include special charges and their surcharges.
C ELSE
* CASE: *OTHERWISE
* RTV:Freight/Misc - Quote/Order Spec Charge *
C EXSR OYRVGN
C END *FI
C YAAB12 ADD YAAB11 WUABXA Total for charg
* Compute taxes, surcharges and trade discount.
* CASE: *OTHERWISE
C Z-ADD*ZERO YAAB1Y Trade discount
* EXT:Calc Tax and Trade R3 - Quote/Order Header *
C CALL 'AMBDPXFR' 90 EXT:Calc Tax an
C PARM *BLANK W0RTN 7
C PARM P1AENB WQ0543 20 Company number
C PARM P1DCCD WQ0544 1 Internal header
C PARM P1CVNB WQ0545 7 Quote/order num
C PARM *ZERO WQ0546 60 Invoice number
C PARM *ZERO WQ0547 70 Invoice sequenc
C PARM YAAB1X WQ0548 172 Cumulative net
C PARM 'E' WQ0549 1 Processing mode
C PARM WUZ9DA WQ0550 1 Ord ship not in
C PARM *BLANK WQ0551 1 Tax inquiry cal
C P6Z9Z0 PARM P6Z9Z0 WQ0552 132 Total tax amt f
C WUAACB PARM WUAACB WQ0553 132 Total surcharge
C WUAACC PARM WUAACC WQ0554 132 Total item tax
C WUAACF PARM WUAACF WQ0555 132 Total spc charg
C WUAACG PARM WUAACG WQ0556 132 Total surcharge
C WUAACH PARM WUAACH WQ0557 132 Total special c
C YAAB1Y PARM YAAB1Y WQ0558 132 Total trade dis
C WUAACP PARM WUAACP WQ0559 132 Total terms dis
C WUAHPC PARM WUAHPC WQ0560 53 Trade discount
C WUAMPC PARM WUAMPC WQ0561 73 Variable trade
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMBDPXFR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C END
* Error detected?
C W0RTN IFNE *BLANK
C SETON 99 *
C END
* If IFM interfacing, total Historical tax records.
* CASE: WRK.IFM AR interface is Activated
C WUADKP IFEQ '2' *IF
* RTV:Get taxes for invoice - Historical Tax *
C EXSR OZRVGN
C END *FI
* Sum taxes
* CUR.Total taxes 15.2 USR =
* *COMPUTE (x1 + x2 + x3)
* x1 : WRK.Total item tax amount
* + : PGM.*Synon (17,7) work field
* x2 : WRK.Total surcharge tax amt
* + : PGM.*Synon (17,7) work field
* x3 : WRK.Total spc charge tax amt
C WUAACC ADD WUAACG W0WD01 *Synon (17,7) w
C W0WD01 ADD WUAACF W0WD00 *Synon (17,7) w
C Z-ADDW0WD00 YAAB1Z Total taxes 15.
* Comp Overflow condition
* WRK.Accumulator - net sales =
* *COMPUTE (x1 + x4 + x2 - x3 + x5)
* x1 : CUR.Net sales amount 15.2 USR
* + : PGM.*Synon (17,7) work field
* x4 : WRK.Total for charges
* + : PGM.*Synon (17,7) work field
* x2 : CUR.Total taxes 15.2 USR
* - : PGM.*Synon (17,7) work field
* x3 : CUR.Trade discount 15.2 USR
* + : PGM.*Synon (17,7) work field
* x5 : WRK.Total surcharge amount
C YAAB1X ADD WUABXA W0WD03 *Synon (17,7) w
C W0WD03 ADD YAAB1Z W0WD02 *Synon (17,7) w
C W0WD02 SUB YAAB1Y W0WD01 *Synon (17,7) w
C W0WD01 ADD WUAACB W0WD00 *Synon (17,7) w
C Z-ADDW0WD00 WUACGS Accumulator - n
* Send message to orginating station if overflow has occurred.
* CASE: WRK.Accumulator - net sales is within 15.2 range
C WUACGS IFGE @C04,01 *IF
C WUACGS ANDLE@C04,02
C ELSE
* CASE: *OTHERWISE
* Send message 'Overflow - Total Order'
C MOVEL'AMB2139' ZAMSID
C MOVEL'*EXT ' ZAPGRL Rel queue
C MOVEL'*STATUS' ZAMSTP Message type
C EXSR ZASNMS
C END *FI
* Compute Invoice Amount
* CUR.Pay this amount 15.2 USR =
* *COMPUTE (x1 + x4 + x2 - x3 + x5)
* x1 : CUR.Net sales amount 15.2 USR
* + : WRK.&Number 16.2
* x4 : WRK.Total for charges
* + : WRK.&Number 16.2
* x2 : CUR.Total taxes 15.2 USR
* - : WRK.&Number 16.2
* x3 : CUR.Trade discount 15.2 USR
* + : WRK.&Number 16.2
* x5 : WRK.Total surcharge amount
C YAAB1X ADD WUABXA WUSANB &Number 16.2
C ADD YAAB1Z WUSANB &Number 16.2
C SUB YAAB1Y WUSANB &Number 16.2
C ADD WUAACB WUSANB &Number 16.2
C Z-ADDWUSANB YAAB14 Pay this amount
* Terms (cash) discount?
* CASE: *OTHERWISE
* Compute order value terms
* WRK.Order value with cash dct =
* *COMPUTE (x1 + x2 - x3 + x4)
* x1 : CUR.Net sales amount 15.2 USR
* + : PGM.*Synon (17,7) work field
* x2 : WRK.Total for charges
* - : PGM.*Synon (17,7) work field
* x3 : CUR.Trade discount 15.2 USR
* + : PGM.*Synon (17,7) work field
* x4 : PAR.Total tax amt for trm dsc
C YAAB1X ADD WUABXA W0WD02 *Synon (17,7) w
C W0WD02 SUB YAAB1Y W0WD01 *Synon (17,7) w
C W0WD01 ADD P6Z9Z0 W0WD00 *Synon (17,7) w
C Z-ADDW0WD00 WUAB05 Order value wit
* CASE: WRK.Installment method id is Present
C WUZ9H4 IFNE *BLANK *IF
C Z-ADD*ZERO YAAB13 Discount allowe
C ELSE
* CASE: *OTHERWISE
* ** Get best IFM data or just COM data.
* RTV:Get All Terms Info. - Terms *
C EXSR PBRVGN
* Compute cash discount
* CUR.Discount allowed 15.2 USR =
* *COMPUTE (((x1 - x4) * x2 / x3))
* x1 : WRK.Order value with cash dct
* - : PGM.*Synon (17,7) work field
* x4 : CUR.Total freight 15.2 USR
* * : PGM.*Synon (17,7) work field *
* x2 : WRK.Terms percent
* / : PGM.*Synon (17,7) work field *
* x3 : CON.100
C WUAB05 SUB YAAB12 W0WD02 *Synon (17,7) w
C W0WD02 MULT WUABPC W0WD01 *Synon (17,7) w
C W0WD01 DIV 100 W0WD00 *Synon (17,7) w
C Z-ADDW0WD00 YAAB13 Discount allowe
C Z-ADD*ZERO WN0067 10 Decimal positio
C Z-ADD*ZERO WN0068 20 Company number
C Z-ADD*ZERO WN0069 150 Price 15.0 USR
C Z-ADD*ZERO WN0070 152 Price 15.2 USR
* INT:Set Prc to Cur Dec Ps
* ** Depending on the currency in question the Price (15.3)
* field can either have:
* (a) two decimal places
* (b) no decimal places.
* Set Company_number for Currency retrieve.
* CASE: PAR.Currency ID is Blank
C P1BRCD IFEQ *BLANK *IF
C Z-ADD*ZERO WN0068 Company number
C ELSE
* CASE: *OTHERWISE
C Z-ADDP1AENB WN0068 Company number
C END *FI
* INT:Get Currency Array
* ** The intent of this function is to reduce I/O to the Currency
* file by storing the data in a Synon array. The data
* is not only available within the program but also persists
* through invocations of the program, until the program is close
* ** This technique is similar to the one used to reduce SYSCTL I/O
* *** If IFM installed, only company 01 records exist.
C Z-ADDWN0068 WUAAQR Company number
* Check if IFM installed?
* EXT:Installed app APPTXT - SYSCTL API non-OEI rcds *
C CALL 'AMZAIH2R' 90 EXT:Installed a
C PARM 'IFM' WQ0570 4 Application ali
C WUADVB PARM *BLANK WQ0571 1 Installed apps
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAIH2R'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* If IFM installed, Currency file only has company 01 records.
* CASE:
* - c1 AND c2
* |- c1 : WRK.Installed apps - IFM is Installed
* |- c2 : WRK.Company number USR is Not equal 01
* '-
C MOVEL'0' Y0CX01 1
C WUADVB IFEQ '1' *IF
C WUAAQR IFNE 01 *IF
C MOVEL'1' Y0CX01
C END *FI
C END *FI
C Y0CX01 IFEQ '1' *IF
C Z-ADD01 WUAAQR Company number
C END *FI
* RTV:Currency File Array - *Arrays *
C EXSR PCRVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* Load Currency File Array - *Arrays *
C EXSR PDCRRC
* Retry the load?
* CASE:
* - NOT c1
* |- c1 : PGM.*Return code is *Normal
* '-
C MOVEL'0' Y0CX01 1
C W0RTN IFEQ *BLANK *IF
C ELSE
C MOVEL'1' Y0CX01
C END *FI
C Y0CX01 IFEQ '1' *IF
* ** This error indicates the array is full.
* ** So, the foreign currency array elements are cleared to
* make room.
* ** The array size of 5 was chosen to limit the program's size
* but still handle quite a few currencies before running
* this exception handling.
* Clear Currency File Array - *Arrays *
C EXSR PHDLRC
* Load Currency File Array - *Arrays *
C EXSR PICRRC
C END *FI
C END *FI
C MOVEL*BLANK W0RTN *Return code
* Set Price.
* CASE: PAR.Decimal positions is 0
C WN0067 IFEQ *ZERO *IF
C YAAB13 MULT 1 WN0069 H Price 15.0 USR
C WN0069 MULT 1 YAAB13 &Price
C ELSE
* CASE: PAR.Decimal positions is 2
C WN0067 IFEQ 2 *IF
C YAAB13 MULT 1 WN0070 H Price 15.2 USR
C WN0070 MULT 1 YAAB13 &Price
C END *FI
C END *FI
C END *FI
* For the tax calculation, Net sales amount needs to include
* the surcharge amount. However for the invoice/Quote/Ack
* purposes the surcharge amount neeeds to be added to misc
* charges instead.
C ADD WUAACB YAAB11 Total misc 15.2
*================================================================
CSR UPEXIT ENDSR
/EJECT
CSR XDVC2T BEGSR
*================================================================
* Convert internal to external date format
*================================================================
* Map according to date format
C Z-ADD0 XDEX01 CC
C XDDTFM IFEQ 'DMY'
C Z-ADDXDINDD XDEX02 DD
C Z-ADDXDINMM XDEX03 MM
C Z-ADDXDINYY XDEX04 YY
C ELSE
C XDDTFM IFEQ 'MDY'
C Z-ADDXDINMM XDEX02 MM
C Z-ADDXDINDD XDEX03 DD
C Z-ADDXDINYY XDEX04 YY
C ELSE
* YMD format
C Z-ADDXDINYY XDEX02 YY
C Z-ADDXDINMM XDEX03 MM
C Z-ADDXDINDD XDEX04 DD
C END
C END
*================================================================
CSR XDVC2E ENDSR
/EJECT
CSR ZASNMS BEGSR
*================================================================
* Send message to program's message queue
*================================================================
C ZAPGMQ IFEQ *BLANK
C MOVELZZPGM ZAPGMQ
C END
* If no message file specified, use default
C ZAMSGF IFEQ *BLANK
C MOVELZADFMF ZAMSGF
C END
C CALL 'Y2SNMGC'
C PARM ZAPGMQ 10 Program queue
C PARM ZAPGRL 5 Rel queue
C PARM ZAMSID 7 Message ID
C PARM ZAMSGF 10 Message file
C PARM ZAMSDA Message data
C PARM ZAMSTP 7 Message type
* Clear all fields for default mechanism next time
C MOVEL*BLANK ZAPGMQ
C MOVEL*BLANK ZAPGRL
C MOVEL*BLANK ZAMSID
C MOVEL*BLANK ZAMSGF
C MOVEL*BLANK ZAMSDA
C MOVEL*BLANK ZAMSTP
*================================================================
CSR ZAEXIT ENDSR
/EJECT
CSR ZCINIT BEGSR
*================================================================
* PRO:Acknowledgement Lines: Initialise
*================================================================
* USER: Initialize program
C Z-ADD*ZERO WUAB1X Net sales amoun
C Z-ADD*ZERO WUZ04P Alt net sles am
C Z-ADD1 WULCNB Ship release se
*================================================================
CSR ZCEXIT ENDSR
/EJECT
CSR ZHINIT BEGSR
*================================================================
* PRO:Invoice item tax: Initialise
*================================================================
* USER: Initialize program
* Check for IFM AR interface.
* CASE: *OTHERWISE
* INT:Get SYSCTL XMREPT Arr
* RTV:SYSCTL XMREPT Array - *Arrays *
C EXSR NORVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* Load SYSCTL XMREPT Array - *Arrays *
C EXSR NPCRRC
C END *FI
C MOVEL*BLANK W0RTN *Return code
*================================================================
CSR ZHEXIT ENDSR
/EJECT
CSR ZIINIT BEGSR
*================================================================
* PRO:Invoice special charg: Initialise
*================================================================
* USER: Initialize program
* Comments on this function
C EXSR ULSUBR Comments on thi
* ** Record selection processing builds this special charge
* surcharge array. It is cleared here for the next
* invoice.
* DLT:History Special Chg 2 - *Arrays *
C EXSR NQDLRC
* DLT:History Special Chg - *Arrays *
C EXSR NRDLRC
* RTV:Count Surch & Special - History Special Charge *
C EXSR NSRVGN
*================================================================
CSR ZIEXIT ENDSR
/EJECT
CSR ZKINIT BEGSR
*================================================================
* PRO:Invoice spc chg tax: Initialise
*================================================================
* USER: Initialize program
* Check for IFM AR interface.
* CASE: *OTHERWISE
* INT:Get SYSCTL XMREPT Arr
* RTV:SYSCTL XMREPT Array - *Arrays *
C EXSR NXRVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* Load SYSCTL XMREPT Array - *Arrays *
C EXSR NYCRRC
C END *FI
C MOVEL*BLANK W0RTN *Return code
* Clear this array for special charges.
* CASE: PAR.Special charge sequence # is Zero
C ZRAAD2 IFEQ *ZERO *IF
* DLT:Historical Tax Array - *Arrays *
C EXSR NZDLRC
C END *FI
* Count taxes for this surcharge line if this is a surcharge.
* CASE: PAR.Special charge sequence # is Zero
C ZRAAD2 IFEQ *ZERO *IF
* RTV:Count Tax Grps - surc - Historical Tax *
C EXSR OARVGN
C END *FI
*================================================================
CSR ZKEXIT ENDSR
/EJECT
CSR ZLINIT BEGSR
*================================================================
* PRO:Invoice Tax Summary: Initialise
*================================================================
* USER: Initialize program
* Check for IFM AR interface.
* CASE: *OTHERWISE
* INT:Get SYSCTL XMREPT Arr
* RTV:SYSCTL XMREPT Array - *Arrays *
C EXSR OORVGN
* CASE: PGM.*Return code is *Record does not exist
C W0RTN IFEQ 'Y2U0005' *IF
* Load SYSCTL XMREPT Array - *Arrays *
C EXSR OPCRRC
C END *FI
C MOVEL*BLANK W0RTN *Return code
* DLT:Historical Tax Array - *Arrays *
C EXSR OQDLRC
* RTV:Count Tax Groups - Historical Tax *
C EXSR ORRVGN
*================================================================
CSR ZLEXIT ENDSR
/EJECT
CSR ZXEXPG BEGSR
*================================================================
* Exit program
*================================================================
C MOVEL*BLANK P0RTN
C EXSR ZYEXPG
*================================================================
CSR ZXEXIT ENDSR
/EJECT
CSR ZYEXPG BEGSR
*================================================================
* Exit program: Direct
*================================================================
* Exit program
C RETRN
*================================================================
CSR ZYEXIT ENDSR
/EJECT
CSR ZZINIT BEGSR
*================================================================
* Initialisation
*================================================================
C W0ICL IFEQ *BLANK
C MOVEL'Y' W0ICL 1 *Initial call
C ELSE
C MOVEL'N' W0ICL
C END
C MOVE *BLANK P0RTN
C MOVE *BLANK W0RTN 7
C MOVEL*BLANK W0RSL 1
C MOVEL*BLANK W0RSF 1
C MOVEL*ZEROS W0RTW 90
C MOVEL'400' W0ENV 3
* Clear all neither parameters
C MOVEL*BLANK P1BRCD Currency ID
C MOVEL*BLANK P1BLCD Terms code
C MOVEL*BLANK P2CMTX Address line 1
C MOVEL*BLANK P2CNTX Address line 2
C MOVEL*BLANK P2COTX Address line 3
C MOVEL*BLANK P2CVCD Postal code
C MOVEL*BLANK P2CPTX City
C MOVEL*BLANK P2COCD Country code
C MOVEL*BLANK P2BYCD State code (key
C MOVEL*BLANK P4Z9AN Billing & inven
C MOVEL*BLANK P5Z9JB Tax in price fl
C Z-ADD*ZERO P6Z9Z0 Total tax amt f
* Initialise indicators for re-entry
C MOVE '0' *IN
* Retrieve job attributes
C CALL 'Y2RTJCR'
C PARM PGMDS
* Setup job date/time
C Z-ADDZZSD7 ZZJDT
C TIME ZZJTM
* Update screen time
C TIME ZZTME 60
* Define work field SYSCTL key error
C MOVEL*BLANK WUZ80O 6
* Define work field *Return code
C MOVEL*BLANK WURTN 7
* Define work field Address format
C MOVEL*BLANK WUHYST 1
* Define work field More than one warehouse
C MOVEL*BLANK WUZ80P 1
* Define work field Central warehouse
C MOVEL*BLANK WUZ80Q 3
* Define work field Feature/option template
C MOVEL*BLANK WUZ80R 20
* Define work field Feature/options
C MOVEL*BLANK WUZ80S 1
* Define work field Sysctl user sequence
C MOVEL*BLANK WUZ80T 1
* Define work field Seq for product structure
C MOVEL*BLANK WUZ80U 1
* Define work field Cost cal method for acc
C MOVEL*BLANK WUZ80V 1
* Define work field Inventory trans history
C MOVEL*BLANK WUZ80W 1
* Define work field Quality control indicator
C MOVEL*BLANK WUZ80X 1
* Define work field Batch lot indicator
C MOVEL*BLANK WUZ80Y 1
* Define work field Goods received note ind
C MOVEL*BLANK WUZ80Z 1
* Define work field FIFO control record
C MOVEL*BLANK WUZ801 1
* Define work field Subdivision flag
C MOVEL*BLANK WUZ802 1
* Define work field Allow negative loc qnty
C MOVEL*BLANK WUZ803 1
* Define work field MPS start date
C Z-ADD*ZERO WUZ804 70
* Define work field Aggregation date
C Z-ADD*ZERO WUZ805 70
* Define work field Future aging
C MOVEL*BLANK WUZ806 1
* Define work field taxing body
C MOVEL*BLANK WUZ807 2
* Define work field IM installed
C MOVEL*BLANK WUZ808 1
* Define work field PDM installed
C MOVEL*BLANK WUZ809 1
* Define work field MRP installed
C MOVEL*BLANK WUZ800 1
* Define work field MPSP installed
C MOVEL*BLANK WUZ9AA 1
* Define work field FCST installed
C MOVEL*BLANK WUZ9AB 1
* Define work field REP installed
C MOVEL*BLANK WUZ9AC 1
* Define work field Multi-company indicator
C MOVEL*BLANK WUZ9AD 1
* Define work field Fiscal period indicator
C MOVEL*BLANK WUZ9AE 1
* Define work field Monthly periods defined
C MOVEL*BLANK WUZ9AJ 1
* Define work field Before/after print
C MOVEL*BLANK WUZ9AK 1
* Define work field Multi-currency support
C MOVEL*BLANK WUZ9AL 1
* Define work field OEI GLI interface
C MOVEL*BLANK WUZ9AM 1
* Define work field Billing & inventory inter
C MOVEL*BLANK WUZ9AN 1
* Define work field Sales interface
C MOVEL*BLANK WUZ9AO 1
* Define work field AR interface
C MOVEL*BLANK WUZ9AP 1
* Define work field Delinquent period desig
C MOVEL*BLANK WUAAT9 1
* Define work field Margin calculation method
C MOVEL*BLANK WUAAZ3 1
* Define work field Order Entry Installed
C MOVEL*BLANK WUABDV 1
* Define work field Entry time pricing
C MOVEL*BLANK WUABYH 1
* Define work field Crossfoot quantities
C MOVEL*BLANK WUABYJ 1
* Define work field Special charge 3 to SA
C MOVEL*BLANK WUABYK 1
* Define work field Booking record option
C MOVEL*BLANK WUABYL 1
* Define work field Generated demand in ATP
C MOVEL*BLANK WUABYM 1
* Define work field Commission worksheet
C MOVEL*BLANK WUABYN 1
* Define work field General ledger worksheet
C MOVEL*BLANK WUABYP 1
* Define work field Shipped order history
C MOVEL*BLANK WUABYQ 1
* Define work field MPA to COM interfacing
C MOVEL*BLANK WUACB0 1
* Define work field KBC installed
C MOVEL*BLANK WUADXM 1
* Define work field Page number for PRINT
C Z-ADD*ZERO WUABC5 40
* Define work field ACS Apply complete flag
C MOVEL*BLANK WUADHJ 1
* Define work field Initial install complete
C MOVEL*BLANK WUADHK 1
* Define work field Installation complete flg
C MOVEL*BLANK WUADHL 1
* Define work field AP - IM interface
C MOVEL*BLANK WUADHM 1
* Define work field AR - AP interface
C MOVEL*BLANK WUADHN 1
* Define work field PUR - MRP interface
C MOVEL*BLANK WUADHP 1
* Define work field PUR - IM interface
C MOVEL*BLANK WUADHQ 1
* Define work field MPSP - MRP interface
C MOVEL*BLANK WUADHR 1
* Define work field COM - MPSP interface
C MOVEL*BLANK WUADHS 1
* Define work field MRP - REP interface
C MOVEL*BLANK WUADHT 1
* Define work field COM - REP interface
C MOVEL*BLANK WUADHV 1
* Define work field PMC - REP interface
C MOVEL*BLANK WUADHW 1
* Define work field MPA - COM interface
C MOVEL*BLANK WUADHY 1
* Define work field MPA - PCC interface
C MOVEL*BLANK WUADHZ 1
* Define work field MPA - MRP interface
C MOVEL*BLANK WUADH1 1
* Define work field PUR - GL interface
C MOVEL*BLANK WUADH2 1
* Define work field PUR - PCC interface
C MOVEL*BLANK WUADH3 1
* Define work field Work (alpha 1) (usr)
C MOVEL*BLANK WUABW2 1
* Define work field Master file save control
C MOVEL*BLANK WUADH4 1
* Define work field Current unrestart w/s job
C MOVEL*BLANK WUADH5 3
* Define work field Reuse data entry segments
C MOVEL*BLANK WUADH6 1
* Define work field Fiscal period indic
C MOVEL*BLANK WUADH7 1
* Define work field Date format for dsp/prt
C MOVEL*BLANK WUADH8 1
* Define work field Date validation code
C MOVEL*BLANK WUADH9 1
* Define work field COM - GL interface
C MOVEL*BLANK WUADH0 1
* Define work field I/T checkpoint
C MOVEL*BLANK WUADJA 3
* Define work field PR - GL interface
C MOVEL*BLANK WUADJB 1
* Define work field AP - GL interface
C MOVEL*BLANK WUADJC 1
* Define work field AR - GL interface
C MOVEL*BLANK WUADJD 1
* Define work field AP - PCC interface
C MOVEL*BLANK WUADJF 1
* Define work field PR - PCC interface
C MOVEL*BLANK WUADJG 1
* Define work field PMC - PR interface
C MOVEL*BLANK WUADJH 1
* Define work field IM - PCC interface
C MOVEL*BLANK WUADJJ 1
* Define work field PMC - IM interface
C MOVEL*BLANK WUADJK 1
* Define work field IM - SA interface
C MOVEL*BLANK WUADJL 1
* Define work field IM - COM interface
C MOVEL*BLANK WUADJM 1
* Define work field IM - MRP interface
C MOVEL*BLANK WUADJN 1
* Define work field IM - PDM interface
C MOVEL*BLANK WUADJP 1
* Define work field PDM - PCC interface
C MOVEL*BLANK WUADJQ 1
* Define work field PDM - MRP interface
C MOVEL*BLANK WUADJR 1
* Define work field PDM - COM interface
C MOVEL*BLANK WUADJS 1
* Define work field COM - MRP interface
C MOVEL*BLANK WUADJT 1
* Define work field COM - SA interface
C MOVEL*BLANK WUADJV 1
* Define work field COM - AR interface
C MOVEL*BLANK WUADJW 1
* Define work field AR - SA interface
C MOVEL*BLANK WUADJY 1
* Define work field PMC - PCC interface
C MOVEL*BLANK WUADJZ 1
* Define work field PCC - IM interface
C MOVEL*BLANK WUADJ1 1
* Define work field IM - GL interface
C MOVEL*BLANK WUADJ2 1
* Define work field COM - IM interface
C MOVEL*BLANK WUADJ3 1
* Define work field MRP - IM interface
C MOVEL*BLANK WUADJ4 1
* Define work field PDM - IM interface
C MOVEL*BLANK WUADJ5 1
* Define work field MRP - PDM interface
C MOVEL*BLANK WUADJ6 1
* Define work field PCC - GL interface
C MOVEL*BLANK WUADJ7 1
* Define work field EDMI - PDM interface
C MOVEL*BLANK WUADJ8 1
* Define work field FCST - MRP interface
C MOVEL*BLANK WUADJ9 1
* Define work field FA - GL interface
C MOVEL*BLANK WUADJ0 1
* Define work field Questionnaire heading
C MOVEL*BLANK WUADKA 1
* Define work field Yes response character
C MOVEL*BLANK WUADKB 1
* Define work field No response character
C MOVEL*BLANK WUADKC 1
* Define work field Work alpha (1) USR
C MOVEL*BLANK WUACV5 1
* Define work field Mth periods defined weeks
C MOVEL*BLANK WUADKD 1
* Define work field Weeks per period array
C MOVEL*BLANK WUADKF 12
* Define work field Week beginning day
C MOVEL*BLANK WUADKG 1
* Define work field Last file sts report date
C MOVEL*BLANK WUADKH 6
* Define work field Last file sts report time
C MOVEL*BLANK WUADKJ 6
* Define work field REP - GL interface
C MOVEL*BLANK WUADKK 1
* Define work field IFM GLI interface
C MOVEL*BLANK WUADKM 1
* Define work field IFM AP interface
C MOVEL*BLANK WUADKN 1
* Define work field IFM AR interface
C MOVEL*BLANK WUADKP 1
* Initialize KEY fields.
C MOVEL*LOVAL C6AENB Company number
C MOVEL*LOVAL C6DCCD Internal header
C MOVEL*LOVAL C6CVNB Quote/order num
* Obtain default message file
C *NAMVAR DEFN MBMGFLA ZADFMF 10
C IN ZADFMF
* Define work field External header type
C MOVEL*BLANK WUAAHZ 2
* Define work field Terms discount days
C Z-ADD*ZERO WUCXNB 30
* Define work field Terms net due days
C Z-ADD*ZERO WUCYNB 30
* Define work field Terms percent
C Z-ADD*ZERO WUABPC 73
* Define work field Installed apps conditions
C MOVEL*BLANK WUADRB 1
* Define work field Terms code (USR)
C MOVEL*BLANK WUACKW 2
* Define work field Discount percentage IFM
C Z-ADD*ZERO WUADLL 52
* Define work field Prtd in alternate ccy USR
C MOVEL*BLANK WUZ04D 1
* Define work field Alternate currency ID
C MOVEL*BLANK WUZ0YH 3
* Define work field Print details?
C MOVEL*BLANK WUAAMK 1
* Define work field Installed apps - IFM
C MOVEL*BLANK WUADVB 1
* Define work field Company number USR
C Z-ADD*ZERO WUAAQR 20
* Define work field Primary Currency ID 09570
C MOVEL*BLANK WUAALP 3
* Define work field Exchange rate code
C Z-ADD*ZERO WUAJNB 10
* Define work field Decimal positions
C Z-ADD*ZERO WUAKNB 10
* Define work field AP exchange gain/loss acc
C MOVEL*BLANK WUALNB 15
* Define work field AR exchange gain/loss acc
C MOVEL*BLANK WUAMNB 15
* Define work field Price adjustment factor
C Z-ADD*ZERO WUABVA 52
* Define work field Ship lead time
C Z-ADD*ZERO WUEENB 20
* Define work field Address code
C Z-ADD*ZERO WUCUCD 50
* Define work field Address line 1
C MOVEL*BLANK WUCMTX 35
* Define work field Address line 2
C MOVEL*BLANK WUCNTX 35
* Define work field Address line 3
C MOVEL*BLANK WUCOTX 35
* Define work field Address line 4
C MOVEL*BLANK WUZ9HH 35
* Define work field Address line 5
C MOVEL*BLANK WUZ9HG 35
* Define work field Contact name
C MOVEL*BLANK WUCQTX 25
* Define work field Telephone number
C MOVEL*BLANK WUCRTX 20
* Define work field Fax number
C MOVEL*BLANK WUCSTX 20
* Define work field Shipping instructions
C MOVEL*BLANK WUCDTX 30
* Define work field Ship to location
C MOVEL*BLANK WUG5CD 9
* Define work field Zone
C MOVEL*BLANK WUBKCD 2
* Define work field Address lines to print
C Z-ADD*ZERO WUZ9HK 10
* Define work field Address line 1 - out 40
C MOVEL*BLANK WUX9HA 40
* Define work field Address line 2 - out 40
C MOVEL*BLANK WUZ9HB 40
* Define work field Address line 3 - out 40
C MOVEL*BLANK WUZ9HC 40
* Define work field Address line 4 - out 40
C MOVEL*BLANK WUZ9HD 40
* Define work field Address line 5 - out 40
C MOVEL*BLANK WUZ9HF 40
* Define work field &Conversion type
C Z-ADD*ZERO WUAAKL 10
* Define work field Postal code
C MOVEL*BLANK WUCVCD 10
* Define work field City
C MOVEL*BLANK WUCPTX 35
* Define work field Country code
C MOVEL*BLANK WUCOCD 3
* Define work field State code (key)
C MOVEL*BLANK WUBYCD 2
* Initialize renamed input format fields
C Z-ADD*ZERO WAAENB Company number
C Z-ADD*ZERO WACANB Customer number
C Z-ADD*ZERO WACUCD Address code
C Z-ADD*ZERO WAALDT Create date
C Z-ADD*ZERO WAABTM Create time
C Z-ADD*ZERO WAAMDT Change date
C Z-ADD*ZERO WAACTM Change time
* Define work field Carrier description USR
C MOVEL*BLANK WUAFJ0 25
* Define work field Currency ID (usr)
C MOVEL*BLANK WUAAM5 3
* Initialize renamed input format fields
C Z-ADD*ZERO WBAENB Company number
C Z-ADD*ZERO WBGGNB Invoice number
C Z-ADD*ZERO WBHYNB Invoice sequenc
C Z-ADD*ZERO WBKBNB Comment line se
C Z-ADD*ZERO WBK4NB Shipment header
C Z-ADD*ZERO WBAFAD Shipment consol
C Z-ADD*ZERO WBLCNB Ship release se
C Z-ADD*ZERO WBAASZ Kit release seq
C Z-ADD*ZERO WBAAD2 Special charge
C Z-ADD*ZERO WBALDT Create date
C Z-ADD*ZERO WBABTM Create time
* Initialize KEY fields.
C MOVEL*LOVAL WBAENB Company number
C MOVEL*LOVAL WBGGNB Invoice number
C MOVEL*LOVAL WBHYNB Invoice sequenc
C MOVEL*LOVAL WBDCCD Internal header
C MOVEL*LOVAL WBCVNB Quote/order num
C MOVEL*LOVAL WBHXCD Comment user re
C MOVEL*LOVAL WBKBNB Comment line se
* Define work field Comment line sequence no.
C Z-ADD*ZERO WUKBNB 50
* Define work field Comment line text
C MOVEL*BLANK WUHDTX 25
* Define work field Work Number (1.0)
C Z-ADD*ZERO WUABGP 10
* Define work field Date parameter 1 (usr)
C MOVEL*BLANK WUAA09 7
* Define work field work field 13 characters
C MOVEL*BLANK WUADX9 13
* Define work field Return code (USR)
C MOVEL*BLANK WUAAKC 1
* Define work field Comment line seq no. USR
C Z-ADD*ZERO WUAFD6 50
* Define work field Language code USR
C MOVEL*BLANK WUHVCD 3
* Define work field Counter
C Z-ADD*ZERO WUAAJH 30
* Define work field Continue?
C MOVEL*BLANK WUAA04 1
* Define work field Text line 77 USR
C MOVEL*BLANK WUAFD7 77
* Define work field &Alpha 2 USR
C MOVEL*BLANK WUACC3 2
* Define work field Ord ship not inv flg USR
C MOVEL*BLANK WUZ9DA 1
* Define work field Net sales amount 15.2 USR
C Z-ADD*ZERO WUAB1X 152
* Define work field Alt net sles amt 15.2 USR
C Z-ADD*ZERO WUZ04P 112
* Define work field Ship release sequence
C Z-ADD*ZERO WULCNB 70
* Initialize KEY fields.
C MOVEL*LOVAL CDAENB Company number
C MOVEL*LOVAL CDDCCD Internal header
C MOVEL*LOVAL CDCVNB Quote/order num
C MOVEL*LOVAL CDKTNB User entered se
C MOVEL*LOVAL CDAFVL System sequence
* Define work field External doc print option
C MOVEL*BLANK WUHIST 1
* Define work field Kit/component indicator
C MOVEL*BLANK WUILST 1
* Define work field Kit ext doc print option
C MOVEL*BLANK WUIQST 1
* Define work field Wght unit of measure
C MOVEL*BLANK WUAA80 2
* Define work field &Chr
C MOVEL*BLANK WUZ0NB 1
* Define work field Item description 10 char
C MOVEL*BLANK WUALCD 10
* Define work field Item description 20 char
C MOVEL*BLANK WUAJTX 20
* Define work field Commissionable percent
C Z-ADD*ZERO WUAPPC 73
* Define work field Default ship to address?
C MOVEL*BLANK WUAA9L 1
* Define work field Address type (key)
C MOVEL*BLANK WUE2ST 1
* Define work field Sale code
C MOVEL*BLANK WUBHST 1
* Define work field Tax suffix (key)
C MOVEL*BLANK WUBXCD 5
* Define work field Customer class code
C MOVEL*BLANK WUC7CD 5
* Define work field EEC transaction code
C MOVEL*BLANK WUAAB4 2
* Define work field Transport mode code
C MOVEL*BLANK WUAABZ 2
* Define work field Delivery terms code
C MOVEL*BLANK WUAAB6 3
* Initialize renamed input format fields
C Z-ADD*ZERO WDAENB Company number
C Z-ADD*ZERO WDCANB Customer number
C Z-ADD*ZERO WDCPNB Shipment lead t
C Z-ADD*ZERO WDAPPC Commissionable
C Z-ADD*ZERO WDUUD1 User Field - Da
C Z-ADD*ZERO WDAFFA GEO Code - SP R
C Z-ADD*ZERO WDCUCD Address code
C Z-ADD*ZERO WDCHNB Salesrep number
C Z-ADD*ZERO WDALDT Create date
C Z-ADD*ZERO WDABTM Create time
C Z-ADD*ZERO WDAMDT Change date
C Z-ADD*ZERO WDACTM Change time
* Define work field Price conversion flag USR
C MOVEL*BLANK WUACLA 1
* Define work field Latest promise date
C Z-ADD*ZERO WUBIDT 70
* Define work field Latest request date
C Z-ADD*ZERO WUBJDT 70
* Initialize renamed input format fields
C Z-ADD*ZERO WEC2NB Calendar date
C Z-ADD*ZERO WEALDT Create date
C Z-ADD*ZERO WEABTM Create time
C Z-ADD*ZERO WEAMDT Change date
C Z-ADD*ZERO WEACTM Change time
* Define work field Production Calendar name
C MOVEL*BLANK WUAB5K 10
* Define work field Created by program
C MOVEL*BLANK WUAGVN 10
* Define work field Open release qty tot USR
C Z-ADD*ZERO WUACS7 103
* Define work field Customer order quantity
C Z-ADD*ZERO WUDHVA 103
* Define work field Overflow? USR
C MOVEL*BLANK WUACV9 1
* Define work field +P#ERED Found Error?
C MOVEL*BLANK WUABNV 1
* Define work field Dimension U/M
C MOVEL*BLANK WUCQCD 2
* Define work field &Amount 19.8
C Z-ADD*ZERO WUKTVA 198
* Define work field Work number 20.4 USR
C Z-ADD*ZERO WUACWQ 204
* Define work field Convert to 10.3 USR
C Z-ADD*ZERO WUACWA 103
* Define work field *Synon (17,7) work field
C Z-ADD*ZERO WUWD 177
* Define work field Net sales amount
C Z-ADD*ZERO WUDPVA 153
* Define work field LC - net sales amount
C Z-ADD*ZERO WUDUVA 153
* Define work field Currency conv overflow
C MOVEL*BLANK WUACGL 1
* Define work field Currency description
C MOVEL*BLANK WUA3TX 15
C W0ICL IFEQ 'Y'
* Initialize array variables
C MOVEA*HIVAL YK01
* Initialize last used element number
C Z-ADD0 YL01 50
C Z-ADD1 Y 50
C ENDIF
* Define work field Request date
C Z-ADD*ZERO WUD0NB 70
* Define work field Exchange rate 1
C Z-ADD*ZERO WUGAVA 116
* Define work field Function (USR)
C MOVEL*BLANK WUAAKD 1
* Define work field Effective date from
C Z-ADD*ZERO WUIKNB 70
* Define work field Primary currency ID
C MOVEL*BLANK WUAGCD 3
* Define work field Rounded amount (USR)
C Z-ADD*ZERO WUAAKG 172
* Initialize KEY fields.
C MOVEL*LOVAL ACAENB Company number
C MOVEL*LOVAL ACDCCD Internal header
C MOVEL*LOVAL ACCVNB Quote/order num
C MOVEL*LOVAL ACFCNB Line item seque
C MOVEL*LOVAL ACKXNB Feat/opt sequen
* Initialize KEY fields.
C MOVEL*LOVAL CAAITX Item number
C MOVEL*LOVAL CAGYTX Component item
* Define work field Record found?
C MOVEL*BLANK WUACM1 1
* Define work field Release number
C Z-ADD*ZERO WUDRNB 50
* Initialize renamed input format fields
C Z-ADD*ZERO WGAENB Company number
C Z-ADD*ZERO WGFCNB Line item seque
C Z-ADD*ZERO WGDRNB Release number
C Z-ADD*ZERO WGAASZ Kit release seq
C Z-ADD*ZERO WGBIDT Latest promise
C Z-ADD*ZERO WGAIDT Original promis
C Z-ADD*ZERO WGK3NB Release time
C Z-ADD*ZERO WGDZVA Release quantit
C Z-ADD*ZERO WGBJDT Latest request
C Z-ADD*ZERO WGAJDT Original reques
C Z-ADD*ZERO WGAKDT Manufacturing d
C Z-ADD*ZERO WGAQQT Open to pick/MB
C Z-ADD*ZERO WGAAN6 Original releas
C Z-ADD*ZERO WGAASL Next pick quant
C Z-ADD*ZERO WGAAN7 Original manuf
C Z-ADD*ZERO WGZ93N Pick list quant
C Z-ADD*ZERO WGZ93T Pick list
C Z-ADD*ZERO WGCANB Customer number
C Z-ADD*ZERO WGAFVL System sequence
C Z-ADD*ZERO WGAF79 Allocated qty -
C Z-ADD*ZERO WGAF70 Shipped qty - s
C Z-ADD*ZERO WGA4NB Batch/lot contr
C Z-ADD*ZERO WGA5NB Discrete alloca
C Z-ADD*ZERO WGK0NB Trigger sequenc
C Z-ADD*ZERO WGALDT Create date
C Z-ADD*ZERO WGABTM Create time
C Z-ADD*ZERO WGAMDT Change date
C Z-ADD*ZERO WGACTM Change time
C Z-ADD*ZERO WGJ9VA Kit comp. prora
C Z-ADD*ZERO WGJ8NB Kit comp. quant
* Initialize KEY fields.
C MOVEL*LOVAL WHAENB Company number
C MOVEL*LOVAL WHDCCD Internal header
C MOVEL*LOVAL WHCVNB Quote/order num
C MOVEL*LOVAL WHFCNB Line item seque
C MOVEL*LOVAL WHDRNB Release number
C MOVEL*LOVAL WHAASZ Kit release seq
* Define work field *PROGRAM
C MOVEL*BLANK WUPGM 10
* Define work field Conv ratio stock qty USR
C Z-ADD*ZERO WUACYW 95
* Define work field Conv ratio order qty USR
C Z-ADD*ZERO WUACYX 95
* Define work field Rounding option
C MOVEL*BLANK WUFEST 1
* Define work field Open to pick/MBO quantity
C Z-ADD*ZERO WUAQQT 103
* Initialize KEY fields.
C MOVEL*LOVAL WCAENB Company number
C MOVEL*LOVAL WCGGNB Invoice number
C MOVEL*LOVAL WCHYNB Invoice sequenc
C MOVEL*LOVAL WCKBNB Comment line se
C MOVEL*LOVAL WCAKCD Language code
C W0ICL IFEQ 'Y'
* Initialize array variables
C MOVEA*HIVAL YK02
* Initialize last used element number
C Z-ADD0 YL02 50
C ENDIF
* Initialize KEY fields.
C MOVEL*LOVAL GFAENB Company number
C MOVEL*LOVAL GFDCCD Internal header
C MOVEL*LOVAL GFCVNB Quote/order num
C MOVEL*LOVAL GFK4NB Shipment header
C MOVEL*LOVAL GFLCNB Ship release se
C MOVEL*LOVAL GFAASZ Kit release seq
C MOVEL*LOVAL GFAAG2 Tax sequence
C W0ICL IFEQ 'Y'
* Initialize array variables
C MOVEA*HIVAL YK03
* Initialize last used element number
C Z-ADD0 YL03 50
C ENDIF
C W0ICL IFEQ 'Y'
* Initialize array variables
C MOVEA*HIVAL YK04
* Initialize last used element number
C Z-ADD0 YL04 50
C ENDIF
* Define work field &No of Special charges
C Z-ADD*ZERO WUAC0B 50
* Define work field &No of Surcharges
C Z-ADD*ZERO WUAC0C 50
* Initialize renamed input format fields
C Z-ADD*ZERO WMAENB Company number
C Z-ADD*ZERO WMGGNB Invoice number
C Z-ADD*ZERO WMHYNB Invoice sequenc
C Z-ADD*ZERO WMAAD2 Special charge
C Z-ADD*ZERO WMDDVA Special charge
C Z-ADD*ZERO WMAAD4 LC special char
C Z-ADD*ZERO WMDEVA Special charge
C Z-ADD*ZERO WMZ9QD Tax include spe
C Z-ADD*ZERO WMZ9QF Tax include Spe
C Z-ADD*ZERO WMK4NB Shipment header
C Z-ADD*ZERO WMAFAD Shipment consol
C Z-ADD*ZERO WMLCNB Ship release se
C Z-ADD*ZERO WMAASZ Kit release seq
C Z-ADD*ZERO WMALDT Create date
C Z-ADD*ZERO WMABTM Create time
* Initialize KEY fields.
C MOVEL*LOVAL F9AENB Company number
C MOVEL*LOVAL F9GGNB Invoice number
C MOVEL*LOVAL F9HYNB Invoice sequenc
* Define work field Foreign description
C MOVEL*BLANK WUAA73 30
* Define work field Special charge descriptio
C MOVEL*BLANK WUBXTX 30
* Define work field Tax include Spec chrg
C Z-ADD*ZERO WUZ9QF 132
* Define work field Special charge amount
C Z-ADD*ZERO WUDDVA 132
* Define work field Total alt special chg USR
C Z-ADD*ZERO WUZ04Z 132
* Define work field Total alt special chg 1
C Z-ADD*ZERO WUZ041 132
* Define work field Special charge sequence #
C Z-ADD*ZERO WUAAD2 70
* Define work field Surcharge code 1
C MOVEL*BLANK WUAAD7 3
* Define work field Surcharge detail code 1
C MOVEL*BLANK WUAAD8 3
* Define work field Special charge code
C MOVEL*BLANK WUBLST 1
* Initialize KEY fields.
C MOVEL*LOVAL WBAENB Company number
C MOVEL*LOVAL WBGGNB Invoice number
C MOVEL*LOVAL WBHYNB Invoice sequenc
C MOVEL*LOVAL WBDCCD Internal header
C MOVEL*LOVAL WBCVNB Quote/order num
C MOVEL*LOVAL WBHXCD Comment user re
C MOVEL*LOVAL WBKBNB Comment line se
* Initialize renamed input format fields
C Z-ADD*ZERO WRAENB Company number
C Z-ADD*ZERO WRGGNB Invoice number
C Z-ADD*ZERO WRHYNB Invoice sequenc
C Z-ADD*ZERO WRAAG2 Tax sequence
C Z-ADD*ZERO WRZ0D6 Compound tax up
C Z-ADD*ZERO WRG1VA LC - tax base a
C Z-ADD*ZERO WRGZVA Tax base amount
C Z-ADD*ZERO WRG0VA LC - tax amount
C Z-ADD*ZERO WRGYVA Tax amount
C Z-ADD*ZERO WRJ3VA Item charge dis
C Z-ADD*ZERO WRJSNB Tax effective d
C Z-ADD*ZERO WRZ9VC Tax rate
C Z-ADD*ZERO WRZ9VF Tax recovery pe
C Z-ADD*ZERO WRZ9VM Tax exclusive p
C Z-ADD*ZERO WRZ9VN Tax inclusive p
C Z-ADD*ZERO WRZ9VP Original tax ba
C Z-ADD*ZERO WRZ9VQ Recoverable tax
C Z-ADD*ZERO WRZ9VY Recoverable tax
C Z-ADD*ZERO WRZ9VZ Effective tax r
C Z-ADD*ZERO WRZ9WX Order quantity
C Z-ADD*ZERO WRZ9WY Transaction cas
C Z-ADD*ZERO WRZ9WZ Transaction cas
C Z-ADD*ZERO WRK4NB Shipment header
C Z-ADD*ZERO WRLCNB Ship release se
C Z-ADD*ZERO WRAASZ Kit release seq
C Z-ADD*ZERO WRAFAD Shipment consol
C Z-ADD*ZERO WRAAD2 Special charge
C Z-ADD*ZERO WRZ9WH Original charge
C Z-ADD*ZERO WRAHPC Trade discount
C Z-ADD*ZERO WRZ9ZZ Transaction amo
C Z-ADD*ZERO WRALDT Create date
C Z-ADD*ZERO WRABTM Create time
C W0ICL IFEQ 'Y'
* Initialize array variables
C MOVEA*HIVAL YK05
* Initialize last used element number
C Z-ADD0 YL05 50
C ENDIF
* Define work field &No of Tax groups
C Z-ADD*ZERO WUAC0D 50
* Define work field Tax group code
C MOVEL*BLANK WUACHG 3
* Initialize KEY fields.
C MOVEL*LOVAL WRAENB Company number
C MOVEL*LOVAL WRGGNB Invoice number
C MOVEL*LOVAL WRHYNB Invoice sequenc
C MOVEL*LOVAL WRAAD2 Special charge
C MOVEL*LOVAL WRAAG2 Tax sequence
* Define work field Tax amount
C Z-ADD*ZERO WUGYVA 132
* Define work field Tax invoice text
C MOVEL*BLANK WUACHH 30
* Define work field Inv lang tax invoice text
C MOVEL*BLANK WUACHJ 30
* Initialize KEY fields.
C MOVEL*LOVAL WVAENB Company number
C MOVEL*LOVAL WVGGNB Invoice number
C MOVEL*LOVAL WVHYNB Invoice sequenc
* Define work field Tax amount alternate
C Z-ADD*ZERO WUZ04Y 132
* Define work field Installment method id
C MOVEL*BLANK WUZ9H4 10
* Define work field Personal ledger ID
C MOVEL*BLANK WUADZY 10
* Define work field Print Alternate currency
C MOVEL*BLANK WUZ0YN 1
* Define work field Euro currency flag-ord
C MOVEL*BLANK WUZ0Y2 1
* Define work field Place order hold?
C MOVEL*BLANK WUACWW 1
* Define work field Invoice total discount?
C MOVEL*BLANK WUAAYA 1
* Define work field LC - total misc 13.2 USR
C Z-ADD*ZERO WUAB15 132
* Define work field LC - total freight USR
C Z-ADD*ZERO WUAB16 132
* Define work field Total for charges
C Z-ADD*ZERO WUABXA 132
* Define work field Total surcharge amount
C Z-ADD*ZERO WUAACB 132
* Define work field Total item tax amount
C Z-ADD*ZERO WUAACC 132
* Define work field Total spc charge tax amt
C Z-ADD*ZERO WUAACF 132
* Define work field Total surcharge tax amt
C Z-ADD*ZERO WUAACG 132
* Define work field Total special charge disc
C Z-ADD*ZERO WUAACH 132
* Define work field Total terms discount
C Z-ADD*ZERO WUAACP 132
* Define work field Trade discount %
C Z-ADD*ZERO WUAHPC 53
* Define work field Variable trade discount %
C Z-ADD*ZERO WUAMPC 73
* Define work field Special Charge found ?
C MOVEL*BLANK WUACKN 1
* Define work field Accumulator - net sales
C Z-ADD*ZERO WUACGS 212
* Define work field &Number 16.2
C Z-ADD*ZERO WUSANB 162
* Define work field Order value with cash dct
C Z-ADD*ZERO WUAB05 132
* Define work field Terms description
C MOVEL*BLANK WUA2TX 25
* Define *Synon program work fields
C Z-ADD*ZEROS YRSW00 50 *Synon (5,0) wo
C Z-ADD*ZEROS YRSW01 50 *Synon (5,0) wo
C Z-ADD*ZEROS W0WD01 177 *Synon (17,7) w
C Z-ADD*ZEROS W0WD00 177 *Synon (17,7) w
C Z-ADD*ZEROS W0WD03 177 *Synon (17,7) w
C Z-ADD*ZEROS W0WD02 177 *Synon (17,7) w
* Move main file information to JOB context
C MOVE @1FFL ZZFFL 10 Main file name
C MOVE @1FLB ZZFLB 10 Main file lib
C MOVE @1FMB ZZFMB 10 Main file mbr
C MOVE ZZFFL @1FFL 10
C MOVE ZZFLB @1FLB 10
C MOVE ZZFMB @1FMB 10
C CALL 'Y2QLVNR'
C PARM ZZFFL 10
C PARM ZZFLB 10
C PARM ZZFQL 21 LIBRARY/FILE
C MOVEL'N' W0PMT 1
* Define local variables for subroutine SURVGN.
C MOVEL*BLANK WL0001 15
C MOVEL*BLANK WL0002 30
* Define null work field Packing hierarchy code
C MOVEL*BLANK YN0001 1
* Define null work field Originating ship to
C MOVEL*BLANK YN0002 8
* Define null work field Packing list format opt
C MOVEL*BLANK YN0003 1
* Define null work field User Field - Switch A
C MOVEL*BLANK YN0004 1
* Define null work field User Field - Code A
C MOVEL*BLANK YN0005 5
* Define null work field User Field - Code B
C MOVEL*BLANK YN0006 5
* Define null work field User Field - Code C
C MOVEL*BLANK YN0007 5
* Define null work field User Field - Date 1
C Z-ADD*ZERO YN0008 70
* Define null work field User Field - Text 40
C MOVEL*BLANK YN0009 40
* Define null work field GEO Code - SP Reserved
C Z-ADD*ZERO YN0010 100
* Define null work field Stage area
C MOVEL*BLANK YN0011 7
* Define null work field Active/inactive flag
C MOVEL*BLANK YN0012 1
* Define null work field Export designator
C MOVEL*BLANK YN0013 1
* Define null work field Market analysis code
C MOVEL*BLANK YN0014 5
* Define null work field Carrier ID
C MOVEL*BLANK YN0015 10
* Define null work field Salesrep number
C Z-ADD*ZERO YN0016 50
* Define null work field Warehouse
C MOVEL*BLANK YN0017 3
* Define null work field Packing language code
C MOVEL*BLANK YN0018 3
* Define null work field Create date
C Z-ADD*ZERO YN0019 70
* Define null work field Create time
C Z-ADD*ZERO YN0020 60
* Define null work field Created by user
C MOVEL*BLANK YN0021 10
* Define null work field Created by program
C MOVEL*BLANK YN0022 10
* Define null work field Change date
C Z-ADD*ZERO YN0023 70
* Define null work field Change time
C Z-ADD*ZERO YN0024 60
* Define null work field Changed by user
C MOVEL*BLANK YN0025 10
* Define null work field Changed by program
C MOVEL*BLANK YN0026 10
C MOVEL*BLANK W0PFM 1
C Z-ADD*ZERO @$WRK 40
C Z-ADD*ZERO @$HDL 40
C Z-ADD*ZERO @$CLN
C Z-ADD*ZERO @$PGN
* Adjust page length and overflow as necessary
C @$PGL SUB 2 W0PGL 40
C @$OFL IFGE W0PGL
C W0PGL SUB 2 W0OFL 40
C ELSE
C Z-ADD@$OFL W0OFL
C END
* Clear overflow indicator
C SETOF 97
* Request new page
C MOVEL'Y' W0NEWP 1
* USER: Initialize program
* RTV:SYSCTL API - SYSCTL API non-OEI rcds *
C CLEARPARC
C CALL 'AMZAHUPR' 90 RTV:SYSCTL API
C PARM PARC RCD: SYSCTL API
C WUACB0 PARM *BLANK WQ0001 1 MPA to COM inte
C WUADXM PARM *BLANK WQ0002 1 KBC installed
C MOVELPAZ80O WUZ80O SYSCTL key erro
C MOVELPARTN WURTN *Return code
C MOVELPAHYST WUHYST Address format
C MOVELPAZ80P WUZ80P More than one w
C MOVELPAZ80Q WUZ80Q Central warehou
C MOVELPAZ80R WUZ80R Feature/option
C MOVELPAZ80S WUZ80S Feature/options
C MOVELPAZ80T WUZ80T Sysctl user seq
C MOVELPAZ80U WUZ80U Seq for product
C MOVELPAZ80V WUZ80V Cost cal method
C MOVELPAZ80W WUZ80W Inventory trans
C MOVELPAZ80X WUZ80X Quality control
C MOVELPAZ80Y WUZ80Y Batch lot indic
C MOVELPAZ80Z WUZ80Z Goods received
C MOVELPAZ801 WUZ801 FIFO control re
C MOVELPAZ802 WUZ802 Subdivision fla
C MOVELPAZ803 WUZ803 Allow negative
C Z-ADDPAZ804 WUZ804 MPS start date
C Z-ADDPAZ805 WUZ805 Aggregation dat
C MOVELPAZ806 WUZ806 Future aging
C MOVELPAZ807 WUZ807 taxing body
C MOVELPAZ808 WUZ808 IM installed
C MOVELPAZ809 WUZ809 PDM installed
C MOVELPAZ800 WUZ800 MRP installed
C MOVELPAZ9AA WUZ9AA MPSP installed
C MOVELPAZ9AB WUZ9AB FCST installed
C MOVELPAZ9AC WUZ9AC REP installed
C MOVELPAZ9AD WUZ9AD Multi-company i
C MOVELPAZ9AE WUZ9AE Fiscal period i
C MOVELPAZ9AJ WUZ9AJ Monthly periods
C MOVELPAZ9AK WUZ9AK Before/after pr
C MOVELPAZ9AL WUZ9AL Multi-currency
C MOVELPAZ9AM WUZ9AM OEI GLI interfa
C MOVELPAZ9AN WUZ9AN Billing & inven
C MOVELPAZ9AO WUZ9AO Sales interface
C MOVELPAZ9AP WUZ9AP AR interface
C MOVELPAAAT9 WUAAT9 Delinquent peri
C MOVELPAAAZ3 WUAAZ3 Margin calculat
C MOVELPAABDV WUABDV Order Entry Ins
C MOVELPAABYH WUABYH Entry time pric
C MOVELPAABYJ WUABYJ Crossfoot quant
C MOVELPAABYK WUABYK Special charge
C MOVELPAABYL WUABYL Booking record
C MOVELPAABYM WUABYM Generated deman
C MOVELPAABYN WUABYN Commission work
C MOVELPAABYP WUABYP General ledger
C MOVELPAABYQ WUABYQ Shipped order h
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZAHUPR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
C Z-ADD*ZERO WUABC5 Page number for
* Set Tax_in_price_flag.
* CASE: *OTHERWISE
* RTV:Tax in Price Flag - Company *
C EXSR SARVGN
* Get IFM interfacing bytes.
* RTV:SYSCTL XMREPT format - SYSCTL API non-OEI rcds *
C CALL 'AMZARUPR' 90 RTV:SYSCTL XMRE
C PARM WUZ80O WQ0003 6 SYSCTL key erro
C PARM W0RTN WQ0004 7 *Return code
C WUADHJ PARM *BLANK WQ0005 1 ACS Apply compl
C WUADHK PARM *BLANK WQ0006 1 Initial install
C WUADHL PARM *BLANK WQ0007 1 Installation co
C WUADHM PARM *BLANK WQ0008 1 AP - IM interfa
C WUADHN PARM *BLANK WQ0009 1 AR - AP interfa
C WUADHP PARM *BLANK WQ0010 1 PUR - MRP inter
C WUADHQ PARM *BLANK WQ0011 1 PUR - IM interf
C WUADHR PARM *BLANK WQ0012 1 MPSP - MRP inte
C WUADHS PARM *BLANK WQ0013 1 COM - MPSP inte
C WUADHT PARM *BLANK WQ0014 1 MRP - REP inter
C WUADHV PARM *BLANK WQ0015 1 COM - REP inter
C WUADHW PARM *BLANK WQ0016 1 PMC - REP inter
C WUADHY PARM *BLANK WQ0017 1 MPA - COM inter
C WUADHZ PARM *BLANK WQ0018 1 MPA - PCC inter
C WUADH1 PARM *BLANK WQ0019 1 MPA - MRP inter
C WUADH2 PARM *BLANK WQ0020 1 PUR - GL interf
C WUADH3 PARM *BLANK WQ0021 1 PUR - PCC inter
C WUABW2 PARM *BLANK WQ0022 1 Work (alpha 1)
C WUADH4 PARM *BLANK WQ0023 1 Master file sav
C WUADH5 PARM *BLANK WQ0024 3 Current unresta
C WUADH6 PARM *BLANK WQ0025 1 Reuse data entr
C WUZ9AD PARM *BLANK WQ0026 1 Multi-company i
C WUADH7 PARM *BLANK WQ0027 1 Fiscal period i
C WUADH8 PARM *BLANK WQ0028 1 Date format for
C WUADH9 PARM *BLANK WQ0029 1 Date validation
C WUADH0 PARM *BLANK WQ0030 1 COM - GL interf
C WUADJA PARM *BLANK WQ0031 3 I/T checkpoint
C WUADJB PARM *BLANK WQ0032 1 PR - GL interfa
C WUADJC PARM *BLANK WQ0033 1 AP - GL interfa
C WUADJD PARM *BLANK WQ0034 1 AR - GL interfa
C WUADJF PARM *BLANK WQ0035 1 AP - PCC interf
C WUADJG PARM *BLANK WQ0036 1 PR - PCC interf
C WUADJH PARM *BLANK WQ0037 1 PMC - PR interf
C WUADJJ PARM *BLANK WQ0038 1 IM - PCC interf
C WUADJK PARM *BLANK WQ0039 1 PMC - IM interf
C WUADJL PARM *BLANK WQ0040 1 IM - SA interfa
C WUADJM PARM *BLANK WQ0041 1 IM - COM interf
C WUADJN PARM *BLANK WQ0042 1 IM - MRP interf
C WUADJP PARM *BLANK WQ0043 1 IM - PDM interf
C WUADJQ PARM *BLANK WQ0044 1 PDM - PCC inter
C WUADJR PARM *BLANK WQ0045 1 PDM - MRP inter
C WUADJS PARM *BLANK WQ0046 1 PDM - COM inter
C WUADJT PARM *BLANK WQ0047 1 COM - MRP inter
C WUADJV PARM *BLANK WQ0048 1 COM - SA interf
C WUADJW PARM *BLANK WQ0049 1 COM - AR interf
C WUADJY PARM *BLANK WQ0050 1 AR - SA interfa
C WUADJZ PARM *BLANK WQ0051 1 PMC - PCC inter
C WUADJ1 PARM *BLANK WQ0052 1 PCC - IM interf
C WUADJ2 PARM *BLANK WQ0053 1 IM - GL interfa
C WUADJ3 PARM *BLANK WQ0054 1 COM - IM interf
C WUADJ4 PARM *BLANK WQ0055 1 MRP - IM interf
C WUADJ5 PARM *BLANK WQ0056 1 PDM - IM interf
C WUADJ6 PARM *BLANK WQ0057 1 MRP - PDM inter
C WUADJ7 PARM *BLANK WQ0058 1 PCC - GL interf
C WUADJ8 PARM *BLANK WQ0059 1 EDMI - PDM inte
C WUADJ9 PARM *BLANK WQ0060 1 FCST - MRP inte
C WUADJ0 PARM *BLANK WQ0061 1 FA - GL interfa
C WUADKA PARM *BLANK WQ0062 1 Questionnaire h
C WUADKB PARM *BLANK WQ0063 1 Yes response ch
C WUADKC PARM *BLANK WQ0064 1 No response cha
C WUACV5 PARM *BLANK WQ0065 1 Work alpha (1)
C WUADKD PARM *BLANK WQ0066 1 Mth periods def
C WUADKF PARM *BLANK WQ0067 12 Weeks per perio
C WUADKG PARM *BLANK WQ0068 1 Week beginning
C WUADKH PARM *BLANK WQ0069 6 Last file sts r
C WUADKJ PARM *BLANK WQ0070 6 Last file sts r
C WUADKK PARM *BLANK WQ0071 1 REP - GL interf
C WUADKM PARM *BLANK WQ0072 1 IFM GLI interfa
C WUADKN PARM *BLANK WQ0073 1 IFM AP interfac
C WUADKP PARM *BLANK WQ0074 1 IFM AR interfac
C *IN90 IFEQ '1'
* Call to program ended in error
C MOVEL'Y2U0032' W0RTN
C MOVEL*BLANKS W0CLPG 10
C MOVEL'AMZARUPR'W0CLPG
* Send message '*Error occured on CALL...'
C MOVEL'Y2U0032' ZAMSID
C MOVEL'Y2USRMSG'ZAMSGF
C MOVELW0CLPG ZAMSDA Message data
C EXSR ZASNMS
C SETON 99 *
C END
* Obtain system date format
C *NAMVAR DEFN Y2DTFMA XDDTFM 3
C IN XDDTFM
*================================================================
CSR ZZEXIT ENDSR
** @C01
00000000099999999990
0000000009999999999}
** @C02
000999999999999999}
0009999999999999990
** @C03
999999999999999
99999999999999R
** @C04
00000009999999999999R
000000099999999999999
 A*******************************************************************
A* MODULE NAME- AMBFMPFP *
A* DESCRIPTION- PRT:Acknowledgement Print file *
A* *
A* 5733-M79 THIS MODULE IS "RESTRICTED MATERIAL OF MAPICS, INC." *
A* (C) COPYRIGHT MAPICS, INC. 1997 *
A* LICENSED MATERIALS - PROPERTY OF MAPICS, INC. *
A* REFER TO COPYRIGHT INSTRUCTIONS FORM NUMBER G120-2083 *
A* *
A* VERSION 02/MODIFICATION 07 PTF Z *
A* DATE 09/12/01 *
A* APARS/PTFS APPLIED - SCXXXXX/Z *
A* *
A*******************************************************************
T* PRT:Acknowledgement Print file
Z* CRTPRTF
Z* PAGESIZE(66 85) OVRFLW(59) SCHEDULE(*FILEEND)
*================================================================
M* Maintenance :
*================================================================
A INDARA
*=========================================================================
A R ZAPAGHDR TEXT('Standard report header')
A SKIPB(1)
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZBKEYHDR TEXT('Internal header type')
A SKIPB(4)
*.........................................................................
* Invoice title line
A ZBABY1 40 2TEXT('Invoice title line')
* Date
A VBAA7C 6 0 69TEXT('Date (USR)')
A EDTCDE(Y)
* Page number for PRINT
A ZBABC5 4 0 79TEXT('Page number for PRINT')
A EDTCDE(3)
* Ship to alpha name 40 usr
A ZBZ9KP 40 11TEXT('Ship to alpha name 40 usr')
A SPACEB(4)
* ship to address 1 40 usr
A ZBZ9KR 40 11TEXT('ship to address 1 40 usr')
A SPACEB(1)
* Ship to Address 2 (USR)
A ZBACFD 40 11TEXT('Ship to Address 2 (USR)')
A SPACEB(1)
* Ship to address 3 40 USR
A ZBACKD 40 11TEXT('Ship to address 3 40 USR')
A SPACEB(1)
* Ship to address 4 40 USR
A ZBACKF 40 11TEXT('Ship to address 4 40 USR')
A SPACEB(1)
* Ship to address 5 40 usr
A ZBZ9KS 40 11TEXT('Ship to address 5 40 usr')
A SPACEB(1)
* Export designator
A VBBNST 1 62TEXT('Export designator')
* Currency ID
A ZBBRCD 3 70TEXT('Currency ID')
* Currency desc DRV
A ZBAAAR 15 70TEXT('Currency desc DRV')
A SPACEB(1)
* Alpha sort name 40 usr
A ZBZ9KQ 40 11TEXT('Alpha sort name 40 usr')
A SPACEB(1)
* sold to address 1 40 usr
A ZBZ9KT 40 11TEXT('sold to address 1 40 usr')
A SPACEB(1)
* Sold to Address 2 (USR)
A ZBACFG 40 11TEXT('Sold to Address 2 (USR)')
A SPACEB(1)
* Sold to address 3 40 USR
A ZBACKH 40 11TEXT('Sold to address 3 40 USR')
A SPACEB(1)
* Terms Description DRV
A ZBAAN2 25 60TEXT('Terms Description DRV')
* Sold to address 4 40 USR
A ZBACKJ 40 11TEXT('Sold to address 4 40 USR')
A SPACEB(1)
* sold to address 5 40 usr
A ZBZ9KV 40 11TEXT('sold to address 5 40 usr')
A SPACEB(1)
* Company number
A ZBAENB 2 0 6TEXT('Company number')
A EDTCDE(3)
A SPACEB(3)
* Customer number
A ZBCANB 8 0 9TEXT('Customer number')
A EDTCDE(4)
* Quote/Order number
A ZBAA9V 9 22TEXT('Quote/Order number DRV')
* Salesrep number
A ZBCHNB 5 0 39TEXT('Salesrep number')
A EDTCDE(4)
* Purchase order number
A ZBCBTX 22 49TEXT('Purchase order number')
* Purchase order revision
A ZBCHTX 7 75TEXT('Purchase order revision')
* Shipping instructions
A ZBCDTX 30 6TEXT('Shipping instructions')
A SPACEB(3)
* Blank Report field #1
A ZBACG2 1 6TEXT('Blank Report field #1')
A SPACEB(2)
* Carrier description USR
A N79 11'Carrier . :'
A SPACEB(1)
* Carrier description USR
A N79 ZBAFJ0 25 25TEXT('Carrier description USR')
* *CON (Screen constant)
A N78 11'Credit Memo'
A SPACEB(1)
* 'Hidden' internal version of Date (USR)
A 99N99 ZBAA7C 7 0 1SPACEB(1)
* 'Hidden' internal version of Export designator
A 99N99 ZBBNST 1 1SPACEB(1)
* 'Hidden' internal version of Alpha sort name
A 99N99 ZBHITX 35 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZBDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZBCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Quote/order date
A 99N99 ZBACDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Manuf due date override
A 99N99 ZBICST 1 1SPACEB(1)
* 'Hidden' internal version of Header order value
A 99N99 ZBDAVA 13 2 1SPACEB(1)
* 'Hidden' internal version of Discount percent
A 99N99 ZBDMVA 5 3 1SPACEB(1)
* 'Hidden' internal version of Request date
A 99N99 ZBD0NB 7 0 1SPACEB(1)
* 'Hidden' internal version of Ship to override code
A 99N99 ZBD9NB 1 1SPACEB(1)
* 'Hidden' internal version of Sold to override code
A 99N99 ZBD8NB 1 1SPACEB(1)
* 'Hidden' internal version of LC order value
A 99N99 ZBDCVA 13 2 1SPACEB(1)
* 'Hidden' internal version of Pro forma invoice flag
A 99N99 ZBETST 1 1SPACEB(1)
* 'Hidden' internal version of Current SA month/period
A 99N99 ZBEFNB 2 0 1SPACEB(1)
* 'Hidden' internal version of Invoice procedure code
A 99N99 ZBCNNB 1 0 1SPACEB(1)
* 'Hidden' internal version of Ship lead time
A 99N99 ZBEENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Unit price discount
A 99N99 ZBCENB 1 0 1SPACEB(1)
* 'Hidden' internal version of Current order cost
A 99N99 ZBDBVA 13 2 1SPACEB(1)
* 'Hidden' internal version of Override exchange rate
A 99N99 ZBF8VA 11 6 1SPACEB(1)
* 'Hidden' internal version of Tax override date
A 99N99 ZBEHNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Override exch rate date
A 99N99 ZBARDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Order total volume
A 99N99 ZBAOQT 10 3 1SPACEB(1)
* 'Hidden' internal version of Order total weight
A 99N99 ZBAAQT 11 3 1SPACEB(1)
* 'Hidden' internal version of Sales code
A 99N99 ZBBTCD 1 1SPACEB(1)
* 'Hidden' internal version of Header status
A 99N99 ZBFNST 2 1SPACEB(1)
* 'Hidden' internal version of Quote/acknowledgement ind
A 99N99 ZBIDST 1 1SPACEB(1)
* 'Hidden' internal version of Completion date
A 99N99 ZBAABS 7 0 1SPACEB(1)
* 'Hidden' internal version of Print item tax amount
A 99N99 ZBBFST 1 1SPACEB(1)
* 'Hidden' internal version of Print tax summary
A 99N99 ZBBGST 1 1SPACEB(1)
* 'Hidden' internal version of Page 5 Pricing?
A 99N99 ZBAAJ1 1 1SPACEB(1)
* 'Hidden' internal version of Order number reference
A 99N99 ZBAAYC 12 1SPACEB(1)
* 'Hidden' internal version of Source company
A 99N99 ZBAAYF 2 0 1SPACEB(1)
* 'Hidden' internal version of Source order type
A 99N99 ZBAAYH 1 1SPACEB(1)
* 'Hidden' internal version of Source order number
A 99N99 ZBAAYG 7 1SPACEB(1)
* 'Hidden' internal version of Manual invoice number
A 99N99 ZBABAH 6 0 1SPACEB(1)
* 'Hidden' internal version of Language code
A 99N99 ZBAKCD 3 1SPACEB(1)
* 'Hidden' internal version of Territory ID
A 99N99 ZBC0CD 2 0 1SPACEB(1)
* 'Hidden' internal version of Contract number
A 99N99 ZBD1NB 5 0 1SPACEB(1)
* 'Hidden' internal version of Contract/promo indicator
A 99N99 ZBHQST 1 1SPACEB(1)
* 'Hidden' internal version of Customer price code
A 99N99 ZBF5CD 2 1SPACEB(1)
* 'Hidden' internal version of Priority ID
A 99N99 ZBGQCD 2 1SPACEB(1)
* 'Hidden' internal version of Trade discount code
A 99N99 ZBF7CD 2 1SPACEB(1)
* 'Hidden' internal version of Terms code
A 99N99 ZBBLCD 2 1SPACEB(1)
* 'Hidden' internal version of Surcharge code
A 99N99 ZBGZCD 3 1SPACEB(1)
* 'Hidden' internal version of Backorders?
A 99N99 ZBCCNB 1 1SPACEB(1)
* 'Hidden' internal version of Partial ship
A 99N99 ZBCDNB 1 1SPACEB(1)
* 'Hidden' internal version of Shipment lead time
A 99N99 ZBCPNB 2 0 1SPACEB(1)
* 'Hidden' internal version of Invoice language format
A 99N99 ZBBDST 1 1SPACEB(1)
* 'Hidden' internal version of Print backorder quantity
A 99N99 ZBBEST 1 1SPACEB(1)
* 'Hidden' internal version of Print item tax amoun10758
A 99N99 ZBAAZX 1 1SPACEB(1)
* 'Hidden' internal version of Accept substitute?
A 99N99 ZBHUST 1 1SPACEB(1)
* 'Hidden' internal version of Credit check required
A 99N99 ZBFJST 1 1SPACEB(1)
* 'Hidden' internal version of Address format
A 99N99 ZBHYST 1 1SPACEB(1)
* 'Hidden' internal version of Commissionable percent
A 99N99 ZBAPPC 7 3 1SPACEB(1)
* 'Hidden' internal version of Purchase order required
A 99N99 ZBHZST 1 1SPACEB(1)
* 'Hidden' internal version of Automatic credit hold
A 99N99 ZBH0ST 1 1SPACEB(1)
* 'Hidden' internal version of Customer class code
A 99N99 ZBC7CD 5 1SPACEB(1)
* 'Hidden' internal version of Trade discount code 10768
A 99N99 ZBAAZY 2 1SPACEB(1)
* 'Hidden' internal version of Customer price code 10770
A 99N99 ZBAAZZ 2 1SPACEB(1)
* 'Hidden' internal version of Parent customer number
A 99N99 ZBKQNB 8 0 1SPACEB(1)
* 'Hidden' internal version of Language code 10773
A 99N99 ZBAAZ1 3 1SPACEB(1)
* 'Hidden' internal version of Secondary language code
A 99N99 ZBG0CD 3 1SPACEB(1)
* 'Hidden' internal version of Ship to number
A 99N99 ZBB9CD 8 1SPACEB(1)
* 'Hidden' internal version of Alpha sort name 13017
A 99N99 ZBABAL 35 1SPACEB(1)
* 'Hidden' internal version of Default ship to address?
A 99N99 ZBAA9L 1 1SPACEB(1)
* 'Hidden' internal version of Address code
A 99N99 ZBCUCD 5 0 1SPACEB(1)
* 'Hidden' internal version of Commission header ID
A 99N99 ZBF2CD 7 0 1SPACEB(1)
* 'Hidden' internal version of Price book ID
A 99N99 ZBGPCD 5 1SPACEB(1)
* 'Hidden' internal version of Invoice amount
A 99N99 ZBFGVA 13 2 1SPACEB(1)
* 'Hidden' internal version of Sold to override address
A 99N99 ZBHECD 5 0 1SPACEB(1)
* 'Hidden' internal version of Warehouse
A 99N99 ZBA3CD 3 1SPACEB(1)
* 'Hidden' internal version of Delivery terms code
A 99N99 ZBAAB6 3 1SPACEB(1)
* 'Hidden' internal version of Bill to Company number
A 99N99 ZBABAJ 2 0 1SPACEB(1)
* 'Hidden' internal version of Bill to Customer num13015
A 99N99 ZBABAK 8 0 1SPACEB(1)
* 'Hidden' internal version of Credit memo code
A 99N99 ZBESST 1 1SPACEB(1)
* 'Hidden' internal version of Credit/debit reason code
A 99N99 ZBF4CD 3 1SPACEB(1)
* 'Hidden' internal version of Invoice number
A 99N99 ZBGGNB 6 0 1SPACEB(1)
* 'Hidden' internal version of Invoice sequence
A 99N99 ZBHYNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Future age month
A 99N99 ZBD6NB 2 0 1SPACEB(1)
* 'Hidden' internal version of Total dollars invoiced
A 99N99 ZBD9VA 13 2 1SPACEB(1)
* 'Hidden' internal version of Age date
A 99N99 ZBAEDT 7 0 1SPACEB(1)
* 'Hidden' internal version of LC - total invoiced
A 99N99 ZBECVA 13 2 1SPACEB(1)
* 'Hidden' internal version of Create date
A 99N99 ZBALDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Create time
A 99N99 ZBABTM 6 0 1SPACEB(1)
* 'Hidden' internal version of Created by user
A 99N99 ZBAFVN 10 1SPACEB(1)
* 'Hidden' internal version of Created by program
A 99N99 ZBAGVN 10 1SPACEB(1)
* 'Hidden' internal version of Change date
A 99N99 ZBAMDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Change time
A 99N99 ZBACTM 6 0 1SPACEB(1)
* 'Hidden' internal version of Changed by user
A 99N99 ZBAHVN 10 1SPACEB(1)
* 'Hidden' internal version of Changed by program
A 99N99 ZBAIVN 10 1SPACEB(1)
*=========================================================================
A R ZCCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZCDTLRCD TEXT('Detail line.')
*.........................................................................
* 'Hidden' internal version of Warehouse
A 99N99 ZCA3CD 3 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZCDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Alpha sort name 13017
A 99N99 ZCABAL 35 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZCCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Proforma pack list print?
A 99N99 ZCACR2 1 1SPACEB(1)
* 'Hidden' internal version of Variable trade discount %
A 99N99 ZCAMPC 7 3 1SPACEB(1)
* 'Hidden' internal version of Order origin
A 99N99 ZCAD0W 1 1SPACEB(1)
* 'Hidden' internal version of Cancel after date
A 99N99 ZCAD0X 7 0 1SPACEB(1)
* 'Hidden' internal version of Offline order token
A 99N99 ZCAA74 11 0 1SPACEB(1)
* 'Hidden' internal version of Do not ship before
A 99N99 ZCAFAW 7 0 1SPACEB(1)
* 'Hidden' internal version of Installment method id
A 99N99 ZCZ9H4 10 1SPACEB(1)
* 'Hidden' internal version of Tax transaction type
A 99N99 ZCZ9H5 10 1SPACEB(1)
* 'Hidden' internal version of Note method id
A 99N99 ZCZ9H6 10 1SPACEB(1)
* 'Hidden' internal version of Interbranch trade partner
A 99N99 ZCZ9H9 10 1SPACEB(1)
* 'Hidden' internal version of Interbranch trans refer
A 99N99 ZCZ9H0 7 0 1SPACEB(1)
* 'Hidden' internal version of Amount invoice printed
A 99N99 ZCZ9JA 1 1SPACEB(1)
* 'Hidden' internal version of Invoice series id
A 99N99 ZCZ9JF 4 1SPACEB(1)
* 'Hidden' internal version of Complementary ref nbr
A 99N99 ZCZ0S1 7 0 1SPACEB(1)
* 'Hidden' internal version of Terms code
A 99N99 ZCBLCD 2 1SPACEB(1)
* 'Hidden' internal version of Ship to number
A 99N99 ZCB9CD 8 1SPACEB(1)
* 'Hidden' internal version of Sold to override address
A 99N99 ZCHECD 5 0 1SPACEB(1)
* 'Hidden' internal version of Tax suffix (key)
A 99N99 ZCBXCD 5 1SPACEB(1)
* 'Hidden' internal version of Carrier ID
A 99N99 ZCF1CD 10 1SPACEB(1)
* 'Hidden' internal version of Sale code
A 99N99 ZCBHST 1 1SPACEB(1)
*=========================================================================
A R ZDCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZDDTLRCD TEXT('Invoice comment detail')
A SPACEB(1)
*.........................................................................
* Text Line Description 75
A ZDAFD5 75 11TEXT('Text Line Description 75')
* Date Effective USR
A N79 VDACCS 6 0 11TEXT('Date Effective USR')
A EDTCDE(Y)
A SPACEB(1)
* Total Invoice Amount USR
A N79 ZDAC87 13 2 21TEXT('Total Invoice Amount USR')
A EDTCDE(J)
* Work (Alpha 2)
A N79 ZDABHW 2 11TEXT('Work (Alpha 2)')
A SPACEB(1)
* 'Hidden' internal version of Date Effective USR
A 99N99 ZDACCS 7 0 1SPACEB(1)
* 'Hidden' internal version of Company number
A 99N99 ZDAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Invoice number
A 99N99 ZDGGNB 6 0 1SPACEB(1)
* 'Hidden' internal version of Invoice sequence
A 99N99 ZDHYNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Comment line sequence no.
A 99N99 ZDKBNB 5 0 1SPACEB(1)
* 'Hidden' internal version of Language code
A 99N99 ZDAKCD 3 1SPACEB(1)
* 'Hidden' internal version of Internal print only?
A 99N99 ZDAAD9 1 1SPACEB(1)
* 'Hidden' internal version of Comment line text
A 99N99 ZDHDTX 25 1SPACEB(1)
* 'Hidden' internal version of Comment user reference
A 99N99 ZDHXCD 5 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZDDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZDCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Shipment header number
A 99N99 ZDK4NB 7 0 1SPACEB(1)
* 'Hidden' internal version of Shipment consolidate seq
A 99N99 ZDAFAD 3 0 1SPACEB(1)
* 'Hidden' internal version of Ship release sequence
A 99N99 ZDLCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Kit release sequence
A 99N99 ZDAASZ 5 0 1SPACEB(1)
* 'Hidden' internal version of Special charge sequence #
A 99N99 ZDAAD2 7 0 1SPACEB(1)
* 'Hidden' internal version of Text line print control
A 99N99 ZDAD1N 1 1SPACEB(1)
* 'Hidden' internal version of Create date
A 99N99 ZDALDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Create time
A 99N99 ZDABTM 6 0 1SPACEB(1)
* 'Hidden' internal version of Created by user
A 99N99 ZDAFVN 10 1SPACEB(1)
* 'Hidden' internal version of Created by program
A 99N99 ZDAGVN 10 1SPACEB(1)
*=========================================================================
A R ZEFINTTL TEXT('Final totals')
A SPACEB(1)
*.........................................................................
* 'Hidden' internal version of *CON (Screen constant)
A 99N99 ZECON 1 1SPACEB(1)
*=========================================================================
A R ZFCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZFDTLRCD TEXT('Detail line.')
A SPACEB(1)
A SPACEA(1)
*.........................................................................
* User entered sequence no.
A ZFKTNB 7 2TEXT('User entered sequence no.')
* Item number
A ZFAITX 15 11TEXT('Item number')
* Dimension U/M
A ZFCQCD 2 43TEXT('Dimension U/M')
* Order qty in order u/m
A ZFACQT 10 3 51TEXT('Order qty in order u/m')
A EDTCDE(J)
* Foreign description USR
A ZFABZW 30 11TEXT('Foreign description USR')
A SPACEB(1)
* Sel-prc ord u/m 15.3 USR
A ZFACK0 15 3 45TEXT('Sel-prc ord u/m 15.3 USR')
A EDTCDE(J)
* Net sales amount 14.2 USR
A ZFACRN 14 2 66TEXT('Net sales amount 14.2 USR')
A EDTCDE(J)
* Item description
A N79 ZFALTX 30 11TEXT('Item description')
A SPACEB(1)
* Ship to name USR
A N78 11'Item shipped to'
A SPACEB(1)
* Ship to name USR
A N78 ZFAA66 35 28TEXT('Ship to name USR')
* Customer item number
A N77 ZFHJTX 30 11TEXT('Customer item number')
A SPACEB(1)
* Customer/item desc. DRV
A N76 ZFAAWM 30 11TEXT('Customer/item desc. DRV')
A SPACEB(1)
* Request date (usr)
A N75 11'Request'
A SPACEB(1)
* Request date (usr)
A N75 VFAA35 6 0 19TEXT('Request date (usr)')
A EDTCDE(Y)
* Promise date (usr)
A N74 28'Ship'
* Promise date (usr)
A N74 VFAAT0 6 0 33TEXT('Promise date (usr)')
A EDTCDE(Y)
* Warehouse
A N73 11'Warehouse'
A SPACEB(1)
* Warehouse
A N73 ZFA3CD 3 21TEXT('Warehouse')
* Location in warehouse USR
A N72 28'Location'
* Location in warehouse USR
A N72 ZFABA5 7 37TEXT('Location in warehouse USR')
* Selling price - price U/M USR
A N71 ZFACRM 15 3 11TEXT('Selling price prc U/M USR')
A EDTCDE(J)
A SPACEB(1)
* Pricing unit of measure 1
A N71 ZFDGCD 2 33TEXT('Pricing unit of measure 1')
* Conversion desc (USR)
A N71 ZFABYZ 25 37TEXT('Conversion desc (USR)')
* Original item number
A N70 12'Above item substituted for'
A SPACEB(1)
* Original item number
A N70 ZFAALM 15 39TEXT('Original item number')
* 'Hidden' internal version of Request date (usr)
A 99N99 ZFAA35 7 0 1SPACEB(1)
* 'Hidden' internal version of Promise date (usr)
A 99N99 ZFAAT0 7 0 1SPACEB(1)
* 'Hidden' internal version of Company number
A 99N99 ZFAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZFDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZFCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Customer number
A 99N99 ZFCANB 8 0 1SPACEB(1)
* 'Hidden' internal version of Ship to number
A 99N99 ZFB9CD 8 1SPACEB(1)
* 'Hidden' internal version of Tax transaction typ - ord
A 99N99 ZFZ9Q7 10 1SPACEB(1)
* 'Hidden' internal version of Tax suffix (key)
A 99N99 ZFBXCD 5 1SPACEB(1)
* 'Hidden' internal version of Line item sequence
A 99N99 ZFFCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Kit item
A 99N99 ZFH2ST 1 1SPACEB(1)
* 'Hidden' internal version of Line item status
A 99N99 ZFH3ST 2 1SPACEB(1)
* 'Hidden' internal version of Stocking quantity
A 99N99 ZFFXVA 10 3 1SPACEB(1)
* 'Hidden' internal version of Credit memo code
A 99N99 ZFESST 1 1SPACEB(1)
* 'Hidden' internal version of Ship to override Cus12382
A 99N99 ZFAA9M 8 0 1SPACEB(1)
* 'Hidden' internal version of Ship to number override
A 99N99 ZFABAZ 8 1SPACEB(1)
* 'Hidden' internal version of User Field - Switch A
A 99N99 ZFUUSA 1 1SPACEB(1)
* 'Hidden' internal version of User Field - Code A
A 99N99 ZFUUCA 5 1SPACEB(1)
* 'Hidden' internal version of User Field - Code B
A 99N99 ZFUUCB 5 1SPACEB(1)
* 'Hidden' internal version of User Field - Code C
A 99N99 ZFUUCC 5 1SPACEB(1)
* 'Hidden' internal version of User Field - Quantity 1
A 99N99 ZFUUQ1 11 3 1SPACEB(1)
* 'Hidden' internal version of User Field - Amount 1
A 99N99 ZFUUA1 15 2 1SPACEB(1)
* 'Hidden' internal version of User Field - Date 1
A 99N99 ZFUUD1 7 0 1SPACEB(1)
* 'Hidden' internal version of User Field - Date 2
A 99N99 ZFAFFG 7 0 1SPACEB(1)
* 'Hidden' internal version of Carrier - SP Reserved
A 99N99 ZFAFFC 10 1SPACEB(1)
* 'Hidden' internal version of Item accounting class
A 99N99 ZFA0CD 3 1SPACEB(1)
* 'Hidden' internal version of Tax transaction type
A 99N99 ZFZ9H5 10 1SPACEB(1)
* 'Hidden' internal version of Tax class
A 99N99 ZFZ9JD 15 1SPACEB(1)
* 'Hidden' internal version of Tax include net sales -LC
A 99N99 ZFZ9QG 15 3 1SPACEB(1)
* 'Hidden' internal version of Tax include net sales
A 99N99 ZFZ9QH 15 3 1SPACEB(1)
* 'Hidden' internal version of Tax include sell prc - lc
A 99N99 ZFZ9QJ 17 7 1SPACEB(1)
* 'Hidden' internal version of Tax include sell prc
A 99N99 ZFZ9QK 17 7 1SPACEB(1)
* 'Hidden' internal version of Total shipped qty /cs
A 99N99 ZFZ901 11 3 1SPACEB(1)
* 'Hidden' internal version of Total backordered qty /cs
A 99N99 ZFZ902 11 3 1SPACEB(1)
* 'Hidden' internal version of Blanket item ind /cs
A 99N99 ZFZ903 1 1SPACEB(1)
* 'Hidden' internal version of Line item type /cs
A 99N99 ZFZ904 1 1SPACEB(1)
* 'Hidden' internal version of System sequence #
A 99N99 ZFAFVL 7 0 1SPACEB(1)
* 'Hidden' internal version of Stk to ord u/m conv
A 99N99 ZFAFVM 11 6 1SPACEB(1)
* 'Hidden' internal version of Rounding option
A 99N99 ZFFEST 1 1SPACEB(1)
* 'Hidden' internal version of Blanket release count
A 99N99 ZFAFVP 7 1 1SPACEB(1)
* 'Hidden' internal version of Open release number
A 99N99 ZFAFVS 5 0 1SPACEB(1)
* 'Hidden' internal version of Selling price in ord U/M
A 99N99 ZFDOVA 17 7 1SPACEB(1)
* 'Hidden' internal version of Net sales amount
A 99N99 ZFDPVA 15 3 1SPACEB(1)
* 'Hidden' internal version of Selling price in prc U/M
A 99N99 ZFKHVA 15 3 1SPACEB(1)
* 'Hidden' internal version of KBC item indicator
A 99N99 ZFADM1 1 1SPACEB(1)
* 'Hidden' internal version of User field-currency ID A
A 99N99 ZFZ0ZB 3 1SPACEB(1)
* 'Hidden' internal version of APC Configuration ID
A 99N99 ZFAFYT 10 1SPACEB(1)
* 'Hidden' internal version of APC Global ID
A 99N99 ZFAFYV 34 1SPACEB(1)
* 'Hidden' internal version of APC Item Code
A 99N99 ZFAFYX 1 1SPACEB(1)
* 'Hidden' internal version of APC Short Description
A 99N99 ZFAFYW 30 1SPACEB(1)
* 'Hidden' internal version of Presentation Item Descrip
A 99N99 ZFAF32 30 1SPACEB(1)
* 'Hidden' internal version of Presentation Item Number
A 99N99 ZFAF31 15 1SPACEB(1)
* 'Hidden' internal version of Backorders?
A 99N99 ZFCCNB 1 1SPACEB(1)
* 'Hidden' internal version of Partial ship
A 99N99 ZFCDNB 1 1SPACEB(1)
* 'Hidden' internal version of Total release quantity
A 99N99 ZFAF78 10 3 1SPACEB(1)
* 'Hidden' internal version of Allocated qty - stock u/m
A 99N99 ZFAF79 10 3 1SPACEB(1)
*=========================================================================
A R ZGCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZGDTLRCD TEXT('Detail line.')
A SPACEB(1)
*.........................................................................
* Option item number
A ZGHQTX 15 12TEXT('Option item number')
* Invoice language item description
A ZGB5TX 30 12TEXT('Invoice language item des')
A SPACEB(1)
* Item description
A N79 ZGALTX 30 12TEXT('Item description')
A SPACEB(1)
* 'Hidden' internal version of Company number
A 99N99 ZGAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZGDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZGCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Line item sequence
A 99N99 ZGFCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Feat/opt sequence number
A 99N99 ZGKXNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Record code
A 99N99 ZGB4CD 2 1SPACEB(1)
* 'Hidden' internal version of Last program to maint ite
A 99N99 ZGEHST 1 1SPACEB(1)
* 'Hidden' internal version of S-number
A 99N99 ZGB6TX 20 1SPACEB(1)
* 'Hidden' internal version of Option number
A 99N99 ZGCCCD 2 1SPACEB(1)
* 'Hidden' internal version of End item number
A 99N99 ZGB7TX 15 1SPACEB(1)
* 'Hidden' internal version of Operation seq (in routing
A 99N99 ZGCDCD 4 1SPACEB(1)
* 'Hidden' internal version of Component lead time adj
A 99N99 ZGDXVA 3 1 1SPACEB(1)
* 'Hidden' internal version of Feature number
A 99N99 ZGDMNB 2 0 1SPACEB(1)
* 'Hidden' internal version of Phantom option flag
A 99N99 ZGELST 1 1SPACEB(1)
* 'Hidden' internal version of User sequence
A 99N99 ZGCECD 4 1SPACEB(1)
* 'Hidden' internal version of Field A27
A 99N99 ZGCFCD 6 1SPACEB(1)
* 'Hidden' internal version of Last prog to maint OMNWU
A 99N99 ZGENST 1 1SPACEB(1)
* 'Hidden' internal version of Qty per unit - expanded
A 99N99 ZGDYVA 15 7 1SPACEB(1)
* 'Hidden' internal version of Warehouse
A 99N99 ZGA3CD 3 1SPACEB(1)
* 'Hidden' internal version of Item number
A 99N99 ZGAITX 15 1SPACEB(1)
*=========================================================================
A R ZHFINTTL TEXT('Final totals')
A SPACEB(1)
*.........................................................................
* 'Hidden' internal version of *CON (Screen constant)
A 99N99 ZHCON 1 1SPACEB(1)
*=========================================================================
A R ZIKEYHDR TEXT('Item number')
A SPACEB(1)
*.........................................................................
* *CON (Screen constant)
A 12'Consists of:'
*=========================================================================
A R ZJCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZJDTLRCD TEXT('Detail line.')
A SPACEB(1)
*.........................................................................
* Component item
A ZJGYTX 15 12TEXT('Component item')
* Unit of measure code USR
A ZJAC1T 2 43TEXT('Unit of measure code USR')
* Shipped quantity USR
A ZJABD2 10 3 51TEXT('Shipped quantity USR')
A EDTCDE(J)
* Item Description USR1
A ZJACLQ 30 12TEXT('Item Description USR1')
A SPACEB(1)
* Item description USR
A N79 ZJAAR1 30 12TEXT('Item description USR')
A SPACEB(1)
* 'Hidden' internal version of Item number
A 99N99 ZJAITX 15 1SPACEB(1)
* 'Hidden' internal version of Quantity per
A 99N99 ZJJ6NB 9 3 1SPACEB(1)
* 'Hidden' internal version of User sequence no.
A 99N99 ZJJ4NB 4 0 1SPACEB(1)
* 'Hidden' internal version of Component cost contr fact
A 99N99 ZJJ5NB 7 4 1SPACEB(1)
* 'Hidden' internal version of User Field - Switch A
A 99N99 ZJUUSA 1 1SPACEB(1)
* 'Hidden' internal version of User Field - Code A
A 99N99 ZJUUCA 5 1SPACEB(1)
* 'Hidden' internal version of User Field - Code B
A 99N99 ZJUUCB 5 1SPACEB(1)
* 'Hidden' internal version of User Field - Code C
A 99N99 ZJUUCC 5 1SPACEB(1)
* 'Hidden' internal version of User Field - Date 1
A 99N99 ZJUUD1 7 0 1SPACEB(1)
* 'Hidden' internal version of Create date
A 99N99 ZJALDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Create time
A 99N99 ZJABTM 6 0 1SPACEB(1)
* 'Hidden' internal version of Created by user
A 99N99 ZJAFVN 10 1SPACEB(1)
* 'Hidden' internal version of Created by program
A 99N99 ZJAGVN 10 1SPACEB(1)
* 'Hidden' internal version of Change date
A 99N99 ZJAMDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Change time
A 99N99 ZJACTM 6 0 1SPACEB(1)
* 'Hidden' internal version of Changed by user
A 99N99 ZJAHVN 10 1SPACEB(1)
* 'Hidden' internal version of Changed by program
A 99N99 ZJAIVN 10 1SPACEB(1)
*=========================================================================
A R ZKFINTTL TEXT('Final totals')
A SPACEB(1)
*.........................................................................
* 'Hidden' internal version of *CON (Screen constant)
A 99N99 ZKCON 1 1SPACEB(1)
*=========================================================================
A R ZLCOLHDG TEXT('Detail line headings -
A -
A ')
A SPACEB(1)
*.........................................................................
* Release number
A 13'Release'
* Release quantity - stock
A 21'Quantity'
* Latest request date
A 39'Request'
* Latest promise date
A 51'Promise'
* Manufacturing due date
A 63'Manufacturing'
* Release number
A 13'number'
A SPACEB(1)
* Latest request date
A 39'date'
* Latest promise date
A 51'date'
* Manufacturing due date
A 63'due date'
*=========================================================================
A R ZLDTLRCD TEXT('Detail line.')
A SPACEB(1)
*.........................................................................
* Release number
A ZLDRNB 5 0 13TEXT('Release number')
A EDTCDE(Z)
* Release quantity - stock
A ZLDZVA 10 3 21TEXT('Release quantity - stock')
A EDTCDE(J)
* Latest request date
A VLBJDT 6 0 39TEXT('Latest request date')
A EDTCDE(Y)
* Latest promise date
A VLBIDT 6 0 51TEXT('Latest promise date')
A EDTCDE(Y)
* Manufacturing due date
A VLAKDT 6 0 63TEXT('Manufacturing due date')
A EDTCDE(Y)
* 'Hidden' internal version of Latest request date
A 99N99 ZLBJDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Latest promise date
A 99N99 ZLBIDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Manufacturing due date
A 99N99 ZLAKDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Company number
A 99N99 ZLAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZLDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZLCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Line item sequence
A 99N99 ZLFCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Item number 11027
A 99N99 ZLAA26 15 1SPACEB(1)
* 'Hidden' internal version of Warehouse 11029
A 99N99 ZLAA27 3 1SPACEB(1)
* 'Hidden' internal version of Customer item number
A 99N99 ZLHJTX 30 1SPACEB(1)
* 'Hidden' internal version of Kit release sequence
A 99N99 ZLAASZ 5 0 1SPACEB(1)
* 'Hidden' internal version of Industry item number
A 99N99 ZLH2TX 30 1SPACEB(1)
* 'Hidden' internal version of Allocation status
A 99N99 ZLIJST 1 1SPACEB(1)
* 'Hidden' internal version of Pick list quantity
A 99N99 ZLZ93N 10 3 1SPACEB(1)
* 'Hidden' internal version of Pick list
A 99N99 ZLZ93T 7 0 1SPACEB(1)
* 'Hidden' internal version of Customer number
A 99N99 ZLCANB 8 0 1SPACEB(1)
* 'Hidden' internal version of Promise dte updted by APS
A 99N99 ZLZ08D 1 1SPACEB(1)
* 'Hidden' internal version of Mfg due dte updted by APS
A 99N99 ZLZ08F 1 1SPACEB(1)
* 'Hidden' internal version of System sequence #
A 99N99 ZLAFVL 7 0 1SPACEB(1)
* 'Hidden' internal version of Allocated qty - stock u/m
A 99N99 ZLAF79 10 3 1SPACEB(1)
* 'Hidden' internal version of Shipped qty - stock u/m
A 99N99 ZLAF70 10 3 1SPACEB(1)
*=========================================================================
A R ZMFINTTL TEXT('Final totals')
A SPACEB(2)
*.........................................................................
* 'Hidden' internal version of *CON (Screen constant)
A 99N99 ZMCON 1 1SPACEB(1)
*=========================================================================
A R ZNCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZNDTLRCD TEXT('Invoice comment detail')
A SPACEB(1)
*.........................................................................
* Text Line Description 75
A ZNAFD5 75 11TEXT('Text Line Description 75')
* 'Hidden' internal version of Company number
A 99N99 ZNAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Invoice number
A 99N99 ZNGGNB 6 0 1SPACEB(1)
* 'Hidden' internal version of Invoice sequence
A 99N99 ZNHYNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Comment line sequence no.
A 99N99 ZNKBNB 5 0 1SPACEB(1)
* 'Hidden' internal version of Language code
A 99N99 ZNAKCD 3 1SPACEB(1)
* 'Hidden' internal version of Internal print only?
A 99N99 ZNAAD9 1 1SPACEB(1)
* 'Hidden' internal version of Comment line text
A 99N99 ZNHDTX 25 1SPACEB(1)
* 'Hidden' internal version of Comment user reference
A 99N99 ZNHXCD 5 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZNDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZNCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Shipment header number
A 99N99 ZNK4NB 7 0 1SPACEB(1)
* 'Hidden' internal version of Shipment consolidate seq
A 99N99 ZNAFAD 3 0 1SPACEB(1)
* 'Hidden' internal version of Ship release sequence
A 99N99 ZNLCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Kit release sequence
A 99N99 ZNAASZ 5 0 1SPACEB(1)
* 'Hidden' internal version of Special charge sequence #
A 99N99 ZNAAD2 7 0 1SPACEB(1)
* 'Hidden' internal version of Text line print control
A 99N99 ZNAD1N 1 1SPACEB(1)
* 'Hidden' internal version of Create date
A 99N99 ZNALDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Create time
A 99N99 ZNABTM 6 0 1SPACEB(1)
* 'Hidden' internal version of Created by user
A 99N99 ZNAFVN 10 1SPACEB(1)
* 'Hidden' internal version of Created by program
A 99N99 ZNAGVN 10 1SPACEB(1)
*=========================================================================
A R ZOFINTTL TEXT('Final totals')
A SPACEB(1)
*.........................................................................
* 'Hidden' internal version of *CON (Screen constant)
A 99N99 ZOCON 1 1SPACEB(1)
*=========================================================================
A R ZPCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZPDTLRCD TEXT('Detail line.')
A SPACEB(1)
*.........................................................................
* Inv lang tax invoice text
A ZPACHJ 30 13TEXT('Inv lang tax invoice text')
* Tax amount
A ZPGYVA 13 2 46TEXT('Tax amount')
A EDTCDE(J)
* Tax invoice text
A N79 ZPACHH 30 13TEXT('Tax invoice text')
A SPACEB(1)
* 'Hidden' internal version of Company number
A 99N99 ZPAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Invoice number
A 99N99 ZPGGNB 6 0 1SPACEB(1)
* 'Hidden' internal version of Invoice sequence
A 99N99 ZPHYNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Tax group code
A 99N99 ZPACHG 3 1SPACEB(1)
* 'Hidden' internal version of Tax sequence
A 99N99 ZPAAG2 7 0 1SPACEB(1)
* 'Hidden' internal version of Tax base code
A 99N99 ZPG0ST 1 1SPACEB(1)
* 'Hidden' internal version of Compound tax uplift R4
A 99N99 ZPZ0D6 6 5 1SPACEB(1)
* 'Hidden' internal version of Line item type
A 99N99 ZPAAG3 1 1SPACEB(1)
* 'Hidden' internal version of Tax code (atr)
A 99N99 ZPZ9T1 5 1SPACEB(1)
* 'Hidden' internal version of Tax code result (atr)
A 99N99 ZPZ9VA 10 1SPACEB(1)
* 'Hidden' internal version of Tax adj for cash disc flg
A 99N99 ZPZ9T2 1 1SPACEB(1)
* 'Hidden' internal version of Tax in price - Europe
A 99N99 ZPZ9T3 1 1SPACEB(1)
* 'Hidden' internal version of Tax in price - Brazil
A 99N99 ZPZ9T4 1 1SPACEB(1)
* 'Hidden' internal version of Compound tax code
A 99N99 ZPZ9T5 5 1SPACEB(1)
* 'Hidden' internal version of Compound tax code result
A 99N99 ZPZ9VB 10 1SPACEB(1)
* 'Hidden' internal version of Tax base amt substd flg
A 99N99 ZPZ9T6 1 1SPACEB(1)
* 'Hidden' internal version of Tax rate substituted flag
A 99N99 ZPZ9T7 1 1SPACEB(1)
* 'Hidden' internal version of Tax rate
A 99N99 ZPZ9VC 6 3 1SPACEB(1)
* 'Hidden' internal version of Tax rate method
A 99N99 ZPZ9VD 1 1SPACEB(1)
* 'Hidden' internal version of Tax recovery percent
A 99N99 ZPZ9VF 6 3 1SPACEB(1)
* 'Hidden' internal version of Inc tax in cash disc flg
A 99N99 ZPZ9T8 1 1SPACEB(1)
* 'Hidden' internal version of Use tax flag
A 99N99 ZPZ9T9 1 1SPACEB(1)
* 'Hidden' internal version of EC memo tax flag
A 99N99 ZPZ9T0 1 1SPACEB(1)
* 'Hidden' internal version of Tax rate derived flag
A 99N99 ZPZ9VH 1 1SPACEB(1)
* 'Hidden' internal version of Information only tax flag
A 99N99 ZPZ9VJ 1 1SPACEB(1)
* 'Hidden' internal version of Tax is invoiced flag
A 99N99 ZPZ9VK 1 1SPACEB(1)
* 'Hidden' internal version of Tax liab/rec nature
A 99N99 ZPZ9VL 10 1SPACEB(1)
* 'Hidden' internal version of Discount inc/exp nature
A 99N99 ZPZ9VR 10 1SPACEB(1)
* 'Hidden' internal version of Write-off inc/exp nature
A 99N99 ZPZ9VS 10 1SPACEB(1)
* 'Hidden' internal version of Adjustment inc/exp nature
A 99N99 ZPZ9VT 10 1SPACEB(1)
* 'Hidden' internal version of Use/memo liab/rec nature
A 99N99 ZPZ9VV 10 1SPACEB(1)
* 'Hidden' internal version of Use/memo offset nature
A 99N99 ZPZ9VW 10 1SPACEB(1)
* 'Hidden' internal version of Non-recoverable VAT natur
A 99N99 ZPZ9VX 10 1SPACEB(1)
* 'Hidden' internal version of Tax exclusive price
A 99N99 ZPZ9VM 18 7 1SPACEB(1)
* 'Hidden' internal version of Tax inclusive price
A 99N99 ZPZ9VN 18 7 1SPACEB(1)
* 'Hidden' internal version of Original tax base amount
A 99N99 ZPZ9VP 13 2 1SPACEB(1)
* 'Hidden' internal version of Recoverable tax amount
A 99N99 ZPZ9VQ 13 2 1SPACEB(1)
* 'Hidden' internal version of Recoverable tax base amt
A 99N99 ZPZ9VY 13 2 1SPACEB(1)
* 'Hidden' internal version of Effective tax rate
A 99N99 ZPZ9VZ 6 3 1SPACEB(1)
* 'Hidden' internal version of Currency id (atr)
A 99N99 ZPZ9V1 3 1SPACEB(1)
* 'Hidden' internal version of Charge unit
A 99N99 ZPCHGU 10 1SPACEB(1)
* 'Hidden' internal version of Charge nature
A 99N99 ZPCHGN 10 1SPACEB(1)
* 'Hidden' internal version of Offset unit
A 99N99 ZPOFFU 10 1SPACEB(1)
* 'Hidden' internal version of Offset nature
A 99N99 ZPOFFN 10 1SPACEB(1)
* 'Hidden' internal version of Tax indicator
A 99N99 ZPAJCD 3 1SPACEB(1)
* 'Hidden' internal version of Tax transaction type
A 99N99 ZPZ9H5 10 1SPACEB(1)
* 'Hidden' internal version of Invoice-to/from tax suffi
A 99N99 ZPZ9WV 5 1SPACEB(1)
* 'Hidden' internal version of Ship to number
A 99N99 ZPB9CD 8 1SPACEB(1)
* 'Hidden' internal version of Ship-to/buy-from tax suff
A 99N99 ZPZ9WW 5 1SPACEB(1)
* 'Hidden' internal version of Item number
A 99N99 ZPAITX 15 1SPACEB(1)
* 'Hidden' internal version of Item tax class ID
A 99N99 ZPZ9N0 15 1SPACEB(1)
* 'Hidden' internal version of Special charge ID
A 99N99 ZPGTCD 3 1SPACEB(1)
* 'Hidden' internal version of Warehouse
A 99N99 ZPA3CD 3 1SPACEB(1)
* 'Hidden' internal version of Order quantity
A 99N99 ZPZ9WX 10 3 1SPACEB(1)
* 'Hidden' internal version of Unit of measure
A 99N99 ZPANCD 2 1SPACEB(1)
* 'Hidden' internal version of Transaction cash disc %
A 99N99 ZPZ9WY 5 2 1SPACEB(1)
* 'Hidden' internal version of Transaction cash disc amt
A 99N99 ZPZ9WZ 15 2 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZPDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZPCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Shipment header number
A 99N99 ZPK4NB 7 0 1SPACEB(1)
* 'Hidden' internal version of Ship release sequence
A 99N99 ZPLCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Kit release sequence
A 99N99 ZPAASZ 5 0 1SPACEB(1)
* 'Hidden' internal version of Shipment consolidate seq
A 99N99 ZPAFAD 3 0 1SPACEB(1)
* 'Hidden' internal version of Special charge sequence #
A 99N99 ZPAAD2 7 0 1SPACEB(1)
* 'Hidden' internal version of Original charge amount
A 99N99 ZPZ9WH 13 2 1SPACEB(1)
* 'Hidden' internal version of Tax in price calc type
A 99N99 ZPZ9ZY 1 1SPACEB(1)
* 'Hidden' internal version of Trade discount %
A 99N99 ZPAHPC 5 3 1SPACEB(1)
* 'Hidden' internal version of Transaction amount IFM
A 99N99 ZPZ9ZZ 19 7 1SPACEB(1)
*=========================================================================
A R ZQFINTTL TEXT('Final totals')
A SPACEB(1)
*.........................................................................
* 'Hidden' internal version of *CON (Screen constant)
A 99N99 ZQCON 1 1SPACEB(1)
*=========================================================================
A R ZRCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZRDTLRCD TEXT('Special charge detail')
A SPACEB(1)
A SPACEA(1)
*.........................................................................
* Foreign description
A ZRAA73 30 11TEXT('Foreign description')
* Special charge amount
A N79 ZRDDVA 13 2 67TEXT('Special charge amount')
A EDTCDE(J)
* Special charge description
A N78 ZRBXTX 30 11TEXT('Special charge descriptio')
A SPACEB(1)
* Item Reference
A ZRAD0R 30 11TEXT('Item Reference')
A SPACEB(1)
* 'Hidden' internal version of Company number
A 99N99 ZRAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Invoice number
A 99N99 ZRGGNB 6 0 1SPACEB(1)
* 'Hidden' internal version of Invoice sequence
A 99N99 ZRHYNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Special charge sequence #
A 99N99 ZRAAD2 7 0 1SPACEB(1)
* 'Hidden' internal version of Special charge ID
A 99N99 ZRGTCD 3 1SPACEB(1)
* 'Hidden' internal version of Special charge code
A 99N99 ZRBLST 1 1SPACEB(1)
* 'Hidden' internal version of LC special charge amount
A 99N99 ZRAAD4 13 2 1SPACEB(1)
* 'Hidden' internal version of Special charge cost
A 99N99 ZRDEVA 13 2 1SPACEB(1)
* 'Hidden' internal version of Tax indicator 1
A 99N99 ZRAAD6 3 1SPACEB(1)
* 'Hidden' internal version of Surcharge code 1
A 99N99 ZRAAD7 3 1SPACEB(1)
* 'Hidden' internal version of Terms discount applies
A 99N99 ZRAAD5 1 1SPACEB(1)
* 'Hidden' internal version of Surcharge detail code 1
A 99N99 ZRAAD8 3 1SPACEB(1)
* 'Hidden' internal version of Print before?
A 99N99 ZRAABT 1 1SPACEB(1)
* 'Hidden' internal version of Tax transaction type
A 99N99 ZRZ9H5 10 1SPACEB(1)
* 'Hidden' internal version of Tax class
A 99N99 ZRZ9JD 15 1SPACEB(1)
* 'Hidden' internal version of Tax include spec chrg -LC
A 99N99 ZRZ9QD 13 2 1SPACEB(1)
* 'Hidden' internal version of Tax include Spec chrg
A 99N99 ZRZ9QF 13 2 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZRDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZRCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Shipment header number
A 99N99 ZRK4NB 7 0 1SPACEB(1)
* 'Hidden' internal version of Shipment consolidate seq
A 99N99 ZRAFAD 3 0 1SPACEB(1)
* 'Hidden' internal version of Ship release sequence
A 99N99 ZRLCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Kit release sequence
A 99N99 ZRAASZ 5 0 1SPACEB(1)
*=========================================================================
A R ZSCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZSDTLRCD TEXT('Invoice comment detail')
A SPACEB(1)
*.........................................................................
* Text Line Description 75
A ZSAFD5 75 11TEXT('Text Line Description 75')
* Date Effective USR
A N79 VSACCS 6 0 11TEXT('Date Effective USR')
A EDTCDE(Y)
A SPACEB(1)
* Total Invoice Amount USR
A N79 ZSAC87 13 2 21TEXT('Total Invoice Amount USR')
A EDTCDE(J)
* Work (Alpha 2)
A N79 ZSABHW 2 11TEXT('Work (Alpha 2)')
A SPACEB(1)
* 'Hidden' internal version of Company number
A 99N99 ZSAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Invoice number
A 99N99 ZSGGNB 6 0 1SPACEB(1)
* 'Hidden' internal version of Invoice sequence
A 99N99 ZSHYNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Comment line sequence no.
A 99N99 ZSKBNB 5 0 1SPACEB(1)
* 'Hidden' internal version of Language code
A 99N99 ZSAKCD 3 1SPACEB(1)
* 'Hidden' internal version of Internal print only?
A 99N99 ZSAAD9 1 1SPACEB(1)
* 'Hidden' internal version of Comment line text
A 99N99 ZSHDTX 25 1SPACEB(1)
* 'Hidden' internal version of Comment user reference
A 99N99 ZSHXCD 5 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZSDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZSCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Shipment header number
A 99N99 ZSK4NB 7 0 1SPACEB(1)
* 'Hidden' internal version of Shipment consolidate seq
A 99N99 ZSAFAD 3 0 1SPACEB(1)
* 'Hidden' internal version of Ship release sequence
A 99N99 ZSLCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Kit release sequence
A 99N99 ZSAASZ 5 0 1SPACEB(1)
* 'Hidden' internal version of Special charge sequence #
A 99N99 ZSAAD2 7 0 1SPACEB(1)
* 'Hidden' internal version of Text line print control
A 99N99 ZSAD1N 1 1SPACEB(1)
* 'Hidden' internal version of Create date
A 99N99 ZSALDT 7 0 1SPACEB(1)
* 'Hidden' internal version of Create time
A 99N99 ZSABTM 6 0 1SPACEB(1)
* 'Hidden' internal version of Created by user
A 99N99 ZSAFVN 10 1SPACEB(1)
* 'Hidden' internal version of Created by program
A 99N99 ZSAGVN 10 1SPACEB(1)
* 'Hidden' internal version of Date Effective USR
A 99N99 ZSACCS 7 0 1SPACEB(1)
*=========================================================================
A R ZTFINTTL TEXT('Final totals')
A SPACEB(1)
*.........................................................................
* 'Hidden' internal version of *CON (Screen constant)
A 99N99 ZTCON 1 1SPACEB(1)
*=========================================================================
A R ZUCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZUDTLRCD TEXT('Detail line.')
A SPACEB(1)
*.........................................................................
* Inv lang tax invoice text
A ZUACHJ 30 12TEXT('Inv lang tax invoice text')
* Tax amount
A ZUGYVA 13 2 46TEXT('Tax amount')
A EDTCDE(J)
* Tax invoice text
A N79 ZUACHH 30 12TEXT('Tax invoice text')
A SPACEB(1)
* 'Hidden' internal version of Company number
A 99N99 ZUAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Invoice number
A 99N99 ZUGGNB 6 0 1SPACEB(1)
* 'Hidden' internal version of Invoice sequence
A 99N99 ZUHYNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Tax group code
A 99N99 ZUACHG 3 1SPACEB(1)
* 'Hidden' internal version of Tax sequence
A 99N99 ZUAAG2 7 0 1SPACEB(1)
* 'Hidden' internal version of Tax base code
A 99N99 ZUG0ST 1 1SPACEB(1)
* 'Hidden' internal version of Compound tax uplift R4
A 99N99 ZUZ0D6 6 5 1SPACEB(1)
* 'Hidden' internal version of Tax code (atr)
A 99N99 ZUZ9T1 5 1SPACEB(1)
* 'Hidden' internal version of Tax code result (atr)
A 99N99 ZUZ9VA 10 1SPACEB(1)
* 'Hidden' internal version of Tax adj for cash disc flg
A 99N99 ZUZ9T2 1 1SPACEB(1)
* 'Hidden' internal version of Tax in price - Europe
A 99N99 ZUZ9T3 1 1SPACEB(1)
* 'Hidden' internal version of Tax in price - Brazil
A 99N99 ZUZ9T4 1 1SPACEB(1)
* 'Hidden' internal version of Compound tax code
A 99N99 ZUZ9T5 5 1SPACEB(1)
* 'Hidden' internal version of Compound tax code result
A 99N99 ZUZ9VB 10 1SPACEB(1)
* 'Hidden' internal version of Tax base amt substd flg
A 99N99 ZUZ9T6 1 1SPACEB(1)
* 'Hidden' internal version of Tax rate substituted flag
A 99N99 ZUZ9T7 1 1SPACEB(1)
* 'Hidden' internal version of Tax rate
A 99N99 ZUZ9VC 6 3 1SPACEB(1)
* 'Hidden' internal version of Tax rate method
A 99N99 ZUZ9VD 1 1SPACEB(1)
* 'Hidden' internal version of Tax recovery percent
A 99N99 ZUZ9VF 6 3 1SPACEB(1)
* 'Hidden' internal version of Inc tax in cash disc flg
A 99N99 ZUZ9T8 1 1SPACEB(1)
* 'Hidden' internal version of Use tax flag
A 99N99 ZUZ9T9 1 1SPACEB(1)
* 'Hidden' internal version of EC memo tax flag
A 99N99 ZUZ9T0 1 1SPACEB(1)
* 'Hidden' internal version of Tax rate derived flag
A 99N99 ZUZ9VH 1 1SPACEB(1)
* 'Hidden' internal version of Information only tax flag
A 99N99 ZUZ9VJ 1 1SPACEB(1)
* 'Hidden' internal version of Tax is invoiced flag
A 99N99 ZUZ9VK 1 1SPACEB(1)
* 'Hidden' internal version of Tax liab/rec nature
A 99N99 ZUZ9VL 10 1SPACEB(1)
* 'Hidden' internal version of Discount inc/exp nature
A 99N99 ZUZ9VR 10 1SPACEB(1)
* 'Hidden' internal version of Write-off inc/exp nature
A 99N99 ZUZ9VS 10 1SPACEB(1)
* 'Hidden' internal version of Adjustment inc/exp nature
A 99N99 ZUZ9VT 10 1SPACEB(1)
* 'Hidden' internal version of Use/memo liab/rec nature
A 99N99 ZUZ9VV 10 1SPACEB(1)
* 'Hidden' internal version of Use/memo offset nature
A 99N99 ZUZ9VW 10 1SPACEB(1)
* 'Hidden' internal version of Non-recoverable VAT natur
A 99N99 ZUZ9VX 10 1SPACEB(1)
* 'Hidden' internal version of Tax exclusive price
A 99N99 ZUZ9VM 18 7 1SPACEB(1)
* 'Hidden' internal version of Tax inclusive price
A 99N99 ZUZ9VN 18 7 1SPACEB(1)
* 'Hidden' internal version of Original tax base amount
A 99N99 ZUZ9VP 13 2 1SPACEB(1)
* 'Hidden' internal version of Recoverable tax amount
A 99N99 ZUZ9VQ 13 2 1SPACEB(1)
* 'Hidden' internal version of Recoverable tax base amt
A 99N99 ZUZ9VY 13 2 1SPACEB(1)
* 'Hidden' internal version of Effective tax rate
A 99N99 ZUZ9VZ 6 3 1SPACEB(1)
* 'Hidden' internal version of Currency id (atr)
A 99N99 ZUZ9V1 3 1SPACEB(1)
* 'Hidden' internal version of Charge unit
A 99N99 ZUCHGU 10 1SPACEB(1)
* 'Hidden' internal version of Charge nature
A 99N99 ZUCHGN 10 1SPACEB(1)
* 'Hidden' internal version of Offset unit
A 99N99 ZUOFFU 10 1SPACEB(1)
* 'Hidden' internal version of Offset nature
A 99N99 ZUOFFN 10 1SPACEB(1)
* 'Hidden' internal version of Tax indicator
A 99N99 ZUAJCD 3 1SPACEB(1)
* 'Hidden' internal version of Tax transaction type
A 99N99 ZUZ9H5 10 1SPACEB(1)
* 'Hidden' internal version of Invoice-to/from tax suffi
A 99N99 ZUZ9WV 5 1SPACEB(1)
* 'Hidden' internal version of Ship to number
A 99N99 ZUB9CD 8 1SPACEB(1)
* 'Hidden' internal version of Ship-to/buy-from tax suff
A 99N99 ZUZ9WW 5 1SPACEB(1)
* 'Hidden' internal version of Item number
A 99N99 ZUAITX 15 1SPACEB(1)
* 'Hidden' internal version of Item tax class ID
A 99N99 ZUZ9N0 15 1SPACEB(1)
* 'Hidden' internal version of Special charge ID
A 99N99 ZUGTCD 3 1SPACEB(1)
* 'Hidden' internal version of Warehouse
A 99N99 ZUA3CD 3 1SPACEB(1)
* 'Hidden' internal version of Order quantity
A 99N99 ZUZ9WX 10 3 1SPACEB(1)
* 'Hidden' internal version of Unit of measure
A 99N99 ZUANCD 2 1SPACEB(1)
* 'Hidden' internal version of Transaction cash disc %
A 99N99 ZUZ9WY 5 2 1SPACEB(1)
* 'Hidden' internal version of Transaction cash disc amt
A 99N99 ZUZ9WZ 15 2 1SPACEB(1)
* 'Hidden' internal version of Line item type
A 99N99 ZUAAG3 1 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZUDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZUCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Shipment header number
A 99N99 ZUK4NB 7 0 1SPACEB(1)
* 'Hidden' internal version of Ship release sequence
A 99N99 ZULCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Kit release sequence
A 99N99 ZUAASZ 5 0 1SPACEB(1)
* 'Hidden' internal version of Shipment consolidate seq
A 99N99 ZUAFAD 3 0 1SPACEB(1)
* 'Hidden' internal version of Special charge sequence #
A 99N99 ZUAAD2 7 0 1SPACEB(1)
* 'Hidden' internal version of Original charge amount
A 99N99 ZUZ9WH 13 2 1SPACEB(1)
* 'Hidden' internal version of Tax in price calc type
A 99N99 ZUZ9ZY 1 1SPACEB(1)
* 'Hidden' internal version of Trade discount %
A 99N99 ZUAHPC 5 3 1SPACEB(1)
* 'Hidden' internal version of Transaction amount IFM
A 99N99 ZUZ9ZZ 19 7 1SPACEB(1)
*=========================================================================
A R ZVFINTTL TEXT('Final totals')
A SPACEB(1)
*.........................................................................
* 'Hidden' internal version of *CON (Screen constant)
A 99N99 ZVCON 1 1SPACEB(1)
*=========================================================================
A R ZWKEYHDR TEXT('Company number')
A SPACEB(1)
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZXCOLHDG TEXT('Detail line headings -
A -
A ')
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================
A R ZXDTLRCD TEXT('Detail line.')
A SPACEB(1)
*.........................................................................
* Inv lang tax invoice text
A ZXACHJ 30 11TEXT('Inv lang tax invoice text')
* Tax amount
A ZXGYVA 13 2 67TEXT('Tax amount')
A EDTCDE(J)
* Tax invoice text
A N79 ZXACHH 30 11TEXT('Tax invoice text')
A SPACEB(1)
* 'Hidden' internal version of Company number
A 99N99 ZXAENB 2 0 1SPACEB(1)
* 'Hidden' internal version of Invoice number
A 99N99 ZXGGNB 6 0 1SPACEB(1)
* 'Hidden' internal version of Invoice sequence
A 99N99 ZXHYNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Tax group code
A 99N99 ZXACHG 3 1SPACEB(1)
* 'Hidden' internal version of Tax sequence
A 99N99 ZXAAG2 7 0 1SPACEB(1)
* 'Hidden' internal version of Tax base code
A 99N99 ZXG0ST 1 1SPACEB(1)
* 'Hidden' internal version of Compound tax uplift R4
A 99N99 ZXZ0D6 6 5 1SPACEB(1)
* 'Hidden' internal version of Tax code (atr)
A 99N99 ZXZ9T1 5 1SPACEB(1)
* 'Hidden' internal version of Tax code result (atr)
A 99N99 ZXZ9VA 10 1SPACEB(1)
* 'Hidden' internal version of Tax adj for cash disc flg
A 99N99 ZXZ9T2 1 1SPACEB(1)
* 'Hidden' internal version of Tax in price - Europe
A 99N99 ZXZ9T3 1 1SPACEB(1)
* 'Hidden' internal version of Tax in price - Brazil
A 99N99 ZXZ9T4 1 1SPACEB(1)
* 'Hidden' internal version of Compound tax code
A 99N99 ZXZ9T5 5 1SPACEB(1)
* 'Hidden' internal version of Compound tax code result
A 99N99 ZXZ9VB 10 1SPACEB(1)
* 'Hidden' internal version of Tax base amt substd flg
A 99N99 ZXZ9T6 1 1SPACEB(1)
* 'Hidden' internal version of Tax rate substituted flag
A 99N99 ZXZ9T7 1 1SPACEB(1)
* 'Hidden' internal version of Tax rate
A 99N99 ZXZ9VC 6 3 1SPACEB(1)
* 'Hidden' internal version of Tax rate method
A 99N99 ZXZ9VD 1 1SPACEB(1)
* 'Hidden' internal version of Tax recovery percent
A 99N99 ZXZ9VF 6 3 1SPACEB(1)
* 'Hidden' internal version of Inc tax in cash disc flg
A 99N99 ZXZ9T8 1 1SPACEB(1)
* 'Hidden' internal version of Use tax flag
A 99N99 ZXZ9T9 1 1SPACEB(1)
* 'Hidden' internal version of EC memo tax flag
A 99N99 ZXZ9T0 1 1SPACEB(1)
* 'Hidden' internal version of Tax rate derived flag
A 99N99 ZXZ9VH 1 1SPACEB(1)
* 'Hidden' internal version of Information only tax flag
A 99N99 ZXZ9VJ 1 1SPACEB(1)
* 'Hidden' internal version of Tax is invoiced flag
A 99N99 ZXZ9VK 1 1SPACEB(1)
* 'Hidden' internal version of Tax liab/rec nature
A 99N99 ZXZ9VL 10 1SPACEB(1)
* 'Hidden' internal version of Discount inc/exp nature
A 99N99 ZXZ9VR 10 1SPACEB(1)
* 'Hidden' internal version of Write-off inc/exp nature
A 99N99 ZXZ9VS 10 1SPACEB(1)
* 'Hidden' internal version of Adjustment inc/exp nature
A 99N99 ZXZ9VT 10 1SPACEB(1)
* 'Hidden' internal version of Use/memo liab/rec nature
A 99N99 ZXZ9VV 10 1SPACEB(1)
* 'Hidden' internal version of Use/memo offset nature
A 99N99 ZXZ9VW 10 1SPACEB(1)
* 'Hidden' internal version of Non-recoverable VAT natur
A 99N99 ZXZ9VX 10 1SPACEB(1)
* 'Hidden' internal version of Tax exclusive price
A 99N99 ZXZ9VM 18 7 1SPACEB(1)
* 'Hidden' internal version of Tax inclusive price
A 99N99 ZXZ9VN 18 7 1SPACEB(1)
* 'Hidden' internal version of Original tax base amount
A 99N99 ZXZ9VP 13 2 1SPACEB(1)
* 'Hidden' internal version of Recoverable tax amount
A 99N99 ZXZ9VQ 13 2 1SPACEB(1)
* 'Hidden' internal version of Recoverable tax base amt
A 99N99 ZXZ9VY 13 2 1SPACEB(1)
* 'Hidden' internal version of Effective tax rate
A 99N99 ZXZ9VZ 6 3 1SPACEB(1)
* 'Hidden' internal version of Currency id (atr)
A 99N99 ZXZ9V1 3 1SPACEB(1)
* 'Hidden' internal version of Charge unit
A 99N99 ZXCHGU 10 1SPACEB(1)
* 'Hidden' internal version of Charge nature
A 99N99 ZXCHGN 10 1SPACEB(1)
* 'Hidden' internal version of Offset unit
A 99N99 ZXOFFU 10 1SPACEB(1)
* 'Hidden' internal version of Offset nature
A 99N99 ZXOFFN 10 1SPACEB(1)
* 'Hidden' internal version of Tax indicator
A 99N99 ZXAJCD 3 1SPACEB(1)
* 'Hidden' internal version of Tax transaction type
A 99N99 ZXZ9H5 10 1SPACEB(1)
* 'Hidden' internal version of Invoice-to/from tax suffi
A 99N99 ZXZ9WV 5 1SPACEB(1)
* 'Hidden' internal version of Ship to number
A 99N99 ZXB9CD 8 1SPACEB(1)
* 'Hidden' internal version of Ship-to/buy-from tax suff
A 99N99 ZXZ9WW 5 1SPACEB(1)
* 'Hidden' internal version of Item number
A 99N99 ZXAITX 15 1SPACEB(1)
* 'Hidden' internal version of Item tax class ID
A 99N99 ZXZ9N0 15 1SPACEB(1)
* 'Hidden' internal version of Special charge ID
A 99N99 ZXGTCD 3 1SPACEB(1)
* 'Hidden' internal version of Warehouse
A 99N99 ZXA3CD 3 1SPACEB(1)
* 'Hidden' internal version of Order quantity
A 99N99 ZXZ9WX 10 3 1SPACEB(1)
* 'Hidden' internal version of Unit of measure
A 99N99 ZXANCD 2 1SPACEB(1)
* 'Hidden' internal version of Transaction cash disc %
A 99N99 ZXZ9WY 5 2 1SPACEB(1)
* 'Hidden' internal version of Transaction cash disc amt
A 99N99 ZXZ9WZ 15 2 1SPACEB(1)
* 'Hidden' internal version of Line item type
A 99N99 ZXAAG3 1 1SPACEB(1)
* 'Hidden' internal version of Internal header type
A 99N99 ZXDCCD 1 1SPACEB(1)
* 'Hidden' internal version of Quote/order number
A 99N99 ZXCVNB 7 1SPACEB(1)
* 'Hidden' internal version of Shipment header number
A 99N99 ZXK4NB 7 0 1SPACEB(1)
* 'Hidden' internal version of Ship release sequence
A 99N99 ZXLCNB 7 0 1SPACEB(1)
* 'Hidden' internal version of Kit release sequence
A 99N99 ZXAASZ 5 0 1SPACEB(1)
* 'Hidden' internal version of Shipment consolidate seq
A 99N99 ZXAFAD 3 0 1SPACEB(1)
* 'Hidden' internal version of Special charge sequence #
A 99N99 ZXAAD2 7 0 1SPACEB(1)
* 'Hidden' internal version of Original charge amount
A 99N99 ZXZ9WH 13 2 1SPACEB(1)
* 'Hidden' internal version of Tax in price calc type
A 99N99 ZXZ9ZY 1 1SPACEB(1)
* 'Hidden' internal version of Trade discount %
A 99N99 ZXAHPC 5 3 1SPACEB(1)
* 'Hidden' internal version of Transaction amount IFM
A 99N99 ZXZ9ZZ 19 7 1SPACEB(1)
*=========================================================================
A R YAFINTTL TEXT('Final totals')
A SKIPB(62)
*.........................................................................
* Net sales amount 15.2 USR
A YAAB1X 15 2 15TEXT('Net sales amount 15.2 USR')
A EDTCDE(J)
* Trade discount 15.2 USR
A YAAB1Y 15 2 51TEXT('Trade discount 15.2 USR')
A EDTCDE(J)
* Total misc 15.2 USR
A YAAB11 15 2 15TEXT('Total misc 15.2 USR')
A EDTCDE(J)
A SPACEB(1)
* Discount allowed 15.2 USR
A YAAB13 15 2 51TEXT('Discount allowed 15.2 USR')
A EDTCDE(J)
* Total freight 15.2 USR
A YAAB12 15 2 15TEXT('Total freight 15.2 USR')
A EDTCDE(J)
A SPACEB(1)
* Currency ID (usr)
A N79 YAAAM5 3 40TEXT('Currency ID (usr)')
* Alternate total USR
A N79 44'Total:'
* Alternate total USR
A N79 YAZ04L 15 2 51TEXT('Alternate total USR')
A EDTCDE(J)
* Total taxes 15.2 USR
A YAAB1Z 15 2 15TEXT('Total taxes 15.2 USR')
A EDTCDE(J)
A SPACEB(1)
* Pay this amount 15.2 USR
A YAAB14 15 2 64TEXT('Pay this amount 15.2 USR')
A EDTCDE(J)
* 'Hidden' internal version of *CON (Screen constant)
A 99N99 YACON 1 1SPACEB(1)
*=========================================================================
A R YBENDRPT TEXT('End of report')
A SPACEB(1)
*.........................................................................
* Dummy field to keep format
A 99N99 1' '
*=========================================================================


As an Amazon Associate we earn from qualifying purchases.

This thread ...
Follow-Ups:
Replies:
Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.