Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / message / unitrep.src < prev

Wrap

Text File | 1988-05-03 | 447.4 KB | 12,945 lines

-------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : UNITREP Software Model -- Version : -- Contact : Lt. Colonel Falgiano -- : ESD/SCW -- : Hanscom AFB, MA 01731 -- Author : SAIC COMSYSTEMS Division -- : 2815 Camino del Rio South -- : San Diego, CA 92108 -- DDN Address : -- Copyright : (c) 1984 SAIC COMSYSTEMS -- Date created : -- Release date : September 30, 1984 -- Last update : -- -* --------------------------------------------------------------- -- -* -- Keywords : ----------------: -- -- Abstract : UNITREP consists of four subsystems: Message ----------------: Input and Validation (MIV), Database Manage- ----------------: ment (DBM), Man/Machine Interface (MMI), and ----------------: Systems Utilities (SYS). DBM interfaces to ----------------: an Intelligent Database Machine (IDM) back ----------------: end relational database processor. The ----------------: UNITREP database stores validated UNITREP ----------------: messages from all organizations and units in ----------------: the United States armed forces and some ----------------: foreign forces under U.S. control. ----------------: ----------------: This tool was developed as a precursor for ----------------: the WMCCS Information System (WIS). An ----------------: executable version of the tool has been ----------------: demonstrated. This source code has sub- ----------------: sequently been recompiled but has not under- ----------------: gone extensive testing. ----------------: -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- 10/30/84 1.0 SAIC Initial Release -- -* ------------------ Distribution and Copyright ----------------- -- -* -- This prologue must be included in all copies of this software. -- -- This software is copyright by the author. -- -- This software is released to the Ada community. -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- Restrictions on use or distribution: NONE -- -* ----------------- Disclaimer ---------------------------------- -- -* -- This software and its documentation are provided "AS IS" and -- without any expressed or implied warranties whatsoever. -- -- No warranties as to performance, merchantability, or fitness -- for a particular purpose exist. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- In no event shall any person or organization of people be -- held responsible for any direct, indirect, consequential -- or inconsequential damages or lost profits. -- -* ----------------- END-PROLOGUE ------------------------------- --:::::::::: --unitrepsr.dis --:::::::::: -- UNITREP source files in compilation order follow: idmdefs.src msgtypes.src sys.src idmio.src mmi.src msginput.src msgvalid.src dbb.src modcoms.src main.src --:::::::::: --idmdefs.src --:::::::::: package idm_defs is subtype commbuf is string(1..4000); type buffer_link is access commbuf; type param_value_block is record size : integer range 1..257; token : integer; value : string(1..256); end record; type param_value_link is access param_value_block; type param_var_value is record size : integer range 1..257; token : integer; len : integer; value : string(1..255); end record; type param_name_block; type param_name_link is access param_name_block; type param_name_block is record succ : param_name_link; value : param_value_link; size : integer range 1..12; name : string(1..12); end record; type col_desc is record name : string(1..12); namlen : integer range 0..12; format : integer; index : integer range 0..4000; end record; type col_desc_array is array(1..255) of col_desc; type col_desc_link is access col_desc_array; type idm_data_type is (idm_int1, idm_int2, idm_int4, idm_flt4, idm_flt8, idm_char, idm_fchar, idm_bcd, idm_fbcd, idm_bcdflt, idm_fbcdflt, idm_binary, idm_fbinary); type idm_exception is (badparm_err, bindtype_err, done_err, donecmds_err, getitm_err, moredata_err, no_err, nocmds_err, nodbopen_err, notexec_err, query_err, parse_err, sync_err, targend_err, targnum_err, truncate_err, tupend_err, data_err, device_err, end_err, storage_err); type idm_status_type is (statdata, statdcnt, statdint, staterrno, staterrstr, statnerr, statrc); type idmrun_type is record ftchan : integer := 0; dbin : integer := 0; fgeor : boolean := true; lnbuffer : buffer_link := null; inbufnxt : integer range 1..4001 := 1; inbuflst : integer range 0..4000 := 0; fgxact : boolean := false; fgexec : boolean := false; fgfetch : boolean := false; fgfchxpt : boolean := false; exresult : idm_exception := no_err; stcmdnam : string(1..12); ctcmdnam : integer range 0..12 := 0; lnparams : param_name_link := null; ctparams : integer := 0; lncols : col_desc_link := null; ctcols : integer range 0..255 := 0; end record; badparm_error : exception; bindtype_error : exception; done_error : exception; donecmds_error : exception; getitm_error : exception; moredata_error : exception; nocmds_error : exception; nodbopen_error : exception; notexec_error : exception; query_error : exception; parse_error : exception; sync_error : exception; targend_error : exception; targnum_error : exception; truncate_error : exception; tupend_error : exception; end idm_defs; --:::::::::: --msgtypes.src --:::::::::: package MSG_Types is type Department_Types is (W,F,M,N,E,D,X,Z); type Uic2_Department_Types is (C,D,E,G,H,K,L,N,R,S); type Coaff_Types is (AC, AF, AG, AL, AN, AO, AQ, AR, AS, AU, AV, AY, BA, BB, BC, BD, BE, BF, BG, BH ,BL, BM, BP, BQ, BR, BT, BU, BV, BX, BY, BZ, CA, CB, CD, CE, CF, CG, CH, CI, CJ, CK, CL, CM, CN, CO, CQ, CS, CT, CU, CV, CW, CY, CZ, DA, DJ, DM, DR, EC, EG, EI, EK, EQ, ES, ET, FA, FG, FI, FJ, FO, FP, FR, FS, FT, GA, GB, GC, GE, GH, GI, GJ, GL, GP, GQ, GR, GT, GV, GY, GZ, HA, HK, HM, HO, HU, IC, ID, IO, IQ, IR, IT, IV, IY, IZ, JA, JM, JO, JQ, JS, KE, KN, KR, KS, KT, KU, LA, LE, LI, LS, LT, LU, LY, MA, MB, MC, MG, MH, MI, ML, MN, MO, MP, MQ, MR, MT, MU, MV, MX, MY, MZ, NA, NC, NE, NF, NG, NH, NI, NL, NO, NP, NQ, NR, NS, NU, NZ, PA, PC, PE, PF, PG, PK, PL, PM, PO, PP, PQ, PU, QA, RE, RO, RP, RQ, RW, SA, SB, SC, SE, SF, SG, SH, SL, SM, SN, SO, SP, SQ, ST, SU, SW, SY, SZ, TC, TD, TH, TK, TL, TN, TO, TP, TQ, TS, TU, TV, TW, TZ, UG, UK, UN, UR, US, UV, UY, VC, VE, VI, VM, VQ, VT, WA, WF, WI, WQ, WS, WZ, YE, YO, YS, ZA, ZI); -- COUNTRY/INTERNATIONAL AFFILIATION -- SPECIAL CHECK FOR Coaff_Types "DO", "IN", "IS" type Udc_Types is (A,B,C,D,E,F,T,U,V,W,X,Y,Z, G,H,L,N,J,K,P,Q,R,S); -- UNIT DESCRIPTOR CODE -- SPECIAL CHECK FOR Udc_Types "1" "3" "5" "7" "9" "2" "4" -- "6" "8" "0" type Ulc_Types is (A ,ACD,ACT,ADM,AF ,AFY,AGP,AGY,ANX, AP ,AR ,ARS,AST,AUG,B ,BAS,BD ,BDE, BKS,BLT,BN ,BND,BR ,BSN,BT ,BTY,CAY, CEC,CEP,CGC,CGE,CLN,CMD,CMN,CMP,CO , CPS,CRW,CTP,CTR,DAY,DEP,DET,DIR,DIV, DMB,DMF,DML,DMM,DMP,DMR,DMT,DMU,DSP, DST,DTL,ELE,FAC,FAR,FLO,FLT,FMF,FTR, FT ,GAR,GRP,HBD,HHB,HHC,HHD,HHS,HHT, HM ,HMC,HQ ,HQC,HQD,HQS,HSB,HSC,HSP, INS,ISP,IST,LAB,LIB,MAA,MAB,MAF,MAG, MAU,MAW,MER,MGR,MGZ,MIS,MSC,MSF,MTF, MUS,NSC,NSL,OBS,OFC,OFF,OIC,OL , PKG,PKT,PLN,PLT,PO ,PRT,PTY,PVG,RCT, REP,RES,RGN,RGT,RLT,RNG,SCH,SCM,SCO, SCT,SEC,SHP,SIP,SQ ,SQD,SS ,SST,STA, STF,STP,STR,SU ,SUP,SVC,SYD,SYS,TE , TF ,TG ,TM ,TML,TRN,TRP,TU ,U ,USS, WG ,WKS); -- UNIT LEVEL CODE -- SPECIAL CHECK FOR Ulc_Types "FOR" type Major_Types is (X); -- MAJOR UNIT INDICATOR type Reval_Types is (G,R,X); -- REGISTRATION VALIDATION type Cserv_Types is (C,D,A,N,F,M,E,J); -- CINC/SERVICE COMMAND CODE -- SPECIAL Cserv_Types "1" "2" "3" "4" "5" "6" "7" "8" "9" type Activ_Types is (AC,CW,DE,ED,ER,NP,PD,PH,PK,PL,PS, RD,UM,UN,XX,AN,AS,CA,CD,CJ,CM,CS, DA,DR,FP,FR,GF,IP,LD,LE,ON,OP, PC,PM,PO,PA,PV,PW,RC,RE,RF,RO,RR, SM,SR,CR,CV,MA,OH,RA,RX,DS,FO,OE, OT,SD,TE,TO,BT,NA,RT,TA,TB,TR,TS, TU,TW,AD,AU,EX,GW,MR); -- CURRENT STATUS AND ACTIVITY CODE -- SPECIAL CHECK FOR Activ_Types "IN" type Flag_Types is (X); -- ORGANIC ORGANIZATION ESTABLISHED type Cbcom_Types is (A,B,E,K,N,P,T); -- COMBINED COMMAND CODE type Dfcon_Types is (N,T,V,S,R,G); -- DEFCON STATUS -- SPECIAL CHECK FOR Dfcon_Types "5" "4" "3" "2" "1" type Nucin_Types is (X); -- NUCLEAR CAPABILITY INDICATOR CODE type Media_Types is (C,L,M,T); -- SYSTEM NOTIFICATION MEDIA type Tadc_Types is (X); -- TELECOMMUNICATIONS ADDRESS DIRECTORY CODE type Tpers_Types is (CS,CQ,CP,AC,NC,MC,FC,EC,AW,NW,MW, FW,EW,AE,NE,ME,FE,EE,ZA,ZE,ZC,RC, RE,RW,AK,NK,MK,FK,EK,AX,NX,MX,FX, EX,NT,MT,FT,ET,AM,NM,MM,FM,EM,AI, NI,MI,FI,EI,AD,ND,MD,FD,ED,AH,NH, MH,FH,EH,AL,NL,ML,FL,EL,ZZ); -- TYPE OF PERSONNEL -- SPECIAL CHECK FOR Tpers_Types "AT" type Cceby_Types is (X); -- CUMULATIVE CASUALTIES/ENEMY PW EDIT type Tread_Types is (JCRR1,POMCS); -- TYPE OF READINESS type Reasn_Types is (P,S,R,T,M,N,X); -- OVERALL REASON ORGANIZATION NOT FULLY COMBAT READY type Prres_Types is (P01,P02,P03,P04,P05,P06,P07,P08,P09, P10,P11,P12,P13,P14,P15,P16,P17,P18, P19,P20,P21,P22,P23,P24,P25,P26,P27, P28,P29,P30,P31,P32,P33,P34,P35,P36, P37,P38,P39,P40,P41,P42,P43,P44,P45, P46,P47,P48,P49,P50,P51,P52,P53,P54, P55,P56,P57,P58,P59,P60,P61,P62,P63, P64,P65,P66,P67,P68,P69,P70,P71,P72, P73,P74,P75,P76,P77,P78,P79,P80,PUP, S01,S02,S03,S04,S05,S06,S07,S08,S09, S10,S11,S12,S13,S14,S15,S16,S17,S18, S19,S20,S21,S22,S23,S24,S25,S26,S27, S28,S29,S30,S31,S32,S33,S34,S35,S36, S37,S38,S39,S40,S41,S42,S43,S44,S45, S46,S47,S48,S49,S50,S51,S52,S53,S54, S55,S56,S57,S58,S59,S60,S61,S62,S63, S64,S65,S66,S67,S68,S69,S70,S71,S72, S73,S74,S75,S76,S77,S78,S79,S80,S81, S82,S83,S84,S85,S86,S87,S88,S89,S90, S91,S92,S93,S94,S95,S96,S97,S98,SUP, R00,R01,R02,R03,R04,R05,R06,R07,R08, R09,R10,R11,R12,R13,R14,R15,R16,R17, R18,R19,R20,R21,R22,R23,R24,R25,R26, R27,R28,R29,R30,R31,R32,R33,R34,R35, R36,R37,R38,R39,R40,R41,R42,R43,R44, R45,R46,R47,R48,R49,R50,R51,R52,R53, R54,R55,R56,R57,R58,R59,R60,R61,R62, R63,R64,R65,R66,R67,R68,R69,R70,R71, R72,R73,R74,R75,R76,R77,R78,R79,R80, R81,R82,R83,R84,R85,R86,R87,R88,R89, R90,R91,R92,R93,R94,R95,R96,R97,R98, R99,RAA,RAB,RAC,RAD,RAE,RAF,RAG,RAH, RAL,RAN,RAP,RAQ,RAR,RAS,RAT,RAU,RAV, RAW,RAX,RAY,RBA,RBB,RBC,RBD,RBE,RBF, RBG,RBH,RBI,RBJ,RBK,RBL,RBM,RBN,RUP, T01,T02,T03,T04,T05,T06,T07,T08,T09, T10,T11,T12,T13,T14,T15,T16,T17,T18, T19,T20,T21,T22,T23,T24,T25,T26,T27, T28,T29,T30,T31,T32,T33,T34,T35,T36, T37,T38,T39,T40,T41,T42,T43,T44,T45, T46,T47,T48,T49,T50,T51,T52,T53,T54, T55,T56,T57,T58,T59,T60,T61,T62,T63, T64,T65,T66,T67,T68,T69,T70,T71,T72, T73,T74,T75,T76,T77,T78,T79,T80,T81, T82,T83,TUP); -- PRIMARY REASON MEASURED RESOURCE AREA RATING -- FOR PERSONNEL NOT FULLY COMBAT READY subtype Prres_Prres_Types is Prres_Types range P01..P80; subtype Esres_Prres_Types is Prres_Types range S01..S98; subtype Erres_Prres_Types is Prres_Types range R00..RBN; subtype Trres_Prres_Types is Prres_Types range T01..T83; type Rlim_Types is (P,S,R,T); -- REASON FOR READINESS RATING LIMITATION type Fordv_Types is (C,B,F,H,D,I,J,K,T,U,G, X,Y); -- FOREIGN DELIVERY EQUIPMENT CAPABLILITY type Merec_Types is (AL,AS,CM,CO,DF,DL,EC,EM,EL,FL,HH, HY,IR,LL,LA,MO,OP,PH,RA,RM,SG,SL, SP,TL,TM,TV,UV,VI,WX,MP,XX); -- Major Equipment - Reconnaissance Capabilities -- SPECIAL CHECK FOR Merec_Types "#" type Pin_Types is (A,B,D,E,F,G,H,K,L,M,N,P,R,S); type Pleac_Types is (A,C); -- ORGANIZATION PLAN RELATIONSHIP type Ddp_Types is (ND,ID,AD,MD,LD); -- DIRECTED DEPLOYABILITY POSTURE type Reconn_Types is (AL, AS, CM, CO, DF, DL, EC, EM, EL, FL, HH, HY, IR, LL, LA, MO, OP, PH, RA, RM, SG, SL, SP, TL, TM, TV, UV, VI, WX, MP, XX); type Wpnco_Types is (CO, EL, IR, PH, RA, SG, SL, VI); type Mecus_Types is (CT,TT,MT,DT,XT,CF,TF,MF,DF,XF, CE,CS,RA,FT); -- TRANSPORTABLE COMMUNICATIONS EQUIPMENT CURRENT USE CODES type Avcat_Types is (A,B,C,D,F,G,H,J); -- AVAILABILITY CATEGORY type Resnd_Types is (A,B,C,E,F); -- REASON AVAILABILITY CATEGORY IS CODE "D" type Bilet_Types is (CG ,CO ,OIC,NCO); -- BILLET type Cornk_Types is (SGT, LT, CAPT, MAJ, LTCOL, COL, GEN); -- CORNK type Label_Types is (UDC ,ANAME,UTC ,ULC ,MJCOM,MAJOR,REVAL, TPSN ,SCLAS,LNAME,COAFF,MONOR, -- [A,B,C] CSERV,OPCON,ADCON,HOGEO,PRGEO,EMBRK,ACTIV, FLAG ,PUIC ,CBCOM,DFCON,POINT,NUCIN,PCTEF, BILET,CORNK,CONAM,MMCMD,NTASK,MODFG,PLETD, NDEST,DETA,CXMRS, -- [D] TCAA ,MEDIA,TADC ,ROUTE,RWDTE,XRTE ,XDATE, -- [G] TPERS,PEGEO,STRUC,AUTH ,ASGD ,POSTR,PICDA, DEPS ,TDEPS,CASPW,CCASP,CCEBY,SCATD,MGO , AGO ,NA ,NFO ,MENL ,NAVO ,NAVE ,OTHOF, OTHEN,PIAOD, -- [J] TREAD,READY,REASN,PRRAT,PRRES,ESRAT,ESRES, ERRAT,ERRES,TRRAT,TRRES,SECRN,TERRN,CARAT, CADAT,LIM ,RLIM ,RICDA,DOCNR,DOCID,PERTP, TPAUT,TPASG,TPAVL,PERTC,CPAUR,CPASG,CPAVL, TRUTC,TMTHD,TCARQ,TCRAS,TCRAV,TRSA1,TRSA2, TRSA3,TRSA4,TRSA5,EQSEE,EQSSE,MEARD,MEASG, MEPOS,ESSA1,ESSA2,ESSA3,ESSA4,ESSA5,ESSA6, ESSA7,ESSA8,ESSA9,EQREE,EQRED,MEMRA,ERSA1, ERSA2,ERSA3,ERSA4,ERSA5,ERSA6,ERSA7,ERSA8, SDOC ,READF,REASF,PRRAF,PRREF,ESRAF,ESREF, TRRAF,TRREF,SECRF,TERRF,CARAF,CADAF,LIMF , RLIMF,RICDF,RESPF,SMCC1,SMRA1,SMAA1,SMRC1, SMAC1,SMCC2,SMRA2,SMAA2,SMRC2,SMAC2,SMCC3, SMRA3,SMAA3,SMRC3,SMAC3,SMCC4,SMRA4,SMAA4, SMRC4,SMAC4,GCCLA,GCCLB,GCCLC,SPCLU,PRMA , MARAT,MAREA,CHDAT,FMART,FCDAT, -- [K] MEQPT,FORDV,MEPSA,METAL,MEPSD,MEORD,MEORN, MEORC,MEORO,CREWA,CREAL,CREWF,CRMRD,CRMRN, CRMRC,CRMRO,MEREC,TEGEO, -- [L,M] PIN,FRQNO,PLEAC,DDP,DDPRD,MDT,PUTCV,PEQPT, TPGEO,ALTYP,NUMBR,NUMEA,ALRET,NUSEQ,WPNCO, NUQPT,DSGEO,NUMWR,NUMWB,NUGUN,RTIME,DSSTA, RFDGS,NUSTO,NUECC, -- [N,P,Q] TEQPT,MESEN,DECON,MECUS,AVCAT,RESND,ERDTE, EXDAC,CPGEO,CFGEO,EQDEP,EQARR,TPIN ,TLEAC, TLEQE,UEQPT,MEQS ,SEDY ,TEDY ,ERRDY,AVAIL, DCNDY,EQRET,GEOGR,OPERL,DAFLD, -- [T] ACGEO,ACITY,ADATE,MDATE,RDATE, -- [V] GCMD ,TDATE,TRGEO,DEPDT,ARRDT,RPTOR,INTR1, INTR2,SBRPT -- [X] ); -- DATA ELEMENT LABEL type Mmcmd_Types is (M00048,M00049,M00051,M00053,M00055,M00070, M00074,M00101,M00201,M00300,M00400,M00407, M01333,M01369,M01531,M11000,M12000,M13000, M14000,M18032,M18045,M18172,M19001,M19009, M19012,M19015,M19033,M19100,M19137,M19500, M20000,M20020,M20040,M20051,M20080,M20128, M20135,M20146,M21580,M21610,M27100,M28300, M29000,M54000,M61610,M96300); -- MAJOR MARINE COMMAND -- SPECIAL CHECK FOR Mmcmd_Types "# " type Docid_Types is (AM22,AG23,AM24,BM22,BG23,BM24,BG25,CM22, CG23,CM24,CG25,CD26,CM28,CM29,DM22,DG23, DM24,DG25,DM26,DG27,DM28,DG29,DM32,DG33, DM34,DG35,DG36,DG37,EM22,EG23,EM24,EG25, EM26,EG27,FM22,FG23,FD24,FM25,FG26,FM27, FG28,FM29,FG33,FM34,FG35,FM36,FG37,FD38, GM22,GG23,HM22,HG23,HM24,HG25,HM26,HG27, JM22,JG23,JM24,JG25,JM26,JG27,KM22,KG23, LM22,LG23,LM24,LG25,LM26,LG27,LM28,LG29, MM22,MG23,MM24,MG25,MM26,MM27,MM28,MM29, MM32,MM33,NM22,NG23,NM24,NG25,NM26,NG27, OA22,OA23,OG24,OG25,PM22,PG23,PM24,PG25, QM22,QG23,QM24,QG25,QG26,QM27,QD28,QD29, QD32,QD33,QD34,QD35,QD36,RM22,RM24,RM25, RM26,RM27,RM28,RM29,RM32,RM33,RG34,RG35, RG36,RG37,RG38,RG39,SM22,SM23,SG24,SG25, SM26,SG27,SG28,SG29,SM32,SD33,TM22,TG23, UG22,UG23,UG24,UM25,UD26,UM27,WS22,WS23, WS24,WS25,WS26,WS27,WS28,ZG23,ZM24,ZG25, ZM26); -- PRIMARY DOC IDENTIDENTIFICATION CODE type Tmthd_Types is (B,C); -- METHOD type Meqs_Types is (A,D,F,G,K,L,M,N,P,Q,R,T,U,V, Y,Z,X,B,C,E,H,J,S,W); -- PRIME EQUIPMENT OPERATIONAL STATUS type Sedy_Types is (A,B,C,F,I,J,M,N,R,V,W,Y,Z,X); -- PACKAGE SUPPORT EQUIPMENT STATUS -- SPECIAL CHECK FOR Sedy_Types "0" "5" "7" "9" type Tedy_Types is (C,D,F,G,H,M,N,P,T,X,Z); -- ASSIGNED TEAM STATUS type Avail_Types is (A,B,C,D,E,F); -- EQUIPMENT AVAILABILITY type Alphabetic_Types is (A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z); type Error_Msg_Types is (Bad_Field, Bad_Sequence, No_Header, No_End, Field_Required, Bad_Card_Type, Mutually_Exclusive, Can_Not_Validate_Correctly); type Secur_Types is (U,C,S,T); -- SECURITY CLASSIFICATION type Trtype_Types is (ADD,CHANGE,DELETE,REPLACE); -- TRANSACTION TYPE type Card_Type_Types is (A ,B ,C ,D ,G ,J ,K ,L , M ,N ,P ,Q ,T ,V ,X ,R , DM1,DN1,JM1,KF1,KF2,KF3,KF4,KN1, RM3,TF1,H ,E ); -- CARD TYPE type Month_Types is (JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC); type Real_or_Exercise_Types is (R,X); type Oruic_Types is (DDAAAA,DEAAAA,DJJ010,DJ1000,DJ1200,DJ2000, DJ3000,DJ3020,DJ3021,DJ3023,DJ3024,DJ3025, DJ3026,DJ3090,DJ4000,DJ5000,DJ6000,DJ7000, DJ8000,DJ9000,DLAAAA,DMAAAA,W0ZUFF,W00QAA, W00YFF,W38BFF,W38AFF,W3VYFF,W3YBFF,WATMFF, W0ALFF,W0ANFF,W0ATFF,W32FFF,W0GTAA,W0GVAA, W0GWFF,W0QFAA,WATGFF,W4NHFF,N00011,N00033, N00060,N00061,N00070,N00072,N00071,FFQT10, FFB370,FFB790,FFBBB0,FFBCC0,FFBSD0, FFC4D0,FFCL80,FFCLM0,FFCMF0,FFCMJ0,FFCRS0, FFFHL0,FFFTC0,FFGKT0,FFGTW0,FFH5M0, FFH7B0,FFH7BA,FFH7BB,FFHCS0,FFJQ20, FFVGB0,M54000,M00400,M14000,M20000, M20020,E70098,E73130,E75120,E75150,XXAAAA, ZZZDAA,ZZZDAB,ZZZDAC,ZZZDAD,ZZZDAE,ZZZDAF, ZZZDAG,ZZZDAH,ZZZDAJ); -- MAJOR COMMAND CODE type Picda_Types is record Year : integer range 1901..2099; Month : integer range 1..12; Day : integer range 1..31; end record; type Altyp_Types is (AA,AB,AE,AL,AP,AR,AU,BD,BG,BN, BO,CD,CP,CS,DA,DB,DC,DD,DE,DF, DG,DH,DJ,DK,DL,DM,DN,DS,DW,EA, EG,IP,LC,LS,LT,ME,NE,PE,PG,PN, PS,RC,RN,RP,SA,SC,SD,SG,SI,SL, SM,SN,TA,TC,TD,TE,TF,TG,TL,TM, TN,TP,TR,TS,TT,TW,WR,WX); -- TYPE OF COMMITMENT CODES type Scatd_Types is (TO); type Prma_Types is (AAW ,AMW ,ASU ,ASW ,CCC ,CON ,ELW , FSO ,INT ,LOG ,MIW ,MOB ,NCO ,SPW , STW ,ATN ,ELT ,IOP ,MEP ,MSA ,SAR ); -- PRIMARY MISSION AREA type DDDYY_Types is record DDD : string(1..3); YY : string(1..2); end record; type YYMMDD_Types is record YY : string(1..2); MM : string(1..2); DD : string(1..2); end record; type YYMMDDHH_Types is record YY : string(1..2); MM : string(1..2); DD : string(1..2); HH : string(1..2); end record; type DDDHH_Types is record DDD : string(1..3); HH : string(1..2); end record; type HHHMM_Types is record HHH : string(1..3); MM : string(1..2); end record; type MMDDHH_Types is record Year : integer; MM : string(1..2); DD : string(1..2); HH : string(1..2); end record; type Card_Type_H is record Card_Number : integer range 1..1; Day : integer range 1..31; Month : Month_Types; Year : integer range 0..99; Real_or_Exercise : Real_or_Exercise_Types; Oruic : Oruic_Types; end record; type Card_Type_E is record Not_Used : string(1..2); end record; type Card_Type_A is record Udc : string(1..1); Aname : string(1..30); Utc : string(1..5); Ulc : string(1..3); Mjcom : string(1..6); Major : string(1..1); Reval : string(1..1); Tpsn : string(1..7); Sclas : string(1..1); end record; type Card_Type_B is record Lname : string(1..55); end record; type Card_Type_C is record Udc : string(1..1); Aname : string(1..30); Utc : string(1..5); Ulc : string(1..3); Coaff : string(1..2); Monor : string(1..6); Sclas : string(1..1); end record; type Card_Type_D is record Cserv : string(1..1); Opcon : string(1..6); Adcon : string(1..6); Hogeo : string(1..4); Prgeo : string(1..4); Embrk : string(1..6); Activ : string(1..2); Flag : string(1..1); Puic : string(1..6); Cbcom : string(1..1); Dfcon : string(1..1); Point : string(1..15); Nucin : string(1..1); Pctef : string(1..1); end record; type Card_Type_G is record Tcaa : string(1..29); Media : string(1..1); Tadc : string(1..1); Route : string(1..7); Rwdte : DDDYY_Types; Xrte : string(1..7); Xdate : DDDYY_Types; end record; type Card_Type_J is record Tpers : string(1..2); Pegeo : string(1..6); Struc : string(1..5); Auth : string(1..5); Asgd : string(1..5); Postr : string(1..5); Picda : Picda_Types; Deps : string(1..5); Tdeps : string(1..5); Caspw : string(1..5); Ccasp : string(1..5); Cceby : string(1..1); end record; type Card_Type_K is record Tread : string(1..5); Ready : string(1..1); Reasn : string(1..1); Prrat : string(1..1); Prres : string(1..3); Esrat : string(1..1); Esres : string(1..3); Errat : string(1..1); Erres : string(1..3); Trrat : string(1..1); Trres : string(1..3); Secrn : string(1..3); Terrn : string(1..3); Carat : string(1..1); Cadat : YYMMDD_Types; Lim : string(1..1); Rlim : string(1..1); Ricda : YYMMDD_Types; end record; type Card_Type_L is record Meqpt : string(1..13); Fordv : string(1..1); Mepsa : string(1..3); Metal : string(1..3); Mepsd : string(1..3); Meord : string(1..3); Meorn : string(1..3); Meorc : string(1..3); Meoro : string(1..3); Crewa : string(1..2); Creal : string(1..2); Crewf : string(1..2); Crmrd : string(1..2); Crmrn : string(1..2); Crmrc : string(1..2); Crmro : string(1..2); Merec_1 : string(1..2); Merec_2 : string(1..2); Merec_3 : string(1..2); end record; type Card_Type_M is record Meqpt : string(1..13); Tegeo : string(1..6); Mepsd : string(1..3); Meord : string(1..3); Meorn : string(1..3); Meorc : string(1..3); Meoro : string(1..3); Crewf : string(1..2); Crmrd : string(1..2); Crmrn : string(1..2); Crmrc : string(1..2); Crmro : string(1..2); Merec_1 : string(1..2); Merec_2 : string(1..2); Merec_3 : string(1..2); end record; type Card_Type_N is record Pin : string(1..5); Frqno : string(1..5); Pleac : string(1..1); Ddp : string(1..2); Ddprd : YYMMDDHH_Types; Mdt : DDDHH_Types; Putc : string(1..5); end record; type Card_Type_P is record Pin : string(1..5); Meqpt : string(1..13); Tpgeo : string(1..6); Altyp : Altyp_Types; Numbr : string(1..3); Numea : string(1..3); Alret : HHHMM_Types; end record; type Card_Type_Q is record Pin : string(1..5); Nuseq : string(1..3); Wpnco : string(1..7); Nuqpt : string(1..10); Dsgeo : string(1..6); Altyp : string(1..2); Numwr : string(1..2); Numwb : string(1..2); Nugun : string(1..2); Rtime : string(1..5); Dssta : string(1..1); Rfdgs : string(1..5); Nusto : string(1..3); Nuecc : string(1..2); end record; type Card_Type_T is record Teqpt : string(1..11); Mesen : string(1..4); Decon : string(1..1); Mecus : string(1..2); Avcat : string(1..1); Resnd : string(1..1); Erdte : YYMMDD_Types; Exdac : string(1..1); Cpgeo : string(1..4); Cfgeo : string(1..4); Eqdep : YYMMDD_Types; Eqarr : YYMMDD_Types; Pin : string(1..5); Tleac : string(1..1); Tleqe : string(1..2); end record; type Card_Type_V is record Acgeo : string(1..4); Acity : string(1..2); Adate : YYMMDD_Types; Mdate : string(1..4); Rdate : YYMMDD_Types; end record; type Card_Type_X is record Gcmd : string(1..6); Tdate : YYMMDD_Types; Trgeo : string(1..4); Depdt : YYMMDD_Types; Arrdt : YYMMDD_Types; Rptor : string(1..6); Intr1 : string(1..6); Intr2 : string(1..6); Sbrpt : string(1..6); Atach : string(1..3); end record; type Card_Type_R is record Seq : integer range 1..9; Tot : integer range 1..9; Label : string(1..5); Rmkid : string(1..27); Remrk : string(1..21); end record; type Card_Type_DM1 is record Billet : string(1..3); Cornk : string(1..5); Conam : string(1..17); Mmcmd : string(1..6); end record; type Card_Type_DN1 is record Ntask : string(1..13); Prgeo : string(1..4); Point : string(1..11); Modfg : string(1..1); Activ : string(1..2); Pletd : MMDDHH_Types; Ndest : string(1..11); Deta : MMDDHH_Types; Cxmrs : string(1..1); end record; type Card_Type_JM1 is record Scatd : Scatd_Types; Mgo : string(1..5); Ago : string(1..5); Na : string(1..5); Nfo : string(1..5); Menl : string(1..5); Navo : string(1..5); Nave : string(1..5); Othof : string(1..5); Othen : string(1..5); Piaod : string(1..6); end record; type Card_Type_KF1 is record Docnr : string(1..1); Docid : string(1..4); Pertp : string(1..2); Tpaut : string(1..4); Tpasg : string(1..4); Tpavl : string(1..4); Pertc : string(1..2); Cpaur : string(1..4); Cpasg : string(1..4); Cpavl : string(1..4); Trutc : string(1..2); Tmthd : string(1..1); Tcarq : string(1..3); Tcras : string(1..3); Tcrav : string(1..3); Trsa1 : string(1..2); Trsa2 : string(1..2); Trsa3 : string(1..2); Trsa4 : string(1..2); Trsa5 : string(1..2); end record; type Card_Type_KF2 is record Docnr : string(1..1); Eqsee : string(1..2); Eqsse : string(1..2); Meard : string(1..3); Measq : string(1..3); Mepos : string(1..3); Essa1 : string(1..2); Essa2 : string(1..2); Essa3 : string(1..2); Essa4 : string(1..2); Essa5 : string(1..2); Essa6 : string(1..2); Essa7 : string(1..2); Essa8 : string(1..2); Essa9 : string(1..2); Eqree : string(1..2); Eqred : string(1..2); Memra : string(1..3); Ersa1 : string(1..2); Ersa2 : string(1..2); Ersa3 : string(1..2); Ersa4 : string(1..2); Ersa5 : string(1..2); Ersa6 : string(1..2); Ersa7 : string(1..2); Ersa8 : string(1..2); Ersa9 : string(1..2); end record; type Card_Type_KF3 is record Docnr : string(1..1); Sdoc : string(1..4); Readf : string(1..1); Reasf : string(1..1); Prraf : string(1..1); Prref : string(1..3); Esraf : string(1..1); Esref : string(1..3); Erraf : string(1..1); Erref : string(1..3); Trraf : string(1..1); Trref : string(1..3); Secrf : string(1..3); Terrf : string(1..3); Caraf : string(1..1); Cadaf : YYMMDD_Types; Limf : string(1..1); Rlimf : string(1..1); Ricdf : YYMMDD_Types; Respf : string(1..5); end record; type Card_Type_KF4 is record Smcc1 : string(1..2); Smra1 : string(1..2); Smaa1 : string(1..2); Smrc1 : string(1..2); Smac1 : string(1..2); Smcc2 : string(1..2); Smra2 : string(1..2); Smaa2 : string(1..2); Smrc2 : string(1..2); Smac2 : string(1..2); Smcc3 : string(1..2); Smra3 : string(1..2); Smaa3 : string(1..2); Smrc3 : string(1..2); Smac3 : string(1..2); Smcc4 : string(1..2); Smra4 : string(1..2); Smaa4 : string(1..2); Smrc4 : string(1..2); Smac4 : string(1..2); Gccla : string(1..2); Gcclb : string(1..2); Gcclc : string(1..2); Spclu : string(1..9); end record; type Card_Type_KN1 is record Prma : Prma_Types; Marat : string(1..1); Marea : string(1..3); Chdat : YYMMDD_Types; Fmart : string(1..1); Fcdat : YYMMDD_Types; end record; type Card_Type_TF1 is record Ueqpt : string(1..11); Mesen : string(1..4); Meqs : string(1..1); Sedy : string(1..1); Tedy : string(1..1); Erddy : YYMMDD_Types; Avail : string(1..1); Dcndy : string(1..5); Eqret : YYMMDD_Types; Geogr : string(1..4); Operl : YYMMDD_Types; Dafld : string(1..4); end record; type Access_Card_Type_H is access Card_Type_H; type Access_Card_Type_E is access Card_Type_E; type Access_Card_Type_A is access Card_Type_A; type Access_Card_Type_B is access Card_Type_B; type Access_Card_Type_C is access Card_Type_C; type Access_Card_Type_D is access Card_Type_D; type Access_Card_Type_G is access Card_Type_G; type Access_Card_Type_J is access Card_Type_J; type Access_Card_Type_K is access Card_Type_K; type Access_Card_Type_L is access Card_Type_L; type Access_Card_Type_M is access Card_Type_M; type Access_Card_Type_N is access Card_Type_N; type Access_Card_Type_P is access Card_Type_P; type Access_Card_Type_Q is access Card_Type_Q; type Access_Card_Type_T is access Card_Type_T; type Access_Card_Type_V is access Card_Type_V; type Access_Card_Type_X is access Card_Type_X; type Access_Card_Type_R is access Card_Type_R; type Access_Card_Type_DM1 is access Card_Type_DM1; type Access_Card_Type_DN1 is access Card_Type_DN1; type Access_Card_Type_JM1 is access Card_Type_JM1; type Access_Card_Type_KF1 is access Card_Type_KF1; type Access_Card_Type_KF2 is access Card_Type_KF2; type Access_Card_Type_KF3 is access Card_Type_KF3; type Access_Card_Type_KF4 is access Card_Type_KF4; type Access_Card_Type_KN1 is access Card_Type_KN1; type Access_Card_Type_TF1 is access Card_Type_TF1; end MSG_Types; --:::::::::: --sys.src --:::::::::: --********************************************************************** -- -- -- S Y S T E M U T I L I T I E S -- -- --********************************************************************** with msg_types; use msg_types; with text_io; use text_io; package System_Utilities is type Module_Id is (MMI_ID, MI_ID, MV_ID, DBB_ID, SYS_ID); type Function_Code is (Coldstart_Module, Restart_Module, Terminate_Module, Module_Initialized, Module_Terminated, Send_Statistics, Fixed_Alert, Variable_Text, UNITREP_Message, Validated_Data, Invalid_Message, Delete_Record, Replace_Record, Add_Record, Message_On, Message_Off, Statistics); type Msg_Card_List; type Access_Msg_Card_List is access Msg_Card_List; type Msg_Card_List is record Next : Access_Msg_Card_List; Card : string(1..80); end record; Text_Length : constant integer := 60; subtype Text_Type is string(1..text_length); type Access_Text_Type is access Text_Type; type Alert_Msg is (System_Initialized, Invalid_Ftn_Code, Invalid_Unitrep_Msg, Invalid_Module_Id, Msg_Interface_Down, Msg_Interface_Up, Dbm_Interface_Down, Dbm_Interface_Up, Dbm_Full, Packet_Error, All_Msgs_Processed, No_Msgs_In_Directory, System_Terminated); type Msg_List; type Access_Msg_List is access Msg_List; type Msg_List is record Next : Access_Msg_List := null; Card_Number : integer range 2..999; Secur : Secur_Types; Trtype : Trtype_Types; Card_Type : Card_Type_Types; Oruic : Oruic_Types; Uic : string(1..6); Access_A : Access_Card_Type_A := null; Access_B : Access_Card_Type_B := null; Access_C : Access_Card_Type_C := null; Access_D : Access_Card_Type_D := null; Access_G : Access_Card_Type_G := null; Access_J : Access_Card_Type_J := null; Access_K : Access_Card_Type_K := null; Access_L : Access_Card_Type_L := null; Access_M : Access_Card_Type_M := null; Access_N : Access_Card_Type_N := null; Access_P : Access_Card_Type_P := null; Access_Q : Access_Card_Type_Q := null; Access_T : Access_Card_Type_T := null; Access_V : Access_Card_Type_V := null; Access_X : Access_Card_Type_X := null; Access_R : Access_Card_Type_R := null; Access_DM1 : Access_Card_Type_DM1 := null; Access_DN1 : Access_Card_Type_DN1 := null; Access_JM1 : Access_Card_Type_JM1 := null; Access_KF1 : Access_Card_Type_KF1 := null; Access_KF2 : Access_Card_Type_KF2 := null; Access_KF3 : Access_Card_Type_KF3 := null; Access_KF4 : Access_Card_Type_KF4 := null; Access_KN1 : Access_Card_Type_KN1 := null; Access_TF1 : Access_Card_Type_TF1 := null; Access_H : Access_Card_Type_H := null; Access_E : Access_Card_Type_E := null; end record; type Packet; type Packet_Access is access Packet; type Packet is record SMID : Module_Id; RMID : Module_Id; FTN : Function_Code; BAP : Access_Msg_Card_List; VAR_STRING : Text_Type; VAR_INTEGER : integer; ALERT_ID : Alert_Msg; NEXT : Packet_Access; MSG_PTR : Access_Msg_List; end record; --Null task packet parameters for the possibly unused fields: TP1 : Access_Msg_Card_List; TP2 : Text_Type; TP3 : integer; TP4 : Alert_Msg; TP5 : Access_Msg_List; procedure TPSEND (SMID, RMID : in Module_Id; FTN : in Function_Code; BAP : in Access_Msg_Card_List; VAR_STRING : in Text_Type; VAR_INTEGER : in integer; ALERT_ID : in Alert_Msg; MSG_PTR : in Access_Msg_List); type Queue is record First:Packet_Access:=null; Last :Packet_Access:=null; Count:integer:= 0; end record; MI_Queue, MV_Queue, DBB_Queue, MMI_Queue : Queue; subtype Str3 is string(1..3); function String_To_Integer(s : in string) return integer; function Integer_To_String(Number: in integer) return Str3; end System_Utilities; package body System_Utilities is --********************************************************************** -- TPSEND -- -- This routine builds and queues task packets to the receiving modules -- as specified by the sending module. --********************************************************************** procedure TPSEND (SMID, RMID : in Module_Id; FTN : in Function_Code; BAP : in Access_Msg_Card_List; VAR_STRING : in text_type; VAR_INTEGER : in integer; ALERT_ID : in Alert_Msg; MSG_PTR : in Access_Msg_List) is T,P:Packet_Access; begin T:= new Packet; T.SMID:= SMID; T.RMID:= RMID; T.FTN:= FTN; T.BAP:= BAP; T.VAR_STRING:= VAR_STRING; T.VAR_INTEGER:= VAR_INTEGER; T.ALERT_ID:= ALERT_ID; T.MSG_PTR:= MSG_PTR; case RMID is when DBB_ID => if DBB_Queue.First = null then DBB_Queue.First:=T; DBB_Queue.Last:= T; DBB_Queue.Count:= 1; else P:=DBB_Queue.Last; P.Next:= T; DBB_Queue.Last:= T; DBB_Queue.Count:= DBB_Queue.Count + 1; end if; when MI_ID => if MI_Queue.First = null then MI_Queue.First:= T; MI_Queue.Last:= T; MI_Queue.Count:= 1; else P:=MI_Queue.Last; P.Next:= T; MI_Queue.Last:= T; MI_Queue.Count:= MI_Queue.Count + 1; end if; when MV_ID => if MV_Queue.First = null then MV_Queue.First:= T; MV_Queue.Last:= T; MV_Queue.Count:= 1; else P:=MV_Queue.Last; P.Next:= T; MV_Queue.Last:= T; MV_Queue.Count:= MV_Queue.Count + 1; end if; when MMI_ID => if MMI_Queue.First = null then MMI_Queue.First:= T; MMI_Queue.Last:= T; MMI_Queue.Count:= 1; else P:=MMI_Queue.Last; P.Next:= T; MMI_Queue.Last:= T; MMI_Queue.Count:= MMI_Queue.Count + 1; end if; when others => TPSEND(SYS_ID,MMI_ID,Fixed_Alert,TP1, TP2,TP3,Packet_Error,TP5); end case; exception when constraint_error => put_line("TPSEND CONSTRAINT ERROR"); TPSEND(SYS_ID,MMI_ID,Fixed_Alert,TP1,TP2,TP3,Packet_Error,TP5); when others => put_line("TPSEND OTHER ERRORS"); end TPSEND; --********************************************************************** -- String To Integer -- This routine converts a three character string to a integer. --********************************************************************** function String_To_Integer(s : in string) return integer is val_int, i, exp : integer; begin exp := 10; i := 0; val_int := 0; for j in s'range loop if s(j) = '0' then i := 0; elsif s(j) = '1' then i := 1; elsif s(j) = '2' then i := 2; elsif s(j) = '3' then i := 3; elsif s(j) = '4' then i := 4; elsif s(j) = '5' then i := 5; elsif s(j) = '6' then i := 6; elsif s(j) = '7' then i := 7; elsif s(j) = '8' then i := 8; elsif s(j) = '9' then i := 9; else raise constraint_error; end if; val_int := val_int + (i * (exp ** (s'last - j))); end loop; return val_int; exception when others => return -1; end String_To_Integer; --********************************************************************** -- Integer To String -- This routine converts an integer to a three digit string. --********************************************************************** function Integer_To_String(Number: in integer) return Str3 is s1 : string(1..4); s : Str3; begin s := "000"; if Number < 0 or Number > 999 then s := "***"; elsif Number < 10 then s1(1..2) := integer'image(Number); s(3..3) := s1(2..2); elsif Number < 100 then s1(1..3) := integer'image(Number); s(2..3) := s1(2..3); else s1(1..4) := integer'image(Number); s := s1(2..4); end if; return s; exception when others => put_line("integer to string dead"); end Integer_To_String; begin null; exception when others => put_line("system utilities dead"); end System_Utilities; --:::::::::: --idmio.src --:::::::::: with idm_defs; use idm_defs; package idm_io is procedure idm_abort(idmrun : in out idmrun_type); procedure idm_begin(idmrun : in out idmrun_type); procedure idm_cancel(idmrun : in out idmrun_type); procedure idm_closerun(idmrun : in out idmrun_type); procedure idm_column(idmrun : in out idmrun_type; column : in positive; result : out integer); procedure idm_column(idmrun : in out idmrun_type; column : in positive; result : out float); procedure idm_column(idmrun : in out idmrun_type; column : in positive; result : out string; last : out natural); procedure idm_command(idmrun : in out idmrun_type; command : in string); procedure idm_describe(idmrun : in out idmrun_type; column : in positive; format : out idm_data_type; width : out positive; name : out string; last : out natural); procedure idm_end(idmrun : in out idmrun_type); procedure idm_execute(idmrun : in out idmrun_type); procedure idm_fetch(idmrun : in out idmrun_type); procedure idm_flush(idmrun : in out idmrun_type); procedure idm_getstatus(idmrun : in out idmrun_type; result : out idm_exception; itemid : in idm_status_type); procedure idm_getstatus(idmrun : in out idmrun_type; result : out integer; itemid : in idm_status_type); procedure idm_getstatus(idmrun : in out idmrun_type; result : out boolean; itemid : in idm_status_type); procedure idm_getstatus(idmrun : in out idmrun_type; result : out integer; itemid : in idm_status_type; errno : in positive); procedure idm_getstatus(idmrun : in out idmrun_type; result : out string; itemid : in idm_status_type; errno : in positive; last : out natural); procedure idm_initrun(printerrs : in boolean := true); procedure idm_nextcmd(idmrun : in out idmrun_type); procedure idm_opendb(idmrun : in out idmrun_type; dbname : in string); procedure idm_openrun(idmrun : in out idmrun_type; name : in string); procedure idm_param(idmrun : in out idmrun_type; param : in string; value : in integer; convert : in idm_data_type := idm_int2); procedure idm_param(idmrun : in out idmrun_type; param : in string; value : in float; convert : in idm_data_type := idm_flt4); procedure idm_param(idmrun : in out idmrun_type; param : in string; value : in string; convert : in idm_data_type := idm_char); end idm_io; package body idm_io is procedure idm_abort(idmrun : in out idmrun_type) is begin null; end idm_abort; procedure idm_begin(idmrun : in out idmrun_type) is begin null; end idm_begin; procedure idm_cancel(idmrun : in out idmrun_type) is begin null; end idm_cancel; procedure idm_closerun(idmrun : in out idmrun_type) is begin null; end idm_closerun; procedure idm_column(idmrun : in out idmrun_type; column : in positive; result : out integer) is begin null; end idm_column; procedure idm_column(idmrun : in out idmrun_type; column : in positive; result : out float) is begin null; end idm_column; procedure idm_column(idmrun : in out idmrun_type; column : in positive; result : out string; last : out natural) is begin null; end idm_column; procedure idm_command(idmrun : in out idmrun_type; command : in string) is begin null; end idm_command; procedure idm_describe(idmrun : in out idmrun_type; column : in positive; format : out idm_data_type; width : out positive; name : out string; last : out natural) is begin null; end idm_describe; procedure idm_end(idmrun : in out idmrun_type) is begin null; end idm_end; procedure idm_execute(idmrun : in out idmrun_type) is begin null; end idm_execute; procedure idm_fetch(idmrun : in out idmrun_type) is begin null; end idm_fetch; procedure idm_flush(idmrun : in out idmrun_type) is begin null; end idm_flush; procedure idm_getstatus(idmrun : in out idmrun_type; result : out idm_exception; itemid : in idm_status_type) is begin null; end idm_getstatus; procedure idm_getstatus(idmrun : in out idmrun_type; result : out integer; itemid : in idm_status_type) is begin null; end idm_getstatus; procedure idm_getstatus(idmrun : in out idmrun_type; result : out boolean; itemid : in idm_status_type) is begin null; end idm_getstatus; procedure idm_getstatus(idmrun : in out idmrun_type; result : out integer; itemid : in idm_status_type; errno : in positive) is begin null; end idm_getstatus; procedure idm_getstatus(idmrun : in out idmrun_type; result : out string; itemid : in idm_status_type; errno : in positive; last : out natural) is begin null; end idm_getstatus; procedure idm_initrun(printerrs : in boolean := true) is begin null; end idm_initrun; procedure idm_nextcmd(idmrun : in out idmrun_type) is begin null; end idm_nextcmd; procedure idm_opendb(idmrun : in out idmrun_type; dbname : in string) is begin null; end idm_opendb; procedure idm_openrun(idmrun : in out idmrun_type; name : in string) is begin null; end idm_openrun; procedure idm_param(idmrun : in out idmrun_type; param : in string; value : in integer; convert : in idm_data_type := idm_int2) is begin null; end idm_param; procedure idm_param(idmrun : in out idmrun_type; param : in string; value : in float; convert : in idm_data_type := idm_flt4) is begin null; end idm_param; procedure idm_param(idmrun : in out idmrun_type; param : in string; value : in string; convert : in idm_data_type := idm_char) is begin null; end idm_param; end idm_io; --:::::::::: --mmi.src --:::::::::: --********************************************************************** -- -- -- M A N / M A C H I N E I N T E R F A C E -- -- --********************************************************************** with text_io; with System_Utilities; use text_io; use System_Utilities; package Man_Machine_Interface is task MMI_Packet_Path is entry Packet_Process(PP : in packet_access); end MMI_Packet_Path; end Man_Machine_Interface; package body Man_Machine_Interface is task Command_Entry is entry Enable_Operator_Input; end Command_Entry; procedure Msg_Out(P : in packet_access); procedure Sys_Term(P : in packet_access); procedure Print_Messages(B : in Access_Msg_Card_List); procedure Initialization; procedure Accept_Text(read_me : out text_type); procedure Alert_Out(P : in packet_access); procedure Stats_Out(P : in packet_access); procedure Init_Completed(P : in packet_access); function Demand_Yes(write_me : in text_type) return boolean; type Alert_Text_Type is array(alert_msg range system_initialized..system_terminated) of text_type; Alert_Text : Alert_Text_Type := ("System Initialization Complete ", "Received task packet with invalid function code field value ", "Invalid Unitrep Message ", "Invalid Module Id ", "Message Interface Down ", "Message Interface Up ", "Database Interface Down ", "Database Interface Up ", "Database Full ", "There is an error in the task packet data. ", "Have processed all messages in current UNITREP directory ", "No UNITREP messages in specified directory ", "System Termination Complete "); Message_Interface_On : boolean := FALSE; MI_Init_Flag, MV_Init_Flag : boolean := FALSE; DBB_Init_Flag : boolean := false; DBB_Term_Flag : boolean := false; MI_Term_Flag, MV_Term_Flag : boolean := false; MI_STATS_FLAG, MV_STATS_FLAG : boolean := false; DBB_STATS_FLAG : boolean := false; type Command_Types is (start, stop, ss, term); Command : Command_Types; --********************************************************************** -- Command Entry -- This is the operator entry validation task. --********************************************************************** task body Command_Entry is temp,Tbuf : text_type := " "; --123456789 123456789 123456789 123456789 123456789 123456789 Invalid_Command : boolean; begin --initialize system Initialization; loop --task loop --entry point to this task accept Enable_Operator_Input; Invalid_Command:= True; while Invalid_Command loop --initialize i/o buffer temp:= " "; put_line(temp); temp:= " Valid Commands Description "; put_line(temp); temp:= "ss.................Receive Statistical Information "; put_line(temp); temp:= "term...............Shutdown the System "; put_line(temp); temp:= "start..............Start Message Interface and Validation "; put_line(temp); temp:= "stop...............Stop Message Interface and Validation "; put_line(temp); temp:= " "; put_line(temp); temp(1..15):= "Enter command: "; put_line(temp); accept_text(Tbuf); begin Command := Command_Types'value(Tbuf); case Command is when start => Invalid_Command:= False; if Message_Interface_On then temp(1..33):= "Message Interface already started"; put_line(temp); else temp(1..40):= "Enter name of UNITREP message directory:"; put_line(temp); accept_text(Tbuf); tpsend(mmi_id,mi_id,message_on,tp1,Tbuf,tp3,tp4,tp5); Message_Interface_On:= TRUE; end if; when stop => if not Message_Interface_On then temp(1..33):= "Message Interface already stopped"; put_line(temp); Invalid_Command:= True; else --turn message interface off tpsend(mmi_id,mi_id,message_off,tp1,tp2,tp3,tp4,tp5); Invalid_Command:= False; end if; when ss => Invalid_Command:= False; tpsend(mmi_id,mi_id,send_statistics,tp1,tp2,tp3,tp4,tp5); tpsend(mmi_id,mv_id,send_statistics,tp1,tp2,tp3,tp4,tp5); tpsend(mmi_id,dbb_id,send_statistics,tp1,tp2,tp3,tp4,tp5); when term => Invalid_Command:= False; tpsend(mmi_id,mi_id,terminate_module,tp1,tp2,tp3,tp4,tp5); tpsend(mmi_id,mv_id,terminate_module,tp1,tp2,tp3,tp4,tp5); tpsend(mmi_id,dbb_id,terminate_module,tp1,tp2,tp3,tp4,tp5); end case; exception when constraint_error => temp(1..33):= "Command not valid, try again..."; put_line(temp); Invalid_Command:= True; when others => put_line("Problem in declare block of command entry"); end; end loop; end loop; exception when others => put_line("Command Entry dead"); end Command_Entry; --********************************************************************** -- MMI_Packet_Path -- -- This task handles the reception and processing of task packets from -- the other system modules. The inputs will be received from the -- MMI_Monitor task with the input being the packet pointer. --********************************************************************** task body MMI_Packet_Path is P : packet_access; begin loop accept Packet_Process(PP:in packet_access) do P:= PP; end Packet_Process; case P.FTN is when Fixed_Alert => Alert_Out(P); when Variable_Text => Msg_Out(P); when Statistics => Stats_Out(P); when Module_Terminated => Sys_Term(P); when Module_Initialized => Init_Completed(P); when Invalid_Message => Print_Messages(P.BAP); when others => put_line(Alert_Text(invalid_ftn_code)); end case; end loop; exception when others => put_line("MMI Packet Path dead"); end MMI_Packet_Path; --********************************************************************** -- Alert_Out -- -- This routine outputs the fixed text alerts to the operator. The -- input is task packet pointer to the packet containing the fixed text -- alert message name. --********************************************************************** procedure Alert_Out(P : in packet_access) is begin put_line(Alert_Text(P.alert_id)); case P.alert_id is when Msg_Interface_Down => Message_Interface_On:= FALSE; Command_Entry.Enable_Operator_Input; when others => null; end case; exception when others => put_line("alert out dead"); end Alert_Out; --********************************************************************** -- Stats_Out -- This routine converts the value held in the VAR_INTEGER field of the -- packet to ASCII then outputs this collected statistical value after -- the title held in the VAR_STRING field of the packet. --********************************************************************** procedure Stats_Out(P : in packet_access) is T : text_type :=" "; -- 123456789 123456789 123456789 123456789 123456789 123456789 S : str3; begin S := integer_to_string(P.VAR_INTEGER); T(1..3):= S; put(P.VAR_STRING); put_line(T); case p.smid is when MI_ID => MI_STATS_FLAG := true; when MV_ID => MV_STATS_FLAG := true; when DBB_ID => DBB_STATS_FLAG:= true; when others => put_line("Error in STATS_OUT case statement"); end case; if (MI_STATS_FLAG and MV_STATS_FLAG and DBB_STATS_FLAG) then MI_STATS_FLAG := false; MV_STATS_FLAG := false; DBB_STATS_FLAG := false; Command_Entry.Enable_Operator_Input; end if; exception when others => put_line("stats out dead"); end Stats_Out; --********************************************************************** -- Init Completed -- Processes the initialization complete task packets received from the -- other system modules. When all have been received, the operator is -- notified. --********************************************************************** procedure Init_Completed(P : in packet_access) is begin case P.smid is when MI_ID => MI_Init_Flag := TRUE; when MV_ID => MV_Init_Flag := TRUE; when DBB_ID => DBB_Init_Flag:= TRUE; when others => put_line("problem with case in init completed"); end case; if (MI_Init_Flag and MV_Init_Flag and DBB_Init_Flag) then --notify operator that system is initialized put_line(Alert_Text(system_initialized)); --reset initialization flags MI_Init_Flag := False; MV_Init_Flag := False; DBB_Init_Flag:= False; --enable operator entry of commands Command_Entry.Enable_Operator_Input; end if; end Init_Completed; --********************************************************************** -- Msg_Out -- -- This routine outputs the variable text alerts to the operator. The -- input is a task packet pointer to the packet containing the variable -- text alert message. --********************************************************************** procedure Msg_Out(P : in packet_access) is begin put_line(P.var_string); exception when others => put_line("msg out dead"); end Msg_Out; --********************************************************************** -- Sys_Term -- -- This routine receives the system termination complete packets from -- the various system modules. When all modules have responded, this -- routine outputs a system terminated notification to the operator -- then terminates the system. --********************************************************************** procedure Sys_Term(P : in packet_access) is begin case P.SMID is when MI_ID => MI_Term_Flag := true; when MV_ID => MV_Term_Flag := true; when DBB_ID => DBB_Term_Flag:= true; when others => put_line(Alert_Text(packet_error)); end case; if (MI_Term_Flag and MV_Term_Flag and DBB_Term_Flag) then --notify operator that system is terminated put_line(Alert_Text(system_terminated)); --reset termination flags MI_Term_Flag := False; MV_Term_Flag := False; DBB_Term_Flag:= False; --reinitialize system, Ask operator to coldstart or restart Initialization; end if; exception when others => put_line("sys term dead"); end Sys_Term; --********************************************************************** -- Print Messages -- This routine prints the invalid UNITREP messages for the operator. --********************************************************************** procedure Print_Messages(B : in Access_Msg_Card_List) is Message : Access_Msg_Card_List; begin Message := B; loop exit when Message.next = null; Message := Message.next; put_line(Message.card); end loop; end Print_Messages; --********************************************************************** -- Initialization -- This routine performs the system initialization querying of the -- operator and sends the initialization task packets to the other -- system modules. --********************************************************************** procedure Initialization is Coldstart, Done : boolean; T : text_type :=" "; -- 123456789 123456789 123456789 123456789 123456789 123456789 F : function_code; begin --query operator for system coldstart or restart T(1..21):= "Coldstart the System?"; if demand_yes(T) then Coldstart:= TRUE; F:= Coldstart_Module; else Coldstart:= FALSE; F:= Restart_Module; end if; --coldstart/restart system modules tpsend(mmi_id,mi_id,F,tp1,tp2,tp3,tp4,tp5); tpsend(mmi_id,mv_id,F,tp1,tp2,tp3,tp4,tp5); tpsend(mmi_id,dbb_id,F,tp1,tp2,tp3,tp4,tp5); exception when others => put_line("initialization dead"); end Initialization; procedure Accept_Text(read_me : out text_type) is i:integer; begin put(">"); for i in 1..text_length loop read_me(i):= ' '; end loop; get_line(read_me,i); end Accept_Text; function Demand_Yes(write_me : in text_type) return boolean is temp : text_type; begin loop put_line(write_me); accept_text(temp); if (temp(1..3) = "yes") or (temp(1) = 'y') then return true; elsif (temp(1..2) = "no") or (temp(1) = 'n') then return false; end if; temp(1..30):="Please answer yes or no... "; put_line(temp); end loop; end Demand_Yes; begin --mmi null; exception when constraint_error => put_line("MMI constraint error"); when others => put_line("MMI dead"); end Man_Machine_Interface; --:::::::::: --msginput.src --:::::::::: -- MESSAGE INPUT MODULE PACKAGE SPECIFICATIONS AND BODY with text_io; use text_io; with System_Utilities; use System_Utilities; package Message_Input_Module is task Message_Request is entry Request_Function(R : in packet_access); end Message_Request; end Message_Input_Module; package body Message_Input_Module is task Message_Interface is entry Input_Function(R : in packet_access); end Message_Interface; procedure Read_Unitrep_Messages(Receive_a_packet : in packet_access); Stop_Interface_Flag : boolean := false; Terminate_Input_Flag : boolean := false; Queued_Messages : integer := 0; Total_Queued_Messages : integer := 0; First_Message_List : access_msg_card_list; Message_List : access_msg_card_list; Last_Message_Flag : integer := 0; Input_Initialized : boolean := false; tmp_text : string(1..60) := " "; -- 123456789 123456789 123456789 123456789 123456789 123456789 Blank_Card : constant string(1..80) := " " & " "; -- 123456789 123456789 123456789 123456789 I : integer := 0; I1 : integer := 0; Message_File : file_type; --********************************************************************** -- -- MESSAGE_REQUEST -- -- This Task is the main controlling task of the Message Input Module. -- It receives commands from the Man/Machine Interface (MMI), validates -- and processes the command. The Message Interface Task is turned on -- and off from this task. -- --********************************************************************** task body Message_Request is Receive_a_packet : packet_access; begin loop accept Request_Function(R : in packet_access) do Receive_a_packet := R; end Request_Function; -- -- validation and processing of request -- -- requests handled -- Restart_Module => initialize flags -- clear buffers -- Message_On => turn on message interface -- Message_Off => set Stop_Interface_Flag to -- turn off message interface -- Terminate_Module => set Terminate_Module_Flag to -- turn off message interface -- Send_Statistics => queue statistics to MMI -- Coldstart_Module => zero statistics -- clear buffers -- initialize flags -- others => invalid request queue to MMI -- with message stating invalid -- if not Input_Initialized then if Receive_a_packet.ftn = Coldstart_Module or Receive_a_packet.ftn = Restart_Module then Input_Initialized := true; Terminate_Input_Flag := false; Stop_Interface_Flag := true; Last_Message_Flag := -1; First_Message_List := null; Message_List := null; if Receive_a_packet.ftn = Coldstart_Module then Total_Queued_Messages := 0; end if; tpsend(mi_id,mmi_id,module_initialized,tp1, tp2,tp3,tp4,tp5); else tpsend(mi_id,mmi_id,fixed_alert,tp1,tp2,tp3, invalid_ftn_code,tp5); end if; else case Receive_a_packet.ftn is when Message_On => Stop_Interface_Flag := false; Last_Message_Flag := 0; Message_Interface.Input_Function(Receive_a_packet); when Message_Off => Stop_Interface_Flag := true; when Terminate_Module => Terminate_Input_Flag:= true; if Last_Message_Flag = -1 then tpsend(mi_id,mmi_id,module_terminated, tp1,tp2,tp3,tp4,tp5); Input_initialized := false; end if; when Send_Statistics => Tmp_Text(1..32) := "Number of UNITREP Messages Input"; tpsend(mi_id,mmi_id,statistics,tp1,tmp_text, Total_Queued_Messages,tp4,tp5); when others => tpsend(mi_id,mmi_id,fixed_alert,tp1,tp2,tp3, invalid_ftn_code,tp5); end case; end if; end loop; exception when others => put_line("message request dead"); end Message_Request; --********************************************************************** -- -- MESSAGE_INTERFACE -- -- This Task is the Message Interface for messages input. This task -- handles Coldstart and Message Interface On requests. Message -- Interface On will start the procedure Read_Unitrep_Messages which -- reads UNITREP Messages. -- --********************************************************************** task body Message_Interface is Receive_a_packet : packet_access; begin loop accept Input_Function(R : in packet_access) do Receive_a_packet := R; end Input_Function; -- if Stop_Interface_Flag then tpsend(mi_id,mmi_id,fixed_alert,tp1,tp2,tp3, msg_interface_down,tp5); else tpsend(mi_id,mmi_id,fixed_alert,tp1,tp2,tp3, msg_interface_up,tp5); end if; -- -- start procedure to read UNITREP Messages -- Read_Unitrep_Messages(Receive_a_packet); -- if Stop_Interface_Flag then tpsend(mi_id,mmi_id,fixed_alert,tp1,tp2,tp3, msg_interface_down,tp5); else tpsend(mi_id,mmi_id,fixed_alert,tp1,tp2,tp3, msg_interface_up,tp5); end if; end loop; exception when others => put_line("message interface dead"); end Message_Interface; procedure Read_Unitrep_Messages(Receive_a_packet : in packet_access) is File_Name : string(1..60); begin I1 := 0; Queued_Messages := 0; for I in 1..text_length loop I1 := I1 + 1; exit when Receive_a_packet.var_string(I) = ' '; end loop; I := I1 - 1; File_Name(1..I) := Receive_a_packet.var_string(1..I); File_Name(I + 1 .. I + 8) := "MESSAGE."; I := I + 9; loop I1 := Queued_Messages + 1; File_Name(I..I + 2) := integer_to_string(I1); open(Message_File,in_file,File_Name); First_Message_List := new msg_card_list; Message_List := new msg_card_list; First_Message_List.next := Message_list; begin loop exit when end_of_file(Message_File); Message_List.card := Blank_Card; get_line(Message_File,Message_List.card,I1); if I1 /= 0 then Message_List.next := new msg_card_list; Message_List := Message_List.next; end if; end loop; exception when end_error => Message_List.next := null; when others => put_line("problem reading message file"); end; close(Message_File); if Terminate_Input_Flag then Last_Message_Flag := -1; tpsend(mi_id,mv_id,UNITREP_message,First_Message_List,tp2, Last_Message_Flag,tp4,tp5); Queued_Messages := Queued_Messages + 1; Total_Queued_Messages := Total_Queued_Messages + 1; tpsend(mi_id,mmi_id,module_terminated,tp1,tp2,tp3,tp4,tp5); Input_Initialized := false; exit; elsif Stop_Interface_Flag then Last_Message_Flag := -1; tpsend(mi_id,mv_id,UNITREP_message,First_Message_List,tp2, Last_Message_Flag,tp4,tp5); Queued_Messages := Queued_Messages + 1; Total_Queued_Messages := Total_Queued_Messages + 1; exit; else tpsend(mi_id,mv_id,UNITREP_message,First_Message_List,tp2, Last_Message_Flag,tp4,tp5); Queued_Messages := Queued_Messages + 1; Total_Queued_Messages := Total_Queued_Messages + 1; end if; end loop; exception when name_error => if Queued_Messages = 0 then tpsend(mi_id,mmi_id,fixed_alert,tp1,tp2,tp3, no_msgs_in_directory,tp5); else tpsend(mi_id,mmi_id,fixed_alert,tp1,tp2,tp3, all_msgs_processed,tp5); Last_Message_Flag := -1; tpsend(mi_id,mv_id,UNITREP_Message,tp1,tp2, Last_Message_Flag,tp4,tp5); end if; Stop_Interface_Flag := true; when constraint_error => put_line("MI Constraint"); when numeric_error => put_line("MI Numeric"); when others => put_line("problem with read unitrep messages"); end Read_Unitrep_Messages; end Message_Input_Module; --:::::::::: --msgvalid.src --:::::::::: -- MESSAGE VALIDATION MODULE PACKAGE SPECIFICATION AND BODY with MSG_Types; use MSG_Types; with System_Utilities; use System_Utilities; with calendar; use calendar; with idm_defs; use idm_defs; with idm_io; use idm_io; with text_io; use text_io; package Message_Validation_Module is task Message_Receive is entry Receive_Function(R : in packet_access); end Message_Receive; end Message_Validation_Module; package body Message_Validation_Module is task Message_Validation is entry Validation_Function; end Message_Validation; procedure Validate_Cards; procedure Validate_Common_Data; procedure Process_Card_H; procedure Process_Card_A; procedure Process_Card_B; procedure Process_Card_C; procedure Process_Card_D; procedure Process_Card_G; procedure Process_Card_J; procedure Process_Card_K; procedure Process_Card_L; procedure Process_Card_M; procedure Process_Card_N; procedure Process_Card_P; procedure Process_Card_Q; procedure Process_Card_T; procedure Process_Card_V; procedure Process_Card_X; procedure Process_Card_R; procedure Process_Card_DM1; procedure Process_Card_DN1; procedure Process_Card_JM1; procedure Process_Card_KF1; procedure Process_Card_KF2; procedure Process_Card_KF3; procedure Process_Card_KF4; procedure Process_Card_KN1; procedure Process_Card_TF1; procedure Process_Card_E; procedure Invalid_Unitrep_Message; procedure Valid_Message; procedure Send_Stats; procedure Get_and_Store_System_Date; procedure Link_List; procedure Error_Message(s : in string ; e : in Error_Msg_Types); procedure Validate_Uic(Uic : in string ; Field_Name : in string); procedure Validate_YYMMDD(YY : in string ; MM : in string ; DD : in string ; Field_Name : in string); procedure Validate_Oruic(Oruic : in string ; Field_Name : in string); procedure Validate_Udc(Udc : in string ; Field_Name : in string); procedure Validate_Ulc(Ulc : in string ; Field_Name : in string); procedure Validate_DDDYY(DDD : in string ; YY : in string ; Field_Name : in string); procedure Validate_Numeric(Num : in string ; Field_Name : in string); procedure Validate_Pin(Valid_Pin : in string ; Field_Name : in string); procedure Validate_Meqpt(Meqpt : in string ; Field_Name : in string); procedure Validate_Geolocation(Geolocation : in string ; Field_Name : in string); procedure Load_Meq_Values; procedure Load_Crew_Values; function Invalid_Uic(Uic : in string) return boolean; function Invalid_Geo(Geo : in string) return boolean; Department_Type : Department_Types; Uic2_Department_Type : Uic2_Department_Types; Secur_Type : Secur_Types; Trtype_Type : Trtype_Types; Udc_Type : Udc_Types; Ulc_Type : Ulc_Types; Oruic_Type : Oruic_Types; Major_Type : Major_Types; Reval_Type : Reval_Types; Cserv_Type : Cserv_Types; Activ_Type : Activ_Types; Flag_Type : Flag_Types; Cbcom_Type : Cbcom_Types; Dfcon_Type : Dfcon_Types; Nucin_Type : Nucin_Types; Media_Type : Media_Types; Tadc_Type : Tadc_Types; Tpers_Type : Tpers_Types; Cceby_Type : Cceby_Types; Tread_Type : Tread_Types; Reasn_Type : Reasn_Types; Prres_Type : Prres_Prres_Types; Esres_Type : Esres_Prres_Types; Erres_Type : Erres_Prres_Types; Trres_Type : Trres_Prres_Types; Secrn_Type : Prres_Types; Terrn_Type : Prres_Types; Marea_Type : Prres_Types; Rlim_Type : Rlim_Types; Fordv_Type : Fordv_Types; Merec_Type : Merec_Types; Pin_Type : Pin_Types; Pleac_Type : Pleac_Types; Ddp_Type : Ddp_Types; altyp_type : altyp_types; Reconn_Type : Reconn_Types; Wpnco_Type : Wpnco_Types; Mecus_Type : Mecus_Types; Avcat_Type : Avcat_Types; Resnd_Type : Resnd_Types; Label_Type : Label_Types; Bilet_Type : Bilet_Types; Cornk_Type : Cornk_Types; Scatd_Type : Scatd_Types; Docid_Type : Docid_Types; Tmthd_Type : Tmthd_Types; Meqs_type : Meqs_types; Sedy_Type : Sedy_Types; Tedy_Type : Tedy_Types; Avail_Type : Avail_Types; Coaff_Type : Coaff_Types; Alphabetic_Type : Alphabetic_Types; Mmcmd_Type : Mmcmd_Types; Error_Msg_Type : Error_MSG_Types; Card_H : Access_Card_Type_H; -- header Card_E : Access_Card_Type_E; -- end Card_A : Access_Card_Type_A; Card_B : Access_Card_Type_B; Card_C : Access_Card_Type_C; Card_D : Access_Card_Type_D; Card_G : Access_Card_Type_G; Card_J : Access_Card_Type_J; Card_K : Access_Card_Type_K; Card_L : Access_Card_Type_L; Card_M : Access_Card_Type_M; Card_N : Access_Card_Type_N; Card_P : Access_Card_Type_P; Card_Q : Access_Card_Type_Q; Card_T : Access_Card_Type_T; Card_V : Access_Card_Type_V; Card_X : Access_Card_Type_X; Card_R : Access_Card_Type_R; Card_DM1 : Access_Card_Type_DM1; Card_DN1 : Access_Card_Type_DN1; Card_JM1 : Access_Card_Type_JM1; Card_KF1 : Access_Card_Type_KF1; Card_KF2 : Access_Card_Type_KF2; Card_KF3 : Access_Card_Type_KF3; Card_KF4 : Access_Card_Type_KF4; Card_KN1 : Access_Card_Type_KN1; Card_TF1 : Access_Card_Type_TF1; idmrun : idmrun_type; Length_of_String : integer := 0; First_Valid_Msg : Access_Msg_List; Valid_Msg : Access_Msg_List; First_Input_Msg : Access_Msg_Card_List; Input_Msg : Access_Msg_Card_List; First_Error_Msg : Access_Msg_Card_List; Error_Msg : Access_Msg_Card_List; Receive_packet : packet_access; Bad_Message : boolean; Udc_Valid : boolean; No_Header_Exception : exception; No_End_Exception : exception; Bad_Sequence_Exception : exception; Seq_Number, Old_Seq_Number : integer := 0; Nbr_of_Valid_Messages : integer := 0; Nbr_of_Invalid_Messages : integer := 0; System_Time : time; System_Year : integer; System_Month : integer; System_Day : integer; Header_Date : string(1..6); Header_Year : integer; Header_Month : integer; Header_Day : integer; Header_Oruic : string(1..6); Header_Report_Number : string(1..3); Terminate_Module_Flag : boolean := false; Task_Initialized : boolean := false; Validating_Messages : boolean := false; Last_Message : integer :=0; Validating_Field_Name : string(1..5); Common_Card_Number : string(1..3) := " "; Common_Card_Type : string(1..3) := " "; Tmp_Text_Type : string(1..60) := " "; -- "123456789 123456789 123456789 123456789 123456789 123456789 " Last_Message_String : constant string(1..60) := "LAST MESSAGE "; -- "123456789 123456789 123456789 123456789 123456789 123456789 " type Error_Msg_Text_Type is array (Error_MSG_Types range Bad_Field..Can_Not_Validate_Correctly) of string(1..80); Error_Msg_Text : Error_Msg_Text_Type := ("Bad Field in card sequence number " & " . ", "Card Sequence Numbers out of sequence. " & " ", "No Header Card Found. " & " ", "No End Card Found. " & " ", " Field is Required card sequence nu" & "mber . ", "Bad Card Type card sequence number . " & " ", "Mutually exclusive fields reported card " & "sequence . ", "Can not validate Field correctly i" & "n card sequence number . "); Mepsd_Value : integer; Meord_Value : integer; Meorn_Value : integer; Meorc_Value : integer; Meoro_Value : integer; Crewf_Value : integer; Crmrd_Value : integer; Crmrn_Value : integer; Crmrc_Value : integer; Crmro_Value : integer; Valid_Value : integer := 0; Month_of_Year : integer; Leap_Year : integer; Days_in_Year : integer := 365; type Days_in_Month_Type is array(1..12) of integer; Days_in_Month : Days_in_Month_Type := (31,28,31,30,31,30,31, 31,30,31,30,31); Working_String : string(1..10) := " "; String_Length : integer; --********************************************************************** -- -- MESSAGE_RECEIVE -- -- This Task is the main controlling task of the Message Validation -- Module. It receives commands from Man/Machine Interface (MMI), -- Message Input (MV) and the Database Build, validates and processes -- the command. Message Validation is turned on when a message is -- waiting in queue. -- --********************************************************************** task body Message_Receive is begin loop accept Receive_Function(R : in packet_access) do Receive_packet := R; end Receive_Function; -- -- validation and processing of Request -- -- requests handled -- Coldstart_Module => zero statistics -- clear buffers -- initialize flags -- Unitrep_Message => turn on Message_Validation task -- to validate unitrep message -- Terminate_Module => set Terminate_Module_Flag to -- turn off validation -- Restart_Module => initialize flags -- clear buffers -- Send_Statistics => queue Statistics to MMI -- others => invalid request queue to MMI -- with message stating invalid -- if not Task_Initialized then if Receive_packet.ftn = Coldstart_Module or Receive_packet.ftn = Restart_Module then Task_Initialized := true; Terminate_Module_Flag := false; Validating_Messages := false; Last_Message := 0; First_Valid_Msg := null; Valid_Msg := null; First_Input_Msg := null; Input_Msg := null; First_Error_Msg := null; Error_Msg := null; if Receive_packet.ftn = Coldstart_Module then Nbr_of_Valid_Messages := 0; Nbr_of_Invalid_Messages := 0; end if; tpsend(mv_id,mmi_id,module_initialized,tp1,tp2,tp3,tp4,tp5); else tpsend(mv_id,mmi_id,fixed_alert,tp1,tp2,tp3, invalid_ftn_code,tp5); end if; else case Receive_packet.ftn is when UNITREP_Message => if Receive_packet.bap = null then Validating_Messages := false; else Validating_Messages := true; Message_Validation.Validation_Function; end if; when Terminate_Module => Terminate_Module_Flag := true; if not Validating_Messages then tpsend(mv_id,mmi_id,module_terminated,tp1,tp2, tp3,tp4,tp5); task_initialized := false; end if; when Send_Statistics => Send_Stats; when others => tpsend(mv_id,mmi_id,fixed_alert,tp1,tp2,tp3, invalid_ftn_code,tp5); end case; end if; end loop; exception when others => put_line("Message Receive dead"); end Message_Receive; --********************************************************************** -- -- MESSAGE VALIDATION -- -- This Procedure accepts a message, extracts cards from the -- message and validates the message and cards building a buffer -- of validated cards for queue to DBB -- --********************************************************************** task body Message_Validation is begin -- Get_and_Store_System_Date; -- loop accept Validation_Function; idm_initrun(true); idm_openrun(idmrun,"sys_idm"); idm_opendb(idmrun,"unitrep"); Validate_Cards; idm_closerun(idmrun); if Last_Message = -1 then Validating_Messages := false; if Terminate_Module_Flag then tpsend(mv_id,mmi_id,module_terminated,tp1,tp2,tp3,tp4,tp5); task_initialized := false; end if; end if; end loop; exception when others => put_line("Message Validation dead"); end Message_Validation; procedure Validate_Cards is -- -- start validation of UNITREP Messages -- begin -- -- set up link to first error message -- First_Error_Msg := new Msg_Card_List; Error_Msg := new Msg_Card_List; First_Error_Msg.next := Error_Msg; -- -- get first input message and set pointer to first message -- in list -- First_Input_Msg := Receive_packet.bap; Input_Msg := First_Input_Msg.next; -- -- get last message flag -- Last_Message := Receive_packet.var_integer; -- -- set up first valid message and pointer to first valid -- message -- First_Valid_Msg := new Msg_List; Valid_Msg := new Msg_List; First_Valid_Msg.Next := Valid_Msg; -- -- set bad message flag to false -- Bad_Message := false; -- -- search input Message List for header card. If no header -- card found raise no_header_exception -- loop if Input_Msg.next = null then raise No_Header_exception; end if; Common_Card_Number := Input_Msg.card(1..3); Common_Card_Type := Input_Msg.card(6..8); Seq_Number := string_to_Integer(Common_Card_Number); if Common_Card_Type = "H " and Seq_Number = 1 then Old_Seq_Number := Seq_Number + 1; exit; end if; Input_Msg := Input_Msg.next; end loop; -- -- Validate Card/Fields -- loop -- -- validate card type field card. convert to card type -- enumeration value. if no valid use enumeration value of -- bad. -- begin Validating_Field_Name := " "; Error_Msg_Type := Bad_Card_Type; Valid_Msg.Card_Type := Card_Type_Types'value(Common_Card_Type); -- -- validate common data for all cards except Header and End -- cards -- case Valid_Msg.Card_Type is when H | E => null; when others => Validate_Common_Data; end case; -- -- process each card type. case statement is used to do -- appropriate processing for each enumeration value (card -- type) -- case Valid_Msg.Card_Type is when H => Process_Card_H; when A => Process_Card_A; when B => Process_Card_B; when C => Process_Card_C; when D => Process_Card_D; when G => Process_Card_G; when J => Process_Card_J; when K => Process_Card_K; when L => Process_Card_L; when M => Process_Card_M; when N => Process_Card_N; when P => Process_Card_P; when Q => Process_Card_Q; when T => Process_Card_T; when V => Process_Card_V; when X => Process_Card_X; when R | RM3 => Process_Card_R; when DM1 => Process_Card_DM1; when DN1 => Process_Card_DN1; when JM1 => Process_Card_JM1; when KF1 => Process_Card_KF1; when KF2 => Process_Card_KF2; when KF3 => Process_Card_KF3; when KF4 => Process_Card_KF4; when KN1 => Process_Card_KN1; when TF1 => Process_Card_TF1; when E => Process_Card_E; end case; exception when constraint_error => Error_Message(Validating_Field_Name,Error_Msg_Type); when others => put_line("problem in validate card/fields"); end; if Valid_Msg.card_type = E then exit; end if; -- -- Read in Cards following Header Card watching for an End -- Card -- -- Input_Msg := Input_Msg.next; if Input_Msg.next = null then raise No_End_Exception; end if; Common_Card_Number := Input_Msg.card(1..3); Common_Card_Type := Input_Msg.card(6..8); Seq_Number := string_to_Integer(Common_Card_Number); if Seq_Number /= Old_Seq_Number then raise Bad_Sequence_Exception; end if; Old_Seq_Number := Seq_Number + 1; end loop; if Bad_Message then Invalid_Unitrep_Message; end if; exception when No_Header_Exception => Error_Message("",No_Header); Invalid_Unitrep_Message; when No_End_Exception => Error_Message("",No_End); Invalid_Unitrep_Message; when Bad_Sequence_Exception => Error_Message("",Bad_Sequence); Invalid_Unitrep_Message; when others => put_line("Something wrong in Validation procedure"); end Validate_Cards; --********************************************************************** -- -- This procedure does the processing for the validation of the -- common fields of all cards except the Header and End card. -- --********************************************************************** procedure Validate_Common_Data is begin -- -- validate and place card sequence number in card number field -- Valid_Msg.Card_Number := Seq_Number; -- -- convert and validate security classification field -- begin Working_String := " "; Working_String(1..1) := Input_Msg.card(4..4); Valid_Msg.Secur := Secur_Types'value(Working_String); exception when others => Error_Message("SECUR",Bad_Field); end; -- -- validate and convert transaction type -- if Input_Msg.Card(5) = 'A' then Valid_Msg.Trtype := ADD; elsif Input_Msg.Card(5) = 'C' then Valid_Msg.Trtype := CHANGE; elsif Input_Msg.Card(5) = 'D' then Valid_Msg.Trtype := DELETE; elsif Input_Msg.Card(5) = 'R' then Valid_Msg.Trtype := REPLACE; else Validating_Field_Name := "TRTYP"; Error_Msg_Type := Bad_Field; raise constraint_error; end if; -- Valid_Msg.Uic := Input_Msg.card(9..14); Validate_Uic(Valid_Msg.Uic,"UIC "); -- -- convert and validate Originator's UIC field -- begin if Input_Msg.card(70..75) /= Header_Oruic then Error_Message("ORUIC",Bad_Field); else Valid_Msg.Oruic := Oruic_Types'value(Header_Oruic); end if; exception when others => null; end; -- -- validate report number -- if Input_Msg.card(78..80) /= Header_Report_Number then Error_Message("RPTNR",Bad_Field); else Validate_Numeric(Input_Msg.card(78..80),"RPTNR"); end if; end Validate_Common_Data; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a Header card. -- --********************************************************************** procedure Process_Card_H is begin -- -- set up new access pointer to card H -- Card_H := new Card_Type_H; -- -- validate and place card sequence number in card number field -- begin Card_H.Card_Number := Seq_Number; exception when others => Error_Message("CRDSQ",Bad_Field); end; -- -- convert and validate security classification -- begin Working_String := " "; Working_String(1..1) := Input_Msg.card(4..4); Valid_Msg.Secur := Secur_Types'value(Working_String); exception when others => Error_Message("SECUR",Bad_Field); end; -- -- convert and validate "as of" date field -- Header_Date := " "; Header_Year := 0; Header_Month := 0; Header_Day := 0; begin Working_String := " "; Working_String(1..2) := Input_Msg.card(9..10); Card_H.Day := string_to_integer(Working_String(1..2)); Working_String := " "; Working_String(1..3) := Input_Msg.card(16..18); Card_H.Month := Month_Types'value(Working_String); Working_String := " "; Working_String(1..2) := Input_Msg.card(19..20); Card_H.Year := string_to_integer(Working_String(1..2)); Leap_Year := Card_H.Year / 4; Leap_Year := Leap_Year - (Card_H.Year * 4); if Leap_Year = 0 then Days_in_Month(2) := 29; else Days_in_Month(2) := 28; end if; if Card_H.Day > Days_in_Month((Month_Types'pos(Card_H.Month) + 1)) then raise constraint_error; end if; Working_String(1..3) := integer_to_string((Month_Types'pos(Card_H.Month) + 1)); Header_Date := Input_Msg.Card(19..20) & Working_String(2..3) & Input_Msg.card(9..10); Header_Year := Card_H.Year; Header_Month := Month_Types'pos(Card_H.Month) + 1; Header_Day := Card_H.Day; exception when others => Error_Message("as of",Bad_Field); end; -- -- validate and convert Real or Exercise field -- begin Working_String := " "; Working_String(1..1) := Input_Msg.card(21..21); Card_H.Real_or_Exercise := Real_or_Exercise_Types'value(Working_String); exception when others => Error_Message("REXER",Bad_Field); end; -- -- convert and validate Originator's UIC field -- begin Header_Oruic := Input_Msg.card(70..75); Valid_Msg.Oruic := Oruic_Types'value(Header_Oruic); exception when others => Error_Message("ORUIC",Bad_Field); end; -- -- validate report number -- Header_Report_Number := Input_Msg.card(78..80); Validate_Numeric(Header_Report_Number,"RPTNR"); -- -- if card is valid place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_h := Card_H; Link_List; end if; end Process_Card_H; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "A " card. -- --********************************************************************** procedure Process_Card_A is begin -- -- set up new access pointer to card A -- Card_A := new Card_Type_A; -- -- place strings in field components -- Card_A.Udc := Input_Msg.card(15..15); Card_A.Aname := Input_Msg.card(16..45); Card_A.Utc := Input_Msg.card(46..50); Card_A.Ulc := Input_Msg.card(51..53); Card_A.Mjcom := Input_Msg.card(54..59); Card_A.Major := Input_Msg.card(60..60); Card_A.Reval := Input_Msg.card(61..61); Card_A.Tpsn := Input_Msg.card(62..68); Card_A.Sclas := Input_Msg.card(69..69); -- Validate_Ulc(Card_A.Ulc,"ULC "); -- -- validate MJCOM field. this field is required if transaction -- type is "A" -- if Card_A.Mjcom /= " " then Validate_Oruic(Card_A.Mjcom,"MJCOM"); elsif Valid_Msg.Trtype = ADD then Error_Message("MJCOM",Field_Required); end if; -- begin if Card_A.Major /= " " then if Card_A.Major = "#" and Valid_Msg.Trtype = CHANGE then null; else Major_Type := Major_Types'value(Card_A.Major); end if; end if; exception when others => Error_Message("MAJOR",Bad_Field); end; -- -- validate REVAL and UDC fields. if UDC is blank REVAL must be -- blank. if UDC is one of the following "A B C D E F T U V W X Y -- Z" REVAL must be "X". if UDC is one of the following "1 3 5 7 -- 9 G H J K L N P Q R S" REVAL must be "R". if UDC in one of -- the following "0 2 4 6 8 G H J K L N P Q R S" REVAL must be "G". -- begin if Card_A.Udc = " " then if Card_A.Reval /= " " then Error_Message("REVAL",Bad_Field); end if; else Validate_Udc(Card_A.Udc,"UDC "); if Udc_Valid then Reval_Type := Reval_Types'value(Card_A.Reval); if Valid_Value < 0 then if Udc_type < G and Reval_Type /= X then Error_Message("REVAL",Bad_Field); elsif Udc_Type > Z and Reval_Type = X then Error_Message("REVAL",Bad_Field); end if; elsif (Valid_Value = 1 or Valid_Value = 3 or Valid_Value = 5 or Valid_Value = 7 or Valid_Value = 9) and Reval_Type /= R then Error_Message("REVAL",Bad_Field); elsif (Valid_Value = 0 or Valid_Value = 2 or Valid_Value = 4 or Valid_Value = 6 or Valid_Value = 8) and Reval_Type /= G then Error_Message("REVAL",Bad_Field); end if; end if; end if; exception when others => Error_Message("REVAL",Bad_Field); end; -- -- validation of TPSN if char 1-5 are blank char 6-7 must be blank -- if char 1-5 is not blank, char 1-5 must be numeric, char 6-7 -- must be numeric or blank -- if Card_A.Tpsn(1..5) = " " then if Card_A.Tpsn(6..7) /= " " then Error_Message("TPSN ",Bad_Field); end if; else Validate_Numeric(Card_A.Tpsn(1..5),"TPSN "); Validate_Numeric(Card_A.Tpsn(6..7),"TPSN "); end if; -- -- if SCLAS is reported, it must be <= SECUR. if not reported -- and transaction type is Add, set SCLAS = SECUR. -- begin if Card_A.Sclas /= " " then Secur_Type := Secur_Types'value(Card_A.Sclas); if Secur_Type > Valid_Msg.Secur then Error_Message("SCLAS",Bad_Field); end if; elsif Valid_Msg.Trtype = ADD then Card_A.Sclas := Secur_Types'image(Valid_Msg.Secur); end if; exception when others => Error_Message("SCLAS",Bad_Field); end; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_a := Card_A; Link_List; end if; end Process_Card_A; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "B " card. -- --********************************************************************** procedure Process_Card_B is begin -- -- set up new access pointer for card B -- Card_B := new Card_Type_B; -- -- place strings in field components -- Card_B.Lname := Input_Msg.card(15..69); -- -- LNAME must be reported when transaction is either an Add or -- Change -- case Valid_Msg.Trtype is when ADD | CHANGE => if Card_B.Lname = " " & " " then Error_Message("LNAME",Field_Required); end if; when others => null; end case; -- -- if card is valid, place access pointer in message list and -- set up a new access pointer for message list -- if not Bad_Message then Valid_Msg.access_b := Card_B; Link_List; end if; end Process_Card_B; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "C " card. -- --********************************************************************** procedure Process_Card_C is begin -- -- set up new access pointer for card C -- Card_C := new Card_Type_C; -- -- place strings in field components -- Card_C.Udc := Input_Msg.card(15..15); Card_C.Aname := Input_Msg.card(16..45); Card_C.Utc := Input_Msg.card(46..50); Card_C.Ulc := Input_Msg.card(51..53); Card_C.Coaff := Input_Msg.card(54..55); Card_C.Monor := Input_Msg.card(56..61); Card_C.Sclas := Input_Msg.card(69..69); -- Validate_Udc(Card_C.Udc,"UDC "); -- Validate_Ulc(Card_C.Ulc,"ULC "); -- begin if Card_C.Coaff /= " " then if Card_C.Coaff = "DO" or Card_C.Coaff = "IN" or Card_C.Coaff = "IS" then null; else Coaff_Type := Coaff_Types'value(Card_C.Coaff); end if; end if; exception when others => Error_Message("COAFF",Bad_Field); end; -- -- validate MONOR field. required to be reported if transaction -- type is "A" -- if Card_C.Monor /= " " then Validate_Oruic(Card_C.Monor,"MONOR"); elsif Valid_Msg.Trtype = ADD then Error_Message("MONOR",Field_Required); end if; -- -- if SCLAS is reported must be <= SECUR. if not reported -- and transaction type is Add, then set SCLAS = SECUR. -- begin if Card_C.Sclas /= " " then Secur_Type := Secur_Types'value(Card_C.Sclas); if Secur_Type > Valid_Msg.Secur then Error_Message("SCLAS",Bad_Field); end if; elsif Valid_Msg.Trtype = ADD then Card_C.Sclas := Secur_Types'image(Valid_Msg.Secur); end if; exception when others => Error_Message("SCLAS",Bad_Field); end; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_c := Card_C; Link_List; end if; end Process_Card_C; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "D " card. -- --********************************************************************** procedure Process_Card_D is begin -- -- set up new access pointer for card D -- Card_D := new Card_Type_D; -- -- place strings in field components -- Card_D.Cserv := Input_Msg.card(15..15); Card_D.Opcon := Input_Msg.card(16..21); Card_D.Adcon := Input_Msg.card(22..27); Card_D.Hogeo := Input_Msg.card(28..31); Card_D.Prgeo := Input_Msg.card(32..35); Card_D.Embrk := Input_Msg.card(36..41); Card_D.Activ := Input_Msg.card(42..43); Card_D.Flag := Input_Msg.card(44..44); Card_D.Puic := Input_Msg.card(45..50); Card_D.Cbcom := Input_Msg.card(51..51); Card_D.Dfcon := Input_Msg.card(52..52); Card_D.Point := Input_Msg.card(53..67); Card_D.Nucin := Input_Msg.card(68..68); Card_D.Pctef := Input_Msg.card(69..69); -- -- if CSERV is reported must be 1-9 or C D A N F M E J -- begin if Card_D.Cserv /= " " then Valid_Value := string_to_integer(Card_D.Cserv); if Valid_Value < 1 then Cserv_Type := Cserv_Types'value(Card_D.Cserv); elsif Valid_Value > 9 then raise constraint_error; end if; end if; exception when others => Error_Message("CSERV",Bad_Field); end; -- if Card_D.Opcon /= " " then Validate_Uic(Card_D.Opcon,"OPCON"); end if; -- if Card_D.Adcon /= " " then Validate_Uic(Card_D.Adcon,"ADCON"); end if; -- -- if HOGEO is reported it will be validated against an IDM -- database relation Geoloc -- -- Card_D.Hogeo -- -- if PRGEO is reported it will be validated against an IDM -- database relation Geoloc -- -- Card_D.Prgeo -- -- if transaction type is Add and PRGEO is blank, set PRGEO to -- HOGEO -- Validate_Geolocation(Card_D.Hogeo,"HOGEO"); -- if Card_D.Prgeo /= " " and Card_D.Embrk /= " " then Error_Message("",Mutually_Exclusive); elsif Card_D.Embrk /= " " then Validate_Uic(Card_D.Embrk,"EMBRK"); else Validate_Geolocation(Card_D.Prgeo,"PRGEO"); end if; -- if Valid_Msg.Trtype = ADD and Card_D.PRGEO = " " then Card_D.Prgeo := Card_D.Hogeo; end if; -- begin if Card_D.Activ /= " " then if Card_D.Activ /= "IN" then Activ_Type := Activ_Types'value(Card_D.Activ); end if; end if; exception when others => Error_Message("ACTIV",Bad_Field); end; -- begin if Card_D.Flag /= " " then if Card_D.Flag = "#" and Valid_Msg.Trtype = CHANGE then null; else Flag_Type := Flag_Types'value(Card_D.Flag); end if; end if; exception when others => Error_Message("FLAG ",Bad_Field); end; -- if Card_D.Puic /= " " then if Card_D.Puic = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_Uic(Card_D.Puic,"PUIC "); end if; end if; -- begin if Card_D.Cbcom /= " " then if Card_D.Cbcom = "#" and Valid_Msg.Trtype = CHANGE then null; else Cbcom_Type := Cbcom_Types'value(Card_D.Cbcom); end if; end if; exception when others => Error_Message("CBCOM",Bad_Field); end; -- -- if DFCON is reported,it must be 1-5 or N T V S R G -- begin if Card_D.Dfcon /= " " then Valid_Value := string_to_integer(Card_D.Dfcon); if Valid_Value not in 1..5 then Dfcon_Type := Dfcon_Types'value(Card_D.Dfcon); end if; end if; exception when others => Error_Message("DFCON",Bad_Field); end; -- begin if Card_D.Point /= " " then Valid_Value := string_to_integer(Card_D.Point(1..2)); if Valid_Value not in 0..90 then raise constraint_error; end if; Valid_Value := string_to_integer(Card_D.Point(3..4)); if Valid_Value not in 0..59 then raise constraint_error; end if; Valid_Value := string_to_integer(Card_D.Point(5..6)); if Valid_Value not in 0..59 then raise constraint_error; end if; if Card_D.Point(7) = 'N' or Card_D.Point(7) = 'S' then null; else raise constraint_error; end if; Valid_Value := string_to_integer(Card_D.Point(8..10)); if Valid_Value not in 0..180 then raise constraint_error; end if; Valid_Value := string_to_integer(Card_D.Point(11..12)); if Valid_Value not in 0..59 then raise constraint_error; end if; Valid_Value := string_to_integer(Card_D.Point(13..14)); if Valid_Value not in 0..59 then raise constraint_error; end if; if Card_D.Point(15) = 'E' or Card_D.Point(15) = 'W' then null; else raise constraint_error; end if; end if; exception when others => Error_Message("Point",Bad_Field); end; -- begin if Card_D.Nucin /= " " then Nucin_Type := Nucin_Types'value(Card_D.Nucin); end if; exception when others => Error_Message("NUCIN",Bad_Field); end; -- if Card_D.Pctef /= " " then if Card_D.Pctef = "#" and Valid_Msg.Trtype = CHANGE then null; else Valid_Value := string_to_integer(Card_D.Pctef); if Valid_Value = 2 or Valid_Value = 4 or Valid_Value = 6 or Valid_Value = 8 then Error_Message("PCTEF",Bad_Field); end if; end if; end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_d := Card_D; Link_List; end if; end Process_Card_D; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "G " card. -- --********************************************************************** procedure Process_Card_G is begin -- -- set up new access pointer for card G -- Card_G := new Card_Type_G; -- -- place strings in field components -- Card_G.Tcaa := Input_Msg.card(15..43); Card_G.Media := Input_Msg.card(44..44); Card_G.Tadc := Input_Msg.card(45..45); Card_G.Route := Input_Msg.card(46..52); Card_G.Rwdte.DDD := Input_Msg.card(53..55); Card_G.Rwdte.YY := Input_Msg.card(56..57); Card_G.Xrte := Input_Msg.card(58..64); Card_G.Xdate.DDD := Input_Msg.card(65..67); Card_G.Xdate.YY := Input_Msg.card(68..69); -- if Card_G.Tcaa = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("TCAA ",Bad_Field); end if; -- begin if Card_G.Media /= " " then Media_Type := Media_types'value(Card_G.Media); end if; exception when others => Error_Message("MEDIA",Bad_Field); end; -- begin if Card_G.Tadc /= " " then if Card_G.Tadc = "#" and Valid_Msg.Trtype = CHANGE then null; else Tadc_Type := Tadc_types'value(Card_G.Tadc); end if; end if; exception when others => Error_Message("TADC ",Bad_Field); end; -- if Card_G.Route = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("ROUTE",Bad_Field); end if; -- Validate_DDDYY(Card_G.Rwdte.DDD, Card_G.Rwdte.YY, "RWDTE"); -- -- XRTE and XDATE are mutually inclusive -- if Card_G.Xrte = " " and Card_G.Xdate.DDD & Card_G.Xdate.YY /= " " then Error_Message("XRTE ",Field_Required); elsif Card_G.Xrte /= " " and Card_G.Xdate.DDD & Card_G.Xdate.YY = " " then Error_Message("XDATE",Field_Required); else if Card_G.Xrte = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("XRTE ",Bad_Field); end if; Validate_DDDYY(Card_G.Xdate.DDD, Card_G.Xdate.YY, "XDATE"); end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_g := Card_G; Link_List; end if; end Process_Card_G; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "J " card. -- --********************************************************************** procedure Process_Card_J is begin -- -- set up new access pointer for card J -- Card_J := new Card_Type_J; -- -- place strings in field components -- Card_J.Tpers := Input_Msg.card(15..16); Card_J.Pegeo := Input_Msg.card(17..22); Card_J.Struc := Input_Msg.card(23..27); Card_J.Auth := Input_Msg.card(28..32); Card_J.Asgd := Input_Msg.card(33..37); Card_J.Postr := Input_Msg.card(38..42); Card_J.Deps := Input_Msg.card(49..53); Card_J.Tdeps := Input_Msg.card(54..58); Card_J.Caspw := Input_Msg.card(59..63); Card_J.Ccasp := Input_Msg.card(64..68); Card_J.Cceby := Input_Msg.card(69..69); -- -- validate TPERS must be reported -- begin if Card_J.Tpers = " " then Error_Message("TPERS",Field_Required); elsif Card_J.Tpers /= "AT" then Tpers_Type := Tpers_Types'value(Card_J.Tpers); end if; exception when others => Error_Message("TPERS",Bad_Field); end; -- -- if PEGEO is reported it will be validated against an IDM -- database relation either the Geolocation database or the -- Uic database. if PEGEO is blank and transaction is Change, -- then find the tuple for this unit in the "D" (Status data) -- relation, read the value of PRGEO or EMBRK (whichever one -- is non-blank), and set PEGEO to this value. -- if Card_J.Pegeo /= " " then if Invalid_Uic(Card_J.Pegeo) and Invalid_Geo(Card_J.Pegeo) then Error_Message("PEGEO",Bad_Field); end if; -- -- if transaction is Change, use PRGEO or EMBRK value stored in -- database. -- elsif Valid_Msg.Trtype = CHANGE then begin idm_command(idmrun,"return_status_prgeo $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Card_J.Pegeo(1..4),Length_of_String); if Card_J.Pegeo = " " then idm_command(idmrun,"return_status_embrk $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Card_J.Pegeo,Length_of_String); end if; exception when others => Error_Message("PEGEO",Can_Not_Validate_Correctly); end; end if; -- Validate_Numeric(Card_J.Struc,"STRUC"); Validate_Numeric(Card_J.Auth,"AUTH "); Validate_Numeric(Card_J.Asgd,"ASGD "); -- if Card_J.Postr = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_Numeric(Card_J.Postr,"POSTR"); end if; -- -- validate PICDA if blank put system date in PICDA -- begin if Input_Msg.card(43..48) = " " then Card_J.Picda.Year := System_Year; Card_J.Picda.Month := System_Month; Card_J.Picda.Day := System_Day; else Valid_Value := string_to_integer(Input_Msg.card(43..44)); if Valid_Value < 0 then raise constraint_error; end if; Card_J.Picda.Year := Valid_Value + 1900; Leap_Year := Valid_Value /4; Leap_Year := Valid_Value - (Leap_Year * 4); if Leap_Year = 0 then Days_in_Month(2) := 29; else Days_in_Month(2) := 28; end if; Card_J.Picda.Month := string_to_integer(Input_Msg.card(45..46)); Card_J.Picda.Day := string_to_integer(Input_Msg.card(47..48)); if Card_J.Picda.Day > Days_in_Month(Card_J.Picda.Month) then raise constraint_error; end if; end if; exception when others => Error_Message("PICDA",Bad_Field); end; -- if Card_J.Deps = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_Numeric(Card_J.Deps,"DEPS "); end if; -- if Card_J.Tdeps = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_Numeric(Card_J.Tdeps,"TDEPS"); end if; -- -- CASPW and CCASP are mutually inclusive -- if Card_J.Caspw /= " " and Card_J.Ccasp = " " then Error_Message("CCASP",Field_Required); elsif Card_J.Caspw = " " and Card_J.Ccasp /= " " then Error_Message("CASPW",Field_Required); else Validate_Numeric(Card_J.Caspw,"CASPW"); Validate_Numeric(Card_J.Ccasp,"CCASP"); end if; -- begin if Card_J.Cceby /= " " then Cceby_Type := Cceby_Types'value(Card_J.Cceby); end if; exception when others => Error_Message("CCEBY",Bad_Field); end; -- -- if card is valid place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_j := Card_J; Link_List; end if; end Process_Card_J; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "K " card. -- --********************************************************************** procedure Process_Card_K is Ready_Value : integer; Prrat_Value : integer; Esrat_Value : integer; Errat_Value : integer; Trrat_Value : integer; begin -- -- initialize variables -- Ready_Value := 0; Prrat_Value := 0; Esrat_Value := 0; Errat_Value := 0; Trrat_Value := 0; -- -- set up access pointer for card K -- Card_K := new Card_Type_K; -- -- place strings in field components -- Card_K.Tread := Input_Msg.card(15..19); Card_K.Ready := Input_Msg.card(20..20); Card_K.Reasn := Input_Msg.card(21..21); Card_K.Prrat := Input_Msg.card(22..22); Card_K.Prres := Input_Msg.card(23..25); Card_K.Esrat := Input_Msg.card(26..26); Card_K.Esres := Input_Msg.card(27..29); Card_K.Errat := Input_Msg.card(30..30); Card_K.Erres := Input_Msg.card(31..33); Card_K.Trrat := Input_Msg.card(34..34); Card_K.Trres := Input_Msg.card(35..37); Card_K.Secrn := Input_Msg.card(38..40); Card_K.Terrn := Input_Msg.card(41..43); Card_K.Carat := Input_Msg.card(44..44); Card_K.Cadat.YY := Input_Msg.card(45..46); Card_K.Cadat.MM := Input_Msg.card(47..48); Card_K.Cadat.DD := Input_Msg.card(49..50); Card_K.Lim := Input_Msg.card(51..51); Card_K.Rlim := Input_Msg.card(52..52); Card_K.Ricda.YY := Input_Msg.card(53..54); Card_K.Ricda.MM := Input_Msg.card(55..56); Card_K.Ricda.DD := Input_Msg.card(57..58); -- -- if TREAD is reported must be JCRR1 POMCS or 001HRS - 072HRS -- begin if Card_K.Tread /= " " then if Card_K.Tread(3..5) = "HRS" then Valid_Value := string_to_integer(Card_K.Tread(1..2)); if Valid_Value not in 1..72 then raise constraint_error; end if; else Tread_Type := Tread_Types'value(Card_K.Tread); end if; end if; exception when others => Error_Message("TREAD",Bad_Field); end; -- if Card_K.Ready /= " " then Ready_Value := string_to_integer(Card_K.Ready); if Ready_Value not in 1..5 then Error_Message("READY",Bad_Field); end if; end if; -- if Card_K.Prrat /= " " then Prrat_Value := string_to_integer(Card_K.Prrat); if Prrat_Value not in 1..6 then Error_Message("PRRAT",Bad_Field); elsif Prrat_Value /= 6 and Card_K.Reasn /= "X" then if Prrat_Value > Ready_Value then Error_Message("PRRAT",Bad_Field); end if; end if; end if; -- begin if Card_K.Prres = " " then if Prrat_Value in 2..4 then Error_Message("PRRES",Field_Required); end if; else Prres_Type := Prres_Prres_Types'value(Card_K.Prres); end if; exception when others => Error_Message("PRRES",Bad_Field); end; -- if Card_K.Esrat /= " " then Esrat_Value := string_to_integer(Card_K.Esrat); if Esrat_Value not in 1..6 then Error_Message("ESRAT",Bad_Field); elsif Esrat_Value /= 6 and Card_K.Reasn /= "X" then if Esrat_Value > Ready_Value then Error_Message("ESRAT",Bad_Field); end if; end if; end if; -- begin if Card_K.Esres = " " then if Esrat_Value in 2..4 then Error_Message("ESRES",Field_Required); end if; else Esres_Type := Esres_Prres_Types'value(Card_K.Esres); end if; exception when others => Error_Message("ESRES",Bad_Field); end; -- if Card_K.Errat /= " " then Errat_Value := string_to_integer(Card_K.Errat); if Errat_Value not in 1..6 then Error_Message("ERRAT",Bad_Field); elsif Errat_Value /= 6 and Card_K.Reasn /= "X" then if Errat_Value > Ready_Value then Error_Message("ERRAT",Bad_Field); end if; end if; end if; -- begin if Card_K.Erres = " " then if Errat_Value in 2..4 then Error_Message("ERRES",Field_Required); end if; else Erres_Type := Erres_Prres_Types'value(Card_K.Erres); end if; exception when others => Error_Message("ERRES",Bad_Field); end; -- if Card_K.Trrat /= " " then Trrat_Value := string_to_integer(Card_K.Trrat); if Trrat_Value not in 1..6 then Error_Message("TRRAT",Bad_Field); elsif Trrat_Value /= 6 and Card_K.Reasn /= "X" then if Trrat_Value > Ready_Value then Error_Message("TRRAT",Bad_Field); end if; end if; end if; -- begin if Card_K.Trres = " " then if Trrat_Value in 2..4 then Error_Message("TRRES",Field_Required); end if; else Trres_Type := Trres_Prres_Types'value(Card_K.Trres); end if; exception when others => Error_Message("TRRES",Bad_Field); end; -- begin if Card_K.Reasn /= " " then Reasn_Type := Reasn_Types'value(Card_K.Reasn); case Reasn_Type is when N | M => if Ready_Value /= 5 then Error_Message("READY",Bad_Field); end if; when X => if Card_K.Ready = " " then Error_Message("READY",Field_Required); end if; when others => Valid_Value := 0; if Prrat_Value /= 6 and Prrat_Value > Valid_Value then Valid_Value := Prrat_Value; end if; if Esrat_Value /= 6 and Esrat_Value > Valid_Value then Valid_Value := Esrat_Value; end if; if Errat_Value /= 6 and Errat_Value > Valid_Value then Valid_Value := Errat_Value; end if; if Trrat_Value /= 6 and Trrat_Value > Valid_Value then Valid_Value := Trrat_Value; end if; if Ready_Value /= Valid_Value then Error_Message("READY",Bad_Field); end if; end case; end if; exception when others => Error_Message("REASN",Bad_Field); end; -- -- if SECRN is reported, REASN must be reported on this card or be -- stored already in the database. -- begin if Card_K.Secrn /= " " then if Valid_Msg.Trtype = ADD and Card_K.Reasn = " " then Error_Message("REASN",Field_Required); end if; if Valid_Msg.Trtype = CHANGE and Card_K.Reasn = " " then begin idm_command(idmrun,"return_readiness_reason $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Working_String(1..1),Length_of_String); if Working_String(1..1) = " " then Error_Message("REASN",Field_Required); end if; exception when others => Error_Message("REASN",Can_Not_Validate_Correctly); end; end if; if Valid_Msg.Trtype = CHANGE and Card_K.Secrn = "# " then null; else Secrn_Type := Prres_Types'value(Card_K.Secrn); end if; end if; exception when others => Error_Message("SECRN",Bad_Field); end; -- -- if TERRN is reported, REASN and SECRN must be reported on this -- card or be stored already in the database. TERRN must not be -- equal to SECRN. -- begin if Card_K.Terrn /= " " then if Valid_Msg.Trtype = ADD then if Card_K.Reasn = " " then Error_Message("REASN",Field_Required); end if; if Card_K.Secrn = " " then Error_Message("SECRN",Field_Required); end if; elsif Valid_Msg.Trtype = CHANGE then begin Working_String := " "; if Card_K.Secrn = " " then idm_command(idmrun,"return_readiness_reason2 $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Working_String(1..1),Length_of_String); if Working_String(1..1) = " " then Error_Message("SECRN",Field_Required); else Secrn_Type := Prres_Types'value(Working_String); end if; end if; if Card_K.Reasn = " " then idm_command(idmrun,"return_readiness_reason $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Working_String(1..1),Length_of_String); if Working_String(1..1) = " " then Error_Message("REASN",Field_Required); end if; end if; exception when others => Error_Message("TERRN",Can_Not_Validate_Correctly); end; end if; if Valid_Msg.Trtype = CHANGE and Card_K.Terrn = "# " then null; else Terrn_Type := Prres_Types'value(Card_K.Terrn); if Terrn_Type = Secrn_Type then Error_Message("TERRN",Bad_Field); end if; end if; end if; exception when others => Error_Message("TERRN",Bad_Field); end; -- -- CARAT and CADAT are mutually inclusive and are fields that can -- be "#" when transaction is Change. CARAT must not be equal to -- READY. CADAT must not be < Header Date. -- if (Card_K.Carat = " " and Card_K.Cadat.YY & Card_K.Cadat.MM & Card_K.Cadat.DD = " ") or (Valid_Msg.Trtype = CHANGE and Card_K.Carat = "#" and Card_K.Cadat.YY & Card_K.Cadat.MM & Card_K.Cadat.DD = "# ") then null; elsif Card_K.Carat = " " then Error_Message("CARAT",Field_Required); elsif Card_K.Cadat.YY & Card_K.Cadat.MM & Card_K.Cadat.DD = " " then Error_Message("CADAT",Field_Required); else -- -- if CARAT is reported must equal 1 2 3 4 5 6 and not be equal to -- READY -- Valid_Value := string_to_integer(Card_K.Carat); if Valid_Value not in 1..6 or Card_K.Carat = Card_K.Ready then Error_Message("CARAT",Bad_Field); end if; -- -- if CADAT is reported it must be > the header date -- if Card_K.Cadat.YY & Card_K.Cadat.MM & Card_K.Cadat.DD <= Header_Date then Error_Message("CADAT",Bad_Field); else Validate_YYMMDD(Card_K.Cadat.YY, Card_K.Cadat.MM, Card_K.Cadat.DD, "CADAT"); end if; end if; -- if Card_K.Lim /= " " then if Valid_Msg.Trtype = CHANGE and Card_K.Lim = "#" then null; else Valid_Value := string_to_integer(Card_K.Lim); if Valid_Value not in 1..6 or Card_K.Lim = Card_K.Ready then Error_Message("LIM ",Bad_Field); end if; end if; end if; -- begin if Card_K.Rlim /= " " then if Valid_Msg.Trtype = CHANGE and Card_K.Rlim = "#" then null; else Rlim_Type := Rlim_Types'value(Card_K.Rlim); end if; end if; exception when others => Error_Message("RLIM ",Bad_Field); end; -- -- if reported RICDA can not be < RICDA stored in database if -- transaction type is "C" -- if Card_K.Ricda.YY & Card_K.Ricda.MM & Card_K.Ricda.DD /= " " then Validate_YYMMDD(Card_K.Ricda.YY, Card_K.Ricda.MM, Card_K.Ricda.DD, "RICDA"); if Valid_Msg.Trtype = CHANGE then begin Working_String := " "; idm_command(idmrun,"return_readiness_ricda $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Working_String(1..8),Length_of_String); exception when others => Error_Message("RICDA",Can_Not_Validate_Correctly); end; end if; end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_k := Card_K; Link_List; end if; end Process_Card_K; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "L " card. -- --********************************************************************** procedure Process_Card_L is begin -- -- initialize variables -- Mepsd_Value := 0; Meord_Value := 0; Meorn_Value := 0; Meorc_Value := 0; Meoro_Value := 0; Crewf_Value := 0; Crmrd_Value := 0; Crmrn_Value := 0; Crmrc_Value := 0; Crmro_Value := 0; -- -- set up new access pointer for card L -- Card_L := new Card_Type_L; -- -- place strings in field components -- Card_L.Meqpt := Input_Msg.card(15..27); Card_L.Fordv := Input_Msg.card(28..28); Card_L.Mepsa := Input_Msg.card(29..31); Card_L.Metal := Input_Msg.card(32..34); Card_L.Mepsd := Input_Msg.card(35..37); Card_L.Meord := Input_Msg.card(38..40); Card_L.Meorn := Input_Msg.card(41..43); Card_L.Meorc := Input_Msg.card(44..46); Card_L.Meoro := Input_Msg.card(47..49); Card_L.Crewa := Input_Msg.card(50..51); Card_L.Creal := Input_Msg.card(52..53); Card_L.Crewf := Input_Msg.card(54..55); Card_L.Crmrd := Input_Msg.card(56..57); Card_L.Crmrn := Input_Msg.card(58..59); Card_L.Crmrc := Input_Msg.card(60..61); Card_L.Crmro := Input_Msg.card(62..63); Card_L.Merec_1 := Input_Msg.card(64..65); Card_L.Merec_2 := Input_Msg.card(66..67); Card_L.Merec_3 := Input_Msg.card(68..69); -- -- MEQPT is required to be reported -- if Card_L.Meqpt = " " then Error_Message("MEQPT",Field_Required); else Validate_Meqpt(Card_L.Meqpt,"MEQPT"); end if; -- begin if Card_L.Fordv /= " " then Fordv_Type := Fordv_Types'value(Card_L.Fordv); end if; exception when others => Error_Message("FORDV",Bad_Field); end; -- Validate_Numeric(Card_L.Mepsa,"MEPSA"); Validate_Numeric(Card_L.Metal,"METAL"); -- if Card_L.Mepsd /= " " then Mepsd_Value := string_to_integer(Card_L.Mepsd); if Mepsd_Value < 0 then Error_Message("MEPSD",Bad_Field); else Load_Meq_Values; end if; end if; -- if Card_L.Meord /= " " then Meord_Value := string_to_integer(Card_L.Meord); if Meord_Value < 0 then Error_Message("MEORD",Bad_Field); end if; end if; -- if Card_L.Meorn /= " " then Meorn_Value := string_to_integer(Card_L.Meorn); if Meorn_Value < 0 then Error_Message("MEORN",Bad_Field); end if; end if; -- if Card_L.Meorc /= " " then Meorc_Value := string_to_integer(Card_L.Meorc); if Meorc_Value < 0 then Error_Message("MEORC",Bad_Field); end if; end if; -- if Card_L.Meoro /= " " then Meoro_Value := string_to_integer(Card_L.Meoro); if Meoro_Value < 0 then Error_Message("MEORO",Bad_Field); end if; end if; -- -- if MEPSD is reported, the four fields being add together below -- must be reported at the same time or have values already in the -- database. -- if Mepsd_Value < 0 or Mepsd_Value < Meord_Value + Meorn_Value + Meorc_Value + Meoro_Value then Error_Message("MEPSD",Bad_Field); end if; -- Validate_Numeric(Card_L.Crewa,"CREWA"); Validate_Numeric(Card_L.Creal,"CREAL"); -- if Card_L.Crewf /= " " then Crewf_Value := string_to_integer(Card_L.Crewf); if Crewf_Value < 0 then Error_Message("CREWF",Bad_Field); else Load_Crew_Values; end if; end if; -- if Card_L.Crmrd /= " " then Crmrd_Value := string_to_integer(Card_L.Crmrd); if Crmrd_Value < 0 then Error_Message("CRMRD",Bad_field); end if; end if; -- if Card_L.Crmrn /= " " then Crmrn_Value := string_to_integer(Card_L.Crmrn); if Crmrn_Value < 0 then Error_Message("CRMRN",Bad_field); end if; end if; -- if Card_L.Crmrc /= " " then Crmrc_Value := string_to_integer(Card_L.Crmrc); if Crmrc_Value < 0 then Error_Message("CRMRC",Bad_field); end if; end if; -- if Card_L.Crmro /= " " then Crmro_Value := string_to_integer(Card_L.Crmro); if Crmro_Value < 0 then Error_Message("CRMRO",Bad_field); end if; end if; -- -- if CREWF is reported, the four fields being add together below -- must be reported at the same time or have values already in the -- database. -- if Crewf_Value < 0 or Crewf_Value < Crmrd_Value + Crmrn_Value + Crmrc_Value + Crmro_Value then Error_Message("CREWF",Bad_Field); end if; -- begin if Card_L.Merec_1 /= " " then if Card_L.Merec_1 /= "# " then Merec_Type := Merec_Types'value(Card_L.Merec_1); end if; end if; if Card_L.Merec_2 /= " " then if Card_L.Merec_2 /= "# " then Merec_Type := Merec_Types'value(Card_L.Merec_2); end if; end if; if Card_L.Merec_3 /= " " then if Card_L.Merec_3 /= "# " then Merec_Type := Merec_Types'value(Card_L.Merec_3); end if; end if; exception when others => Error_Message("MEREC",Bad_Field); end; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_l := Card_L; Link_List; end if; end Process_Card_L; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "M " card. -- --********************************************************************** procedure Process_Card_M is begin -- -- initialize variables -- Mepsd_Value := 0; Meord_Value := 0; Meorn_Value := 0; Meorc_Value := 0; Meoro_Value := 0; Crewf_Value := 0; Crmrd_Value := 0; Crmrn_Value := 0; Crmrc_Value := 0; Crmro_Value := 0; -- -- set up new access pointer for card M -- Card_M := new Card_Type_M; -- -- place strings in field components -- Card_M.Meqpt := Input_Msg.card(15..27); Card_M.Tegeo := Input_Msg.card(28..33); Card_M.Mepsd := Input_Msg.card(34..36); Card_M.Meord := Input_Msg.card(37..39); Card_M.Meorn := Input_Msg.card(40..42); Card_M.Meorc := Input_Msg.card(43..45); Card_M.Meoro := Input_Msg.card(46..48); Card_M.Crewf := Input_Msg.card(49..50); Card_M.Crmrd := Input_Msg.card(51..52); Card_M.Crmrn := Input_Msg.card(53..54); Card_M.Crmrc := Input_Msg.card(55..56); Card_M.Crmro := Input_Msg.card(57..58); Card_M.Merec_1 := Input_Msg.card(59..60); Card_M.Merec_2 := Input_Msg.card(61..62); Card_M.Merec_3 := Input_Msg.card(63..64); -- -- MEQPT must be reported -- if Card_M.Meqpt = " " then Error_Message("MEQPT",Field_Required); else Validate_Meqpt(Card_M.Meqpt,"MEQPT"); end if; -- -- if TEGEO is reported it will be validated against an IDM -- database relation, either the Geoloc or UIC. -- if Card_M.Tegeo = " " then Error_Message("TEGEO",Field_Required); elsif Invalid_Uic(Card_M.Tegeo) and Invalid_Geo(Card_M.Tegeo) then Error_Message("TEGEO",Field_Required); end if; -- -- if Card_M.Mepsd /= " " then Mepsd_Value := string_to_integer(Card_M.Mepsd); if Mepsd_Value < 0 then Error_Message("MEPSD",Bad_Field); else Load_Meq_Values; end if; end if; -- if Card_M.Meord /= " " then Meord_Value := string_to_integer(Card_M.Meord); if Meord_Value < 0 then Error_Message("MEORD",Bad_Field); end if; end if; -- if Card_M.Meorn /= " " then Meorn_Value := string_to_integer(Card_M.Meorn); if Meorn_Value < 0 then Error_Message("MEORN",Bad_Field); end if; end if; -- if Card_M.Meorc /= " " then Meorc_Value := string_to_integer(Card_M.Meorc); if Meorc_Value < 0 then Error_Message("MEORC",Bad_Field); end if; end if; -- if Card_M.Meoro /= " " then Meoro_Value := string_to_integer(Card_M.Meoro); if Meoro_Value < 0 then Error_Message("MEORO",Bad_Field); end if; end if; -- -- if MEPSD is reported, the four fields being add together below -- must be reported at the same time or have values already in the -- database. -- if Mepsd_Value < 0 or Mepsd_Value < Meord_Value + Meorn_Value + Meorc_Value + Meoro_Value then Error_Message("MEPSD",Bad_Field); end if; -- if Card_M.Crewf /= " " then Crewf_Value := string_to_integer(Card_M.Crewf); if Crewf_Value < 0 then Error_Message("CREWF",Bad_Field); else Load_Crew_Values; end if; end if; -- if Card_M.Crmrd /= " " then Crmrd_Value := string_to_integer(Card_M.Crmrd); if Crmrd_Value < 0 then Error_Message("CRMRD",Bad_field); end if; end if; -- if Card_M.Crmrn /= " " then Crmrn_Value := string_to_integer(Card_M.Crmrn); if Crmrn_Value < 0 then Error_Message("CRMRN",Bad_field); end if; end if; -- if Card_M.Crmrc /= " " then Crmrc_Value := string_to_integer(Card_M.Crmrc); if Crmrc_Value < 0 then Error_Message("CRMRC",Bad_field); end if; end if; -- if Card_M.Crmro /= " " then Crmro_Value := string_to_integer(Card_M.Crmro); if Crmro_Value < 0 then Error_Message("CRMRO",Bad_field); end if; end if; -- -- if CREWF is reported, the four fields being add together below -- must be reported at the same time or have values already in the -- database. -- if Crewf_Value < 0 or Crewf_Value < Crmrd_Value + Crmrn_Value + Crmrc_Value + Crmro_Value then Error_Message("CREWF",Bad_Field); end if; -- begin if Card_M.Merec_1 /= " " then if Card_M.Merec_1 /= "# " then Merec_Type := Merec_Types'value(Card_M.Merec_1); end if; end if; if Card_M.Merec_2 /= " " then if Card_M.Merec_2 /= "# " then Merec_Type := Merec_Types'value(Card_M.Merec_2); end if; end if; if Card_M.Merec_3 /= " " then if Card_M.Merec_3 /= "# " then Merec_Type := Merec_Types'value(Card_M.Merec_3); end if; end if; exception when others => Error_Message("MEREC",Bad_Field); end; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_m := Card_M; Link_List; end if; end Process_Card_M; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "N " card. -- --********************************************************************** procedure Process_Card_N is begin -- -- set up new access pointer for card N -- Card_N := new Card_Type_N; -- -- place strings in field components -- Card_N.Pin := Input_Msg.card(15..19); Card_N.Frqno := Input_Msg.card(20..24); Card_N.Pleac := Input_Msg.card(25..25); Card_N.Ddp := Input_Msg.card(26..27); Card_N.Ddprd.YY := Input_Msg.card(28..29); Card_N.Ddprd.MM := Input_Msg.card(30..31); Card_N.Ddprd.DD := Input_Msg.card(32..33); Card_N.Ddprd.HH := Input_Msg.card(34..35); Card_N.Mdt.DDD := Input_Msg.card(36..38); Card_N.Mdt.HH := Input_Msg.card(39..40); Card_N.Putc := Input_Msg.card(41..45); -- -- PIN is required to be reported -- if Card_N.Pin = " " then Error_Message("PIN ",Field_Required); else Validate_Pin(Card_N.Pin,"PIN "); end if; -- begin if Card_N.Pleac /= " " then Pleac_Type := Pleac_Types'value(Card_N.Pleac); end if; exception when others => Error_Message("PLEAC",Bad_Field); end; -- begin if Card_N.Ddp /= " " then if Card_N.Ddprd.YY & Card_N.Ddprd.MM & Card_N.Ddprd.DD = " " then Error_Message("DDPRD",Field_Required); end if; if Card_N.Mdt.DDD & Card_N.Mdt.HH = " " then Error_Message("MDT ",Field_Required); end if; Ddp_Type := Ddp_Types'value(Card_N.Ddp); end if; exception when others => Error_Message("DDP ",Bad_Field); end; -- if Card_N.Ddprd.YY /= " " or Card_N.Ddprd.MM /= " " or Card_N.Ddprd.DD /= " " or Card_N.Ddprd.HH /= " " then if Card_N.Ddp = " " then Error_Message("DDP ",Field_Required); end if; if Card_N.Mdt.DDD & Card_N.Mdt.HH = " " then Error_Message("MDT ",Field_Required); end if; if Card_N.Ddprd.YY & Card_N.Ddprd.MM & Card_N.Ddprd.DD = " " then Error_Message("DDPRD",Bad_Field); else Validate_YYMMDD(Card_N.Ddprd.YY, Card_N.Ddprd.MM, Card_N.Ddprd.DD, "DDPRD"); Valid_Value := string_to_integer(Card_N.Ddprd.HH); if Valid_Value not in 0..23 then Error_Message("DDPRD",Bad_Field); end if; end if; end if; -- if Card_N.Mdt.DDD /= " " or Card_N.Mdt.HH /= " " then if Card_N.Ddprd.YY & Card_N.Ddprd.MM & Card_N.Ddprd.DD = " " then Error_Message("DDPRD",Field_Required); end if; if Card_N.Ddp = " " then Error_Message("DDP ",Field_Required); end if; Validate_Numeric(Card_N.Mdt.DDD,"MDT "); Valid_Value := string_to_integer(Card_N.Mdt.HH); if Valid_Value not in 0..23 then Error_Message("MDT ",Bad_Field); end if; end if; -- -- if PUTCV is reported it will be validated against an IDM -- database relation Utc database. -- if Card_N.Putc = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("PUTCV",Bad_Field); end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_n := Card_N; Link_List; end if; end Process_Card_N; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "P " card. -- --********************************************************************** procedure Process_Card_P is begin -- -- set up new access pointer for card P -- Card_P := new Card_Type_P; -- -- validate and convert ALTYP -- begin Working_String := " "; Working_String(1..2) := Input_Msg.card(39..40); Card_P.Altyp := Altyp_Types'value(Working_String); exception when others => Error_Message("ALTYP",Bad_Field); end; -- -- place strings in field components -- Card_P.Pin := Input_Msg.card(15..19); Card_P.Meqpt := Input_Msg.card(20..32); Card_P.Tpgeo := Input_Msg.card(33..38); Card_P.Numbr := Input_Msg.card(41..43); Card_P.Numea := Input_Msg.card(44..46); Card_P.Alret.HHH := Input_Msg.card(47..49); Card_P.Alret.MM := Input_Msg.card(50..51); -- -- PIN is required to be reported -- if Card_P.Pin = " " then Error_Message("PIN ",Field_Required); else Validate_Pin(Card_P.Pin,"PIN "); end if; -- -- MEQPT is required to be reported -- if Card_P.Meqpt = " " then Error_Message("MEQPT",Field_Required); else Validate_Meqpt(Card_P.Meqpt,"MEQPT"); end if; -- -- if TPGEO is reported it will be validated against an IDM -- database relation, either the Geoloc or UIC. -- if Card_P.Tpgeo /= " " then if Invalid_Uic(Card_P.Tpgeo) and Invalid_Geo(Card_P.Tpgeo) then Error_Message("TPGEO",Bad_Field); end if; end if; -- Validate_Numeric(Card_P.Numbr,"NUMBR"); Validate_Numeric(Card_P.Numea,"NUMEA"); -- if Card_P.Alret.HHH & Card_P.Alret.MM /= " " then Validate_Numeric(Card_P.Alret.HHH,"ALRET"); Valid_Value := string_to_integer(Card_P.Alret.MM); if Valid_Value not in 0..59 then Error_Message("ALRET",Bad_Field); end if; end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_p := Card_P; Link_List; end if; end Process_Card_P; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "Q " card. -- --********************************************************************** procedure Process_Card_Q is Working_Nuseq : string(1..1); Working_Wpnco : string(1..2); Working_Rfdgs : string(1..1); begin -- -- set up new access pointer for card Q -- Card_Q := new Card_Type_Q; -- -- place strings in field components -- Card_Q.Pin := Input_Msg.card(15..19); Card_Q.Nuseq := Input_Msg.card(20..22); Card_Q.Wpnco := Input_Msg.card(23..29); Card_Q.Nuqpt := Input_Msg.card(30..39); Card_Q.Dsgeo := Input_Msg.card(40..45); Card_Q.Altyp := Input_Msg.card(46..47); Card_Q.Numwr := Input_Msg.card(48..49); Card_Q.Numwb := Input_Msg.card(50..51); Card_Q.Nugun := Input_Msg.card(52..53); Card_Q.Rtime := Input_Msg.card(54..58); Card_Q.Dssta := Input_Msg.card(59..59); Card_Q.Rfdgs := Input_Msg.card(60..64); Card_Q.Nusto := Input_Msg.card(65..67); Card_Q.Nuecc := Input_Msg.card(68..69); -- -- PIN and ALTYP are mutually inclusive -- begin if Card_Q.Pin /= " " and Card_Q.Altyp = " " then Error_Message("ALTYP",Field_Required); elsif Card_Q.Pin = " " and Card_Q.Altyp /= " " then Error_Message("PIN ",Field_Required); else if Card_Q.Pin /= " " then Validate_Pin(Card_Q.Pin,"PIN "); end if; if Card_Q.Altyp /= " " then if Valid_Msg.Trtype = CHANGE and Card_Q.Altyp = "# " then null; else Altyp_Type := Altyp_Types'value(Card_Q.Altyp); end if; end if; end if; exception when others => Error_Message("ALTYP",Field_Required); end; -- -- NUSEQ is required to be reported and must be all numeric or -- 1st character alphabetic + 2 numeric. "ALL" is ok when -- tansaction is Change or Delete. -- begin if Card_Q.Nuseq = " " then Error_Message("NUSEQ",Field_Required); elsif (Valid_Msg.Trtype = ADD or Valid_Msg.Trtype = REPLACE) and Card_Q.Nuseq /= "ALL" then Valid_Value := string_to_integer(Card_Q.Nuseq); if Valid_Value < 0 then Working_Nuseq := Card_Q.Nuseq(1..1); Alphabetic_Type := Alphabetic_Types'value(Working_Nuseq); Valid_Value := string_to_integer(Card_Q.Nuseq(2..3)); if Valid_Value < 0 then Error_Message("NUSEQ",Bad_Field); end if; end if; end if; exception when others => Error_Message("NUSEQ",Bad_Field); end; -- -- if WPNCO is reported, not validated if NUSEQ = "ALL". if 1-6 -- characters, up to 3 groups of 2-character codes from the set -- (CO, EL, IR, PH, RA, SG, SL, VI) if 7 characters, perform -- lookup of valid codes in NUREP relation. -- begin if Card_Q.Nuseq = "ALL" then null; elsif Card_Q.Wpnco(7) /= ' ' then -- find WPNCO is NUREP database idm_command(idmrun,"return_wpnco $1"); idm_param(idmrun,"$1",Card_Q.Wpnco,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Card_Q.Wpnco,Length_of_String); else if Card_Q.Wpnco /= " " then Working_Wpnco := Card_Q.Wpnco(1..2); Wpnco_Type := Wpnco_Types'value(Working_Wpnco); Working_Wpnco := Card_Q.Wpnco(3..4); Wpnco_Type := Wpnco_Types'value(Working_Wpnco); Working_Wpnco := Card_Q.Wpnco(5..6); Wpnco_Type := Wpnco_Types'value(Working_Wpnco); end if; end if; exception when others => Error_Message("WPNCO",Bad_Field); end; -- -- NUQPT if reported can be "SHIP " or a code in the MEQPT -- database or Reconn code. Required to be reported when -- transaction is Add. -- if Card_Q.Nuqpt /= " " then if Card_Q.Nuqpt(3..10) = " " then begin Reconn_Type := Reconn_Types'value(Card_Q.Nuqpt); exception when others => Error_Message("NUQPT",Bad_Field); end; end if; if Card_Q.Nuqpt /= "SHIP " then Validate_Meqpt(Card_Q.Nuqpt,"NUQPT"); end if; elsif Valid_Msg.Trtype = ADD then Error_Message("NUQPT",Field_Required); end if; -- if Valid_Msg.Trtype = CHANGE and Card_Q.Numwr /= "# " then Validate_Numeric(Card_Q.Numwr,"NUMWR"); end if; -- -- NUMWB and NUSTO are mutually inclusive -- if Card_Q.Numwb /= " " and Card_Q.Nusto = " " then Error_Message("NUSTO",Field_Required); elsif Card_Q.Numwb = " " and Card_Q.Nusto /= " " then Error_Message("NUMWB",Field_Required); elsif Valid_Msg.Trtype = CHANGE and Card_Q.Numwb = "# " and Card_Q.Nusto /= "# " then Error_Message("NUSTO",Bad_Field); elsif Valid_Msg.Trtype = CHANGE and Card_Q.Numwb /= "# " and Card_Q.Nusto = "# " then Error_Message("NUMWB",Bad_Field); elsif Valid_Msg.Trtype /= CHANGE AND CARD_Q.Numwb /= "# " and Card_Q.Nusto /= "# " then Validate_Numeric(Card_Q.Numwb,"NUMWB"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_Q.Nugun /= "# " then Validate_Numeric(Card_Q.Nugun,"NUGUN"); end if; -- if Valid_Msg.Trtype /= CHANGE and Card_Q.Dssta = "#" then Error_Message("DSSTA",Bad_Field); end if; -- -- if RTIME is reported, it must be all numeric -- -- (NOTE: the following DSSTA codes are "degraded": D, N, E, 0) -- -- if the delivery system is meeting its committment (i.e., not -- degraded), the RTIME field will indicate a reaction time in -- the format HHHMM, where HHH is in the range 000-240 and MM is -- in the range 00-59. if "XXXXX" is entered in the RTIME field, -- store "NULL" in the database. -- -- if the delivery system is not meeting its committment (i.e., is -- degraded), then -- for Air Force units -- this field will show julian day and hour in the format -- DDDHH, where DDD is in the range 000-366 and HH is in -- the range 00-23 -- -- for Army and Marine Corp units, -- this field will show julian date in the format DDDYY. -- -- for Navy units, not applicable -- -- the service (AirForce, Army, or Marines) is determined by -- looking at the first character of the UIC in the common data -- fields -- if Card_Q.Rtime /= " " then if Valid_Msg.Trtype = CHANGE and Card_Q.Rtime = "# " then null; elsif Card_Q.Dssta = "D" or Card_Q.Dssta = "N" or Card_Q.Dssta = "E" or Card_Q.Dssta = "0" then if Valid_Msg.Uic(1) = 'F' then Valid_Value := string_to_integer(Card_Q.Rtime(1..3)); if Valid_Value not in 0..366 then Error_Message("RTIME",Bad_Field); else Valid_Value := string_to_integer(Card_Q.Rtime(4..5)); if Valid_Value not in 0..23 then Error_Message("RTIME",Bad_Field); end if; end if; elsif Valid_Msg.Uic(1) = 'W' or Valid_Msg.Uic(1) = 'M' then Validate_DDDYY(Card_Q.Rtime(1..3), Card_Q.Rtime(4..5), "RTIME"); else Error_Message("RTIME",Bad_Field); end if; elsif Card_Q.Rtime /= "XXXXX" then Valid_Value := string_to_integer(Card_Q.Rtime(1..3)); if Valid_Value not in 0..240 then Error_Message("RTIME",Bad_Field); else Valid_Value := string_to_integer(Card_Q.Rtime(4..5)); if Valid_Value not in 0..59 then Error_Message("RTIME",Bad_Field); end if; end if; end if; elsif Card_Q.Dssta = "D" or Card_Q.Dssta = "N" or Card_Q.Dssta = "E" or Card_Q.Dssta = "0" then Error_Message("RTIME",Field_Required); end if; -- -- RFDGS is required when DSSTA is "D", "N", "E" or "0" (zero) or -- when RTIME is "XXXXX". 1 character code (A..Z), up to five -- codes per field, no repeated codes allowed -- begin if Card_Q.Rfdgs /= " " then if Valid_Msg.Trtype = CHANGE and Card_Q.Rfdgs = "# " then null; else Working_Rfdgs := Card_Q.Rfdgs(1..1); Alphabetic_Type := Alphabetic_Types'value(Working_Rfdgs); if Card_Q.Rfdgs(1..1) = Card_Q.Rfdgs(2..2) then Error_Message("RFDGS",Bad_Field); elsif Card_Q.Rfdgs(2..5) /= " " then Working_Rfdgs := Card_Q.Rfdgs(2..2); Alphabetic_Type := Alphabetic_Types'value(Working_Rfdgs); if Card_Q.Rfdgs(1..1) = Card_Q.Rfdgs(3..3) or Card_Q.Rfdgs(2..2) = Card_Q.Rfdgs(3..3) then Error_Message("RFDGS",Bad_Field); elsif Card_Q.Rfdgs(3..5) /= " " then Working_Rfdgs := Card_Q.Rfdgs(3..3); Alphabetic_Type := Alphabetic_Types'value(Working_Rfdgs); if Card_Q.Rfdgs(1..1) = Card_Q.Rfdgs(4..4) or Card_Q.Rfdgs(2..2) = Card_Q.Rfdgs(4..4) or Card_Q.Rfdgs(3..3) = Card_Q.Rfdgs(4..4) then Error_Message("RFDGS",Bad_Field); elsif Card_Q.Rfdgs(4..5) /= " " then Working_Rfdgs := Card_Q.Rfdgs(4..4); Alphabetic_Type := Alphabetic_Types'value(Working_Rfdgs); if Card_Q.Rfdgs(1..1) = Card_Q.Rfdgs(5..5) or Card_Q.Rfdgs(2..2) = Card_Q.Rfdgs(5..5) or Card_Q.Rfdgs(3..3) = Card_Q.Rfdgs(5..5) or Card_Q.Rfdgs(4..4) = Card_Q.Rfdgs(5..5) then Error_Message("RFDGS",Bad_Field); elsif Card_Q.Rfdgs(5..5) /= " " then Working_Rfdgs := Card_Q.Rfdgs(5..5); Alphabetic_Type := Alphabetic_Types'value(Working_Rfdgs); end if; end if; end if; end if; end if; elsif Card_Q.Dssta = "D" or Card_Q.Dssta = "N" or Card_Q.Dssta = "E" or Card_Q.Dssta = "0" or Card_Q.Rtime = "XXXXX" then Error_Message("RFDGS",Field_Required); end if; exception when others => Error_Message("RFDGS",Bad_Field); end; -- -- if NUECC is reported, it must be numeric range 00-60. if -- transaction is Change then it can be "# " -- if Card_Q.Nuecc /= " " then if Valid_Msg.Trtype = CHANGE and Card_Q.Nuecc = "# " then null; else Valid_Value := string_to_integer(Card_Q.Nuecc); if Valid_Value not in 0..60 then Error_Message("NUECC",Bad_Field); end if; end if; end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list; -- if not Bad_Message then Valid_Msg.access_q := Card_Q; Link_List; end if; end Process_Card_Q; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "T " card. -- --********************************************************************** procedure Process_Card_T is begin -- -- set up new access pointer for card T -- Card_T := new Card_Type_T; -- -- place strings in field components -- Card_T.Teqpt := Input_Msg.card(15..25); Card_T.Mesen := Input_Msg.card(26..29); Card_T.Decon := Input_Msg.card(30..30); Card_T.Mecus := Input_Msg.card(31..32); Card_T.Avcat := Input_Msg.card(33..33); Card_T.Resnd := Input_Msg.card(34..34); Card_T.Erdte.YY := Input_Msg.card(35..36); Card_T.Erdte.MM := Input_Msg.card(37..38); Card_T.Erdte.DD := Input_Msg.card(39..40); Card_T.Exdac := Input_Msg.card(41..41); Card_T.Cpgeo := Input_Msg.card(42..45); Card_T.Cfgeo := Input_Msg.card(46..49); Card_T.Eqdep.YY := Input_Msg.card(50..51); Card_T.Eqdep.MM := Input_Msg.card(52..53); Card_T.Eqdep.DD := Input_Msg.card(54..55); Card_T.Eqarr.YY := Input_Msg.card(56..57); Card_T.Eqarr.MM := Input_Msg.card(58..59); Card_T.Eqarr.DD := Input_Msg.card(60..61); Card_T.Pin := Input_Msg.card(62..66); Card_T.Tleac := Input_Msg.card(67..67); Card_T.Tleqe := Input_Msg.card(68..69); -- -- TEQPT is required to be reported and will be validated an -- IDM database relation MEQPT. -- if Card_T.Teqpt = " " then Error_Message("TEQPT",Field_Required); else Validate_Meqpt(Card_T.Teqpt,"TEQPT"); end if; -- -- MESEN is requried to be reported -- if Card_T.Mesen = " " then Error_Message("MESEN",Field_Required); end if; -- -- if DECON is reported must be 1-9 or C D A N F M E J -- begin if Card_T.Decon /= " " then Valid_Value := string_to_integer(Card_T.Decon); if Valid_Value < 1 then Cserv_Type := Cserv_Types'value(Card_T.Decon); elsif Valid_Value > 9 then raise constraint_error; end if; end if; exception when others => Error_Message("DECON",Bad_Field); end; -- begin if Card_T.Mecus /= " " then Mecus_Type := Mecus_Types'value(Card_T.Mecus); end if; exception when others => Error_Message("MECUS",Bad_Field); end; -- -- validate AVCAT and RESND. RESND is reported only when AVCAT is -- reported and has a value of "D". EXDAC and ERDTE are required -- to be reported when AVCAT has a value of "D". -- begin begin if Card_T.Avcat /= " " then Avcat_Type := Avcat_Types'value(Card_T.Avcat); end if; exception when others => Error_Message("AVCAT",Bad_Field); end; if Avcat_Type = D then if Card_T.Erdte.YY & Card_T.Erdte.MM & Card_T.Erdte.DD = " " then Error_Message("ERDTE",Field_Required); end if; if Card_T.Exdac = " " then Error_Message("EXDAC",Field_Required); end if; Resnd_Type := Resnd_Types'value(Card_T.Resnd); elsif Card_T.Resnd /= " " then raise constraint_error; end if; exception when others => Error_Message("RESND",Bad_Field); end; -- Validate_YYMMDD(Card_T.Erdte.YY, Card_T.Erdte.MM, Card_T.Erdte.DD, "ERDTE"); -- begin if Card_T.Exdac /= " " then Avcat_Type := Avcat_Types'value(Card_T.Exdac); end if; exception when others => Error_Message("EXDAC",Bad_Field); end; -- -- if CPGEO is reported it will be validated against an IDM -- database relation Geoloc. -- if Card_T.Cpgeo = "# " and Valid_Msg.Trtype = CHANGE then null; elsif Card_T.Cpgeo /= " " then Validate_Geolocation(Card_T.Cpgeo,"CPGEO"); end if; -- -- if CFGEO is reported it will be validated against an IDM -- database relation Geoloc. CFGEO must not be equal to CPGEO -- if Card_T.Cfgeo = "# " and Valid_Msg.Trtype = CHANGE then null; elsif Card_T.Cpgeo /= " " and Card_T.Cpgeo = Card_T.Cfgeo then Error_Message("CFGEO",Bad_Field); else Validate_Geolocation(Card_T.Cfgeo,"CFGEO"); end if; -- if Card_T.Eqdep.YY & Card_T.Eqdep.MM & Card_T.Eqdep.DD = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_YYMMDD(Card_T.Eqdep.YY, Card_T.Eqdep.MM, Card_T.Eqdep.DD, "EQDEP"); end if; -- if Card_T.Eqarr.YY & Card_T.Eqarr.MM & Card_T.Eqarr.DD = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_YYMMDD(Card_T.Eqarr.YY, Card_T.Eqarr.MM, Card_T.Eqarr.DD, "EQARR"); if Card_T.Eqarr.YY & Card_T.Eqarr.MM & Card_T.Eqarr.DD < Card_T.Eqdep.YY & Card_T.Eqdep.MM & Card_T.Eqdep.DD then Error_Message("EQARR",Bad_Field); end if; end if; -- if Card_T.Pin = "# " and Valid_Msg.Trtype = CHANGE then null; elsif Card_T.Pin /= " " then Validate_Pin(Card_T.Pin,"TPIN "); end if; -- begin if Card_T.Tleac /= " " then if Card_T.Tleac = "#" and Valid_Msg.Trtype = CHANGE then null; else Pleac_Type := Pleac_Types'value(Card_T.Tleac); end if; end if; exception when others => Error_Message("TLEAC",Bad_Field); end; -- if Card_T.Tleqe = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_Numeric(Card_T.Tleqe,"TLEQE"); end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_t := Card_T; Link_List; end if; end Process_Card_T; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "V " card. -- --********************************************************************** procedure Process_Card_V is Working_Mdate : string(1..3); begin -- -- set up new access pointer for card V -- Card_V := new Card_Type_V; -- -- place strings in field components -- Card_V.Acgeo := Input_Msg.card(15..18); Card_V.Acity := Input_Msg.card(19..20); Card_V.Adate.YY := Input_Msg.card(21..22); Card_V.Adate.MM := Input_Msg.card(23..24); Card_V.Adate.DD := Input_Msg.card(25..26); Card_V.Mdate := Input_Msg.card(27..30); Card_V.Rdate.YY := Input_Msg.card(31..32); Card_V.Rdate.MM := Input_Msg.card(33..34); Card_V.Rdate.DD := Input_Msg.card(35..36); -- -- if ACGEO is reported it will be validated against an IDM -- database relation Geoloc. -- Validate_Geolocation(Card_V.Acgeo,"ACGEO"); -- begin if Card_V.Acity /= " " then if Card_V.Acity /= "IN" then Activ_Type := Activ_Types'value(Card_V.Acity); end if; end if; exception when others => Error_Message("ACTIV",Bad_Field); end; -- if Card_V.Adate.YY & Card_V.Adate.MM & Card_V.Adate.DD = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_YYMMDD(Card_V.Adate.YY, Card_V.Adate.MM, Card_V.Adate.DD, "ADATE"); end if; -- -- if MDATE is reported, the first character must be "A" or "B", -- and the last 3 characters must be numeric, 001-999. -- if Card_V.Mdate /= " " then if Card_V.Mdate(1..1) = "A" or Card_V.Mdate(1..1) = "B" then Working_Mdate := Card_V.Mdate(2..4); Validate_Numeric(Working_Mdate,"MDATE"); else Error_Message("MDATE",Bad_Field); end if; end if; -- -- if RDATE is reported it must be a valid date or the string -- "9 ". the string "9 " means that RDATE is undetermined -- and therefore NULL. -- if Card_V.Rdate.YY & Card_V.Rdate.MM & Card_V.Rdate.DD /= "9 " then if Card_V.Rdate.YY & Card_V.Rdate.MM & Card_V.Rdate.DD = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_YYMMDD(Card_V.Rdate.YY, Card_V.Rdate.MM, Card_V.Rdate.DD, "RDATE"); end if; end if; -- -- ADATE and RDATE are mutually inclusive -- if Card_V.Rdate.YY & Card_V.Rdate.MM & Card_V.Rdate.DD = " " and Card_V.Adate.YY & Card_V.Adate.MM & Card_V.Adate.DD /= " " then Error_Message("RDATE",Field_Required); elsif Card_V.Rdate.YY & Card_V.Rdate.MM & Card_V.Rdate.DD /= " " and Card_V.Adate.YY & Card_V.Adate.MM & Card_V.Adate.DD = " " then Error_Message("ADATE",Field_Required); end if; -- -- if card is valid, place acces pointer in messsage list and -- set up new access pointer in message list -- if not Bad_Message then Valid_Msg.access_v := Card_V; Link_List; end if; end Process_Card_V; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "X " card. -- --********************************************************************** procedure Process_Card_X is begin -- -- set up new access pointer for card X -- Card_X := new Card_Type_X; -- -- place strings in field components -- Card_X.Gcmd := Input_Msg.card(15..20); Card_X.Tdate.YY := Input_Msg.card(21..22); Card_X.Tdate.MM := Input_Msg.card(23..24); Card_X.Tdate.DD := Input_Msg.card(25..26); Card_X.Trgeo := Input_Msg.card(27..30); Card_X.Depdt.YY := Input_Msg.card(31..32); Card_X.Depdt.MM := Input_Msg.card(33..34); Card_X.Depdt.DD := Input_Msg.card(35..36); Card_X.Arrdt.YY := Input_Msg.card(37..38); Card_X.Arrdt.MM := Input_Msg.card(39..40); Card_X.Arrdt.DD := Input_Msg.card(41..42); Card_X.Rptor := Input_Msg.card(43..48); Card_X.Intr1 := Input_Msg.card(49..54); Card_X.Intr2 := Input_Msg.card(55..60); Card_X.Sbrpt := Input_Msg.card(61..66); -- if Valid_Msg.Trtype = DELETE or Valid_Msg.Trtype = REPLACE or Valid_Msg.Trtype = ADD then Error_Message("TRTYP",Bad_Field); end if; -- if Card_X.Gcmd = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_Oruic(Card_X.Gcmd,"GCMD "); end if; -- Validate_YYMMDD(Card_X.Tdate.YY, Card_X.Tdate.MM, Card_X.Tdate.DD, "TDATE"); -- -- if TRGEO is reported it will be validated against an IDM -- database relation Geoloc. -- if Card_X.Trgeo = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("TRGEO",Bad_Field); else Validate_Geolocation(Card_X.Trgeo,"TRGEO"); end if; -- Validate_YYMMDD(Card_X.Depdt.YY, Card_X.Depdt.MM, Card_X.Depdt.DD, "DEPDT"); -- Validate_YYMMDD(Card_X.Arrdt.YY, Card_X.Arrdt.MM, Card_X.Arrdt.DD, "ARRDT"); -- -- ARRDT must be >= DEPDT -- if Card_X.Arrdt.YY & Card_X.Arrdt.MM & Card_X.Arrdt.DD < Card_X.Depdt.YY & Card_X.Depdt.MM & Card_X.Depdt.DD then Error_Message("DEPDT",Bad_Field); end if; -- Validate_Oruic(Card_X.Rptor,"RPTOR"); -- if Card_X.Intr1 = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_Oruic(Card_X.Intr1,"INTR1"); end if; -- if Card_X.Intr2 = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_Oruic(Card_X.Intr2,"INTR2"); end if; -- if Card_X.Sbrpt /= " " then Validate_Uic(Card_X.Sbrpt,"SBRPT"); end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_x := Card_X; Link_List; end if; end Process_Card_X; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "R " and "RM3" card. -- --********************************************************************** procedure Process_Card_R is begin -- -- set up new access pointer for card R -- Card_R := new Card_Type_R; -- -- validate and convert sequence number -- begin Working_String := " "; Working_String(1..1) := Input_Msg.card(15..15); Card_R.Seq := String_to_Integer(Working_String(1..1)); exception when others => Error_Message("SEQ ",Bad_Field); end; -- -- validate and convert total number of remark cards -- begin Working_String := " "; Working_String(1..1) := Input_Msg.card(16..16); Card_R.Tot := String_to_Integer(Working_String(1..1)); exception when others => Error_Message("TOT ",Bad_Field); end; -- -- place strings in field components -- Card_R.Label := Input_Msg.card(17..21); Card_R.Rmkid := Input_Msg.card(22..48); Card_R.Remrk := Input_Msg.card(49..69); -- -- if sequence number is 1 then validate the label field -- begin if Card_R.Seq = 1 then Label_Type := Label_Types'value(Card_R.Label); end if; exception when others => Error_Message("LABEL",Bad_Field); end; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_r := Card_R; Link_List; end if; end Process_Card_R; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "DM1" card. -- --********************************************************************** procedure Process_Card_DM1 is begin -- -- set up new access pointer for card DM1 -- Card_DM1 := new Card_Type_DM1; -- -- place strings in field components -- Card_DM1.Billet := Input_Msg.card(15..17); Card_DM1.Cornk := Input_Msg.card(18..22); Card_DM1.Conam := Input_Msg.card(23..39); Card_DM1.Mmcmd := Input_Msg.card(64..69); -- -- if BILLET is reported, CORNK and CONAM are required to be -- reported. BILLET, CORNK and CONAM are required to be -- reported when transaction is Add. -- if Card_DM1.Billet /= " " then begin Bilet_Type := Bilet_Types'value(Card_DM1.Billet); if Card_DM1.Cornk = " " then Error_Message("CORNK",Field_Required); else begin Cornk_Type := Cornk_Types'value(Card_DM1.Cornk); exception when others => Error_Message("CORNK",Bad_Field); end; end if; if Card_DM1.Conam = " " then Error_Message("CONAM",Field_Required); end if; exception when others => Error_Message("BILET",Bad_Field); end; elsif Valid_Msg.Trtype = ADD then Error_Message("BILET",Field_Required); if Card_DM1.Cornk = " " then Error_Message("CORNK",Field_Required); else begin Cornk_Type := Cornk_Types'value(Card_DM1.Cornk); exception when others => Error_Message("CORNK",Bad_Field); end; end if; if Card_DM1.Conam = " " then Error_Message("CONAM",Field_Required); end if; end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_dm1 := Card_DM1; Link_List; end if; end Process_Card_DM1; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "DN1" card. -- --********************************************************************** procedure Process_Card_DN1 is begin -- -- set up new access pointer for card DN1 -- Card_DN1 := new Card_Type_DN1; -- -- place strings if field components -- Card_DN1.Ntask := Input_Msg.card(15..27); Card_DN1.Prgeo := Input_Msg.card(28..31); Card_DN1.Point := Input_Msg.card(32..42); Card_DN1.Modfg := Input_Msg.card(43..43); Card_DN1.Activ := Input_Msg.card(44..45); Card_DN1.Pletd.MM := Input_Msg.card(46..47); Card_DN1.Pletd.DD := Input_Msg.card(48..49); Card_DN1.Pletd.HH := Input_Msg.card(50..51); Card_DN1.Ndest := Input_Msg.card(52..62); Card_DN1.Deta.MM := Input_Msg.card(63..64); Card_DN1.Deta.DD := Input_Msg.card(65..66); Card_DN1.Deta.HH := Input_Msg.card(67..68); Card_DN1.Cxmrs := Input_Msg.card(69..69); -- -- PRGEO is required to be reported and will be validated against -- an IDM database relation Geoloc. -- if Card_DN1.Prgeo = " " then Error_Message("PRGEO",Field_Required); else Validate_Geolocation(Card_DN1.Prgeo,"PRGEO"); end if; -- -- POINT and CXMRS are mutually exclusive -- if Card_DN1.Point /= " " then if Card_DN1.Cxmrs /= " " then Error_Message("",Mutually_Exclusive); end if; Valid_Value := string_to_integer(Card_DN1.Point(1..2)); if Valid_Value not in 0..90 then Error_Message("POINT",Bad_Field); else Valid_Value := string_to_integer(Card_DN1.Point(3..4)); if Valid_Value not in 0..59 then Error_Message("POINT",Bad_Field); else Valid_Value := string_to_integer(Card_DN1.Point(6..8)); if Valid_Value not in 0..180 then Error_Message("POINT",Bad_Field); else Valid_Value := string_to_integer(Card_DN1.Point(9..10)); if Valid_Value not in 0..59 then Error_Message("POINT",Bad_Field); elsif (Card_DN1.Point(5) = 'N' or Card_DN1.Point(5) = 'S') then if (Card_DN1.Point(11) = 'E' or Card_DN1.Point(11) = 'W') then null; else Error_Message("POINT",Bad_Field); end if; else Error_Message("POINT",Bad_Field); end if; end if; end if; end if; elsif Card_DN1.Cxmrs /= " " then begin Nucin_Type := Nucin_Types'value(Card_DN1.Cxmrs); exception when others => Error_Message("CXMRS",Bad_Field); end; end if; -- begin if Card_DN1.Modfg /= " " then Nucin_Type := Nucin_Types'value(Card_DN1.Modfg); end if; exception when others => Error_Message("MODFG",Bad_Field); end; -- begin if Card_DN1.Activ /= " " then if Card_DN1.Activ /= "IN" then Activ_Type := Activ_Types'value(Card_DN1.Activ); end if; end if; exception when others => Error_Message("ACTIV",Bad_Field); end; -- -- if PLETD is reported it must be greater than the header date but -- not more than 3 months greater. -- begin if Card_DN1.Pletd.MM /= " " or Card_DN1.Pletd.DD /= " " or Card_DN1.Pletd.HH /= " " then Month_of_Year := string_to_integer(Card_DN1.Pletd.MM); if Month_of_Year not in 1..12 then raise constraint_error; end if; Card_DN1.Pletd.Year := Header_Year; if Month_of_Year /= Header_Month then Valid_Value := Header_Month + 3; if Valid_Value > 12 then Valid_Value := Valid_Value - 12; Card_DN1.Pletd.Year := Header_Year + 1; end if; if Month_of_Year < Header_Month or Month_of_Year > Valid_Value then raise constraint_error; end if; end if; Days_in_Month(2) := 29; Valid_Value := string_to_integer(Card_DN1.Pletd.DD); if Valid_Value not in 1..Days_in_Month(Month_of_Year) then raise constraint_error; end if; Valid_Value := string_to_integer(Card_DN1.Pletd.HH); if Valid_Value not in 0..23 then raise constraint_error; end if; end if; exception when others => Error_Message("PLETD",Bad_Field); end; -- the field NDEST is a lat/lon in the format DDMMhDDDMMh begin if Card_DN1.Ndest /= " " then Valid_Value := string_to_integer(Card_DN1.Ndest(1..2)); if Valid_Value < 0 then Working_String := " "; Working_String(1..1) := Card_DN1.Ndest(1..1); alphabetic_type := alphabetic_types'value(Working_String); elsif Valid_Value > 90 then raise constraint_error; else Valid_Value := string_to_integer(Card_DN1.Ndest(3..4)); if Valid_Value not in 0..59 then raise constraint_error; end if; if Card_DN1.Ndest(5) = 'N' or Card_DN1.Ndest(5) = 'S' then null; else raise constraint_error; end if; Valid_Value := string_to_integer(Card_DN1.Ndest(6..8)); if Valid_Value not in 0..180 then raise constraint_error; end if; Valid_Value := string_to_integer(Card_DN1.Ndest(9..10)); if Valid_Value not in 0..59 then raise constraint_error; end if; if Card_DN1.Ndest(11) = 'E' or Card_DN1.Ndest(11) = 'W' then null; else raise constraint_error; end if; end if; end if; exception when others => Error_Message("NDEST",Bad_Field); end; -- -- if DETA is reported it must be greater than the header date but -- not more than 3 months greater. -- begin if Card_DN1.Deta.MM /= " " or Card_DN1.Deta.DD /= " " or Card_DN1.Deta.HH /= " " then Month_of_Year := string_to_integer(Card_DN1.Deta.MM); if Month_of_Year not in 1..12 then raise constraint_error; end if; Card_DN1.Deta.Year := Header_Year; if Month_of_Year /= Header_Month then Valid_Value := Header_Month + 3; if Valid_Value > 12 then Valid_Value := Valid_Value - 12; Card_DN1.Deta.Year := Header_Year + 1; end if; if Month_of_Year < Header_Month or Month_of_Year > Valid_Value then raise constraint_error; end if; end if; Days_in_Month(2) := 29; Valid_Value := string_to_integer(Card_DN1.Deta.DD); if Valid_Value not in 1..Days_in_Month(Month_of_Year) then raise constraint_error; end if; Valid_Value := string_to_integer(Card_DN1.Deta.HH); if Valid_Value not in 0..59 then raise constraint_error; end if; end if; exception when others => Error_Message("DETA ",Bad_Field); end; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_dn1 := Card_DN1; Link_List; end if; end Process_Card_DN1; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "JM1" card. -- --********************************************************************** procedure Process_Card_JM1 is begin -- -- set up new access pointer for card JM1 -- Card_JM1 := new Card_Type_JM1; -- -- validate and convert SCATD -- begin Working_String := " "; Working_String(1..2) := Input_Msg.card(15..16); Card_JM1.Scatd := Scatd_Types'value(Working_String); exception when others => Error_Message("SCATD",Bad_Field); end; -- -- place strings in field components -- Card_JM1.Mgo := Input_Msg.card(17..21); Card_JM1.Ago := Input_Msg.card(22..26); Card_JM1.Na := Input_Msg.card(27..31); Card_JM1.Nfo := Input_Msg.card(32..36); Card_JM1.Menl := Input_Msg.card(37..41); Card_JM1.Navo := Input_Msg.card(42..46); Card_JM1.Nave := Input_Msg.card(47..51); Card_JM1.Othof := Input_Msg.card(52..56); Card_JM1.Othen := Input_Msg.card(57..61); Card_JM1.Piaod := Input_Msg.card(62..67); -- Validate_Numeric(Card_JM1.Mgo,"MGO "); Validate_Numeric(Card_JM1.Ago,"AGO "); Validate_Numeric(Card_JM1.Na,"NA "); Validate_Numeric(Card_JM1.Nfo,"NFO "); Validate_Numeric(Card_JM1.Menl,"MENL "); Validate_Numeric(Card_JM1.Navo,"NAVO "); Validate_Numeric(Card_JM1.Nave,"NAVE "); Validate_Numeric(Card_JM1.Othof,"OTHOF"); Validate_Numeric(Card_JM1.Othen,"OTHEN"); -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_jm1 := Card_JM1; Link_List; end if; end Process_Card_JM1; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "KF1" card. -- --********************************************************************** procedure Process_Card_KF1 is Pertp_Value : integer; Pertc_Value : integer; Trutc_Value : integer; Tcrav_Value : integer; Tcarq_Value : integer; Tcras_Value : integer; Trsa1_Value : integer; Trsa2_Value : integer; Trsa3_Value : integer; Trsa4_Value : integer; Trsa5_Value : integer; Cpaur_Value : integer; Cpasg_Value : integer; Cpavl_Value : integer; Tpaut_Value : integer; Tpasg_Value : integer; Tpavl_Value : integer; begin -- -- set up new access pointer for card KF1 -- Card_KF1 := new Card_Type_KF1; -- -- place strings in field components -- Card_KF1.Docnr := Input_Msg.card(15..15); Card_KF1.Docid := Input_Msg.card(16..19); Card_KF1.Pertp := Input_Msg.card(20..21); Card_KF1.Tpaut := Input_Msg.card(22..25); Card_KF1.Tpasg := Input_Msg.card(26..29); Card_KF1.Tpavl := Input_Msg.card(30..33); Card_KF1.Pertc := Input_Msg.card(34..35); Card_KF1.Cpaur := Input_Msg.card(36..39); Card_KF1.Cpasg := Input_Msg.card(40..43); Card_KF1.Cpavl := Input_Msg.card(44..47); Card_KF1.Trutc := Input_Msg.card(48..49); Card_KF1.Tmthd := Input_Msg.card(50..50); Card_KF1.Tcarq := Input_Msg.card(51..53); Card_KF1.Tcras := Input_Msg.card(54..56); Card_KF1.Tcrav := Input_Msg.card(57..59); Card_KF1.Trsa1 := Input_Msg.card(60..61); Card_KF1.Trsa2 := Input_Msg.card(62..63); Card_KF1.Trsa3 := Input_Msg.card(64..65); Card_KF1.Trsa4 := Input_Msg.card(66..67); Card_KF1.Trsa5 := Input_Msg.card(68..69); -- -- DOCNR is required to be reported -- if Card_KF1.Docnr = " " then Error_Message("DOCNR",Field_Required); end if; -- -- DOCID is required to be reported when transaction type is Add -- begin if Card_KF1.Docid /= " " then Docid_Type := Docid_Types'value(Card_KF1.Docid); elsif Valid_Msg.Trtype = ADD then Error_Message("DOCID",Field_Required); end if; exception when others => Error_Message("DOCID",Bad_Field); end; -- if Card_KF1.Pertp = " " then if (Valid_Msg.Trtype = ADD or Valid_Msg.Trtype = CHANGE) or (Card_KF1.Tpavl /= " " or Card_KF1.Tpasg /= " " or Card_KF1.Tpaut /= " ") then Error_Message("PERTP",Field_Required); end if; else Pertp_Value := string_to_integer(Card_KF1.Pertp); if Card_KF1.Pertp = "**" then Pertp_Value := 100; end if; Tpaut_Value := string_to_Integer(Card_KF1.Tpaut); Tpasg_Value := string_to_Integer(Card_KF1.Tpasg); Tpavl_Value := string_to_Integer(Card_KF1.Tpavl); if Tpasg_Value < 0 or Tpasg_Value > Tpaut_Value or Tpasg_Value < Tpavl_Value then Error_Message("TPASG",Bad_Field); elsif Tpaut_Value < Tpavl_Value then Error_Message("TPAUT",Bad_Field); elsif Tpavl_Value < 0 then Error_Message("TPAVL",Bad_Field); elsif Pertp_Value < 0 or Pertp_Value /= (Tpavl_Value * 100) / Tpaut_Value then Error_Message("PERTP",Bad_Field); end if; end if; -- if Card_KF1.Pertc = " " then if (Valid_Msg.Trtype = ADD or Valid_Msg.Trtype = CHANGE) or (Card_KF1.Cpavl /= " " or Card_KF1.Cpasg /= " " or Card_KF1.Cpaur /= " ") then Error_Message("PERTC",Field_Required); end if; else Pertc_Value := string_to_integer(Card_KF1.Pertc); if Card_KF1.Pertc = "**" then Pertc_Value := 100; end if; Cpaur_Value := string_to_Integer(Card_KF1.Cpaur); Cpasg_Value := string_to_Integer(Card_KF1.Cpasg); Cpavl_Value := string_to_Integer(Card_KF1.Cpavl); if Cpasg_Value < 0 or Cpasg_Value > Cpaur_Value or Cpasg_Value < Cpavl_Value then Error_Message("CPASG",Bad_Field); elsif Cpaur_Value < Cpavl_Value then Error_Message("CPAUR",Bad_Field); elsif Cpavl_Value < 0 then Error_Message("CPAVL",Bad_Field); elsif Pertc_Value < 0 or Pertc_Value /= (Cpavl_Value * 100) / Cpaur_Value then Error_Message("PERTC",Bad_Field); end if; end if; -- begin if Card_KF1.Tmthd = " " then if (Valid_Msg.Trtype = ADD or Valid_Msg.Trtype = CHANGE) or Card_KF1.Trutc /= " " or (Card_KF1.Tcrav /= " " or Card_KF1.Tcras /= " " or Card_KF1.Tcarq /= " ") or (Card_KF1.Trsa1 /= " " or Card_KF1.Trsa2 /= " " or Card_KF1.Trsa3 /= " " or Card_KF1.Trsa4 /= " " or Card_KF1.Trsa5 /= " ") then Error_Message("TMTHD",Field_Required); end if; if Card_KF1.Trutc /= " " then Error_Message("TMTHD",Field_Required); end if; else Tmthd_Type := Tmthd_Types'value(Card_KF1.Tmthd); case Tmthd_Type is when B => if Card_KF1.Tcarq = " " then Error_Message("TCARQ",Field_Required); elsif Card_KF1.Tcras = " " then Error_Message("TCRAS",Field_Required); elsif Card_KF1.Tcrav = " " then Error_Message("TCRAV",Field_Required); elsif Valid_Msg.Trtype = CHANGE and Card_KF1.Tcarq = "# " and Card_KF1.Tcras = "# " and Card_KF1.Tcrav = "# " then null; else Tcarq_Value := string_to_integer(Card_KF1.Tcarq); Tcras_Value := string_to_integer(Card_KF1.Tcras); Tcrav_Value := string_to_integer(Card_KF1.Tcrav); if Tcras_Value < 0 or Tcras_Value > Tcarq_Value or Tcras_Value < Tcrav_Value then Error_Message("TCRAS",Bad_Field); elsif Tcarq_Value < Tcrav_Value then Error_Message("TCRAV",Bad_Field); elsif Tcarq_Value < 0 then Error_Message("TCARQ",Bad_Field); else Trutc_Value := string_to_integer(Card_KF1.Trutc); if Card_KF1.Trutc = "**" then Trutc_Value := 100; end if; if Trutc_Value < 0 or Trutc_Value /= (Tcrav_Value * 100) / Tcarq_Value then Error_Message("TRUTC",Bad_Field); end if; end if; end if; when C => if Card_KF1.Trsa1 = " " then Error_Message("TRSA1",Field_Required); elsif Card_KF1.Trsa2 = " " then Error_Message("TRSA2",Field_Required); elsif Card_KF1.Trsa3 = " " then Error_Message("TRSA3",Field_Required); elsif Card_KF1.Trsa4 = " " then Error_Message("TRSA4",Field_Required); elsif Card_KF1.Trsa5 = " " then Error_Message("TRSA5",Field_Required); elsif Valid_Msg.Trtype = CHANGE and Card_KF1.Trsa1 = "# " and Card_KF1.Trsa2 = "# " and Card_KF1.Trsa3 = "# " and Card_KF1.Trsa4 = "# " and Card_KF1.Trsa5 = "# " then null; else Trsa1_Value := string_to_integer(Card_KF1.Trsa1); if Trsa1_Value < 0 then Error_Message("TRSA1",Bad_Field); end if; Trsa2_Value := string_to_integer(Card_KF1.Trsa2); if Trsa2_Value < 0 then Error_Message("TRSA2",Bad_Field); end if; Trsa3_Value := string_to_integer(Card_KF1.Trsa3); if Trsa3_Value < 0 then Error_Message("TRSA3",Bad_Field); end if; Trsa4_Value := string_to_integer(Card_KF1.Trsa4); if Trsa4_Value < 0 then Error_Message("TRSA4",Bad_Field); end if; Trsa5_Value := string_to_integer(Card_KF1.Trsa5); if Trsa5_Value < 0 then Error_Message("TRSA5",Bad_Field); end if; if Trsa1_Value < 0 or Trsa2_Value < 0 or Trsa3_Value < 0 or Trsa4_Value < 0 or Trsa5_Value < 0 then null; else Valid_Value := Trsa1_Value; if Trsa2_Value < Valid_Value then Valid_Value := Trsa2_Value; end if; if Trsa3_Value < Valid_Value then Valid_Value := Trsa3_Value; end if; if Trsa4_Value < Valid_Value then Valid_Value := Trsa4_Value; end if; if Trsa5_Value < Valid_Value then Valid_Value := Trsa5_Value; end if; Trutc_Value := 100; if Card_KF1.Trutc /= "**" then Trutc_Value := string_to_integer(Card_KF1.Trutc); end if; if Trutc_Value < 0 or Trutc_Value /= Valid_Value then Error_Message("TRUTC",Bad_Field); end if; end if; end if; end case; end if; exception when others => Error_Message("TMTHD",Bad_Field); end; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_kf1 := Card_KF1; Link_List; end if; end Process_Card_KF1; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "KF2" card. -- --********************************************************************** procedure Process_Card_KF2 is Eqsee_Value : integer; Mepos_Value : integer; Meard_Value : integer; begin -- -- set up new access pointer for card KF2 -- Card_KF2 := new Card_Type_KF2; -- -- place strings in field components -- Card_KF2.Docnr := Input_Msg.card(15..15); Card_KF2.Eqsee := Input_Msg.card(16..17); Card_KF2.Eqsse := Input_Msg.card(18..19); Card_KF2.Meard := Input_Msg.card(20..22); Card_KF2.Measq := Input_Msg.card(23..25); Card_KF2.Mepos := Input_Msg.card(26..28); Card_KF2.Essa1 := Input_Msg.card(29..30); Card_KF2.Essa2 := Input_Msg.card(31..32); Card_KF2.Essa3 := Input_Msg.card(33..34); Card_KF2.Essa4 := Input_Msg.card(35..36); Card_KF2.Essa5 := Input_Msg.card(37..38); Card_KF2.Essa6 := Input_Msg.card(39..40); Card_KF2.Essa7 := Input_Msg.card(41..42); Card_KF2.Essa8 := Input_Msg.card(43..44); Card_KF2.Essa9 := Input_Msg.card(45..46); Card_KF2.Eqree := Input_Msg.card(47..48); Card_KF2.Eqred := Input_Msg.card(49..50); Card_KF2.Memra := Input_Msg.card(51..53); Card_KF2.Ersa1 := Input_Msg.card(54..55); Card_KF2.Ersa2 := Input_Msg.card(56..57); Card_KF2.Ersa3 := Input_Msg.card(58..59); Card_KF2.Ersa4 := Input_Msg.card(60..61); Card_KF2.Ersa5 := Input_Msg.card(62..63); Card_KF2.Ersa6 := Input_Msg.card(64..65); Card_KF2.Ersa7 := Input_Msg.card(66..67); Card_KF2.Ersa8 := Input_Msg.card(68..69); -- -- DOCNR is required to be reported -- if Card_KF2.Docnr = " " then Error_Message("DOCNR",Field_Required); end if; -- if Card_KF2.Eqsee = " " then if Card_KF2.Meard /= " " or Card_KF2.Mepos /= " " then Error_Message("EQSEE",Field_Required); end if; elsif Valid_Msg.Trtype = CHANGE and Card_KF2.Eqsee = "# " and Card_KF2.Mepos = "# " and Card_KF2.Meard = "# " then null; else Eqsee_Value := string_to_integer(Card_KF2.Eqsee); if Card_KF2.Eqsee = "**" then Eqsee_Value := 100; end if; if Eqsee_Value < 0 then Error_Message("EQSEE",Bad_Field); else Mepos_Value := string_to_integer(Card_KF2.Mepos); if Mepos_Value < 0 then Error_Message("MEPOS",Bad_Field); end if; Meard_Value := string_to_integer(Card_KF2.Meard); if Meard_Value < 0 then Error_Message("MEARD",Bad_Field); end if; if Meard_Value < 0 or Mepos_Value < 0 then null; elsif Eqsee_Value /= (Mepos_Value * 100) / Meard_Value then Error_Message("EQSEE",Bad_Field); end if; end if; end if; -- if Card_KF2.Eqsse /= " " then if Valid_Msg.Trtype = CHANGE and Card_KF2.Eqsse = "# " then null; elsif Card_KF2.Eqsse /= "**" then Valid_Value := string_to_integer(Card_KF2.Eqsse); if Valid_Value < 0 then Error_Message("EQSSE",Bad_Field); end if; end if; end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Measq = "# " then null; else Validate_Numeric(Card_KF2.Measq,"MEASQ"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Essa1 = "# " then null; else Validate_Numeric(Card_KF2.Essa1,"ESSA1"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Essa2 = "# " then null; else Validate_Numeric(Card_KF2.Essa2,"ESSA2"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Essa3 = "# " then null; else Validate_Numeric(Card_KF2.Essa3,"ESSA3"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Essa4 = "# " then null; else Validate_Numeric(Card_KF2.Essa4,"ESSA4"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Essa5 = "# " then null; else Validate_Numeric(Card_KF2.Essa5,"ESSA5"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Essa6 = "# " then null; else Validate_Numeric(Card_KF2.Essa6,"ESSA6"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Essa7 = "# " then null; else Validate_Numeric(Card_KF2.Essa7,"ESSA7"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Essa8 = "# " then null; else Validate_Numeric(Card_KF2.Essa8,"ESSA8"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Essa9 = "# " then null; else Validate_Numeric(Card_KF2.Essa9,"ESSA9"); end if; -- if Card_KF2.Eqree /= " " then if Valid_Msg.Trtype = CHANGE and Card_KF2.Eqree = "# " then null; elsif Card_KF2.Eqree /= "**" then Valid_Value := string_to_integer(Card_KF2.Eqree); if Valid_Value < 0 then Error_Message("EQREE",Bad_Field); end if; end if; end if; -- if Card_KF2.Eqred /= " " then if Valid_Msg.Trtype = CHANGE and Card_KF2.Eqred = "# " then null; elsif Card_KF2.Eqred /= "**" then Valid_Value := string_to_integer(Card_KF2.Eqred); if Valid_Value < 0 then Error_Message("EQRED",Bad_Field); end if; end if; end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Memra = "# " then null; else Validate_Numeric(Card_KF2.Memra,"MEMRA"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Ersa1 = "# " then null; else Validate_Numeric(Card_KF2.Ersa1,"Ersa1"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Ersa2 = "# " then null; else Validate_Numeric(Card_KF2.Ersa2,"Ersa2"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Ersa3 = "# " then null; else Validate_Numeric(Card_KF2.Ersa3,"Ersa3"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Ersa4 = "# " then null; else Validate_Numeric(Card_KF2.Ersa4,"Ersa4"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Ersa5 = "# " then null; else Validate_Numeric(Card_KF2.Ersa5,"Ersa5"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Ersa6 = "# " then null; else Validate_Numeric(Card_KF2.Ersa6,"Ersa6"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Ersa7 = "# " then null; else Validate_Numeric(Card_KF2.Ersa7,"Ersa7"); end if; -- if Valid_Msg.Trtype = CHANGE and Card_KF2.Ersa8 = "# " then null; else Validate_Numeric(Card_KF2.Ersa8,"Ersa8"); end if; -- -- if card is valid, place access pointer in mErsage list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_kf2 := Card_KF2; Link_List; end if; end Process_Card_KF2; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "KF3" card. -- --********************************************************************** procedure Process_Card_KF3 is Readf_Value : integer; Prraf_Value : integer; Esraf_Value : integer; Erraf_Value : integer; Trraf_Value : integer; begin -- -- initialize variables -- Readf_Value := 0; Prraf_Value := 0; Esraf_Value := 0; Erraf_Value := 0; Trraf_Value := 0; -- -- set up new access pointer for card KF3 -- Card_KF3 := new Card_Type_KF3; -- -- place strings in field components -- Card_KF3.Docnr := Input_Msg.card(15..15); Card_KF3.Sdoc := Input_Msg.card(16..19); Card_KF3.Readf := Input_Msg.card(20..20); Card_KF3.Reasf := Input_Msg.card(21..21); Card_KF3.Prraf := Input_Msg.card(22..22); Card_KF3.Prref := Input_Msg.card(23..25); Card_KF3.Esraf := Input_Msg.card(26..26); Card_KF3.Esref := Input_Msg.card(27..29); Card_KF3.Erraf := Input_Msg.card(30..30); Card_KF3.Erref := Input_Msg.card(31..33); Card_KF3.Trraf := Input_Msg.card(34..34); Card_KF3.Trref := Input_Msg.card(35..37); Card_KF3.Secrf := Input_Msg.card(38..40); Card_KF3.Terrf := Input_Msg.card(41..43); Card_KF3.Caraf := Input_Msg.card(44..44); Card_KF3.Cadaf.YY := Input_Msg.card(45..46); Card_KF3.Cadaf.MM := Input_Msg.card(47..48); Card_KF3.Cadaf.DD := Input_Msg.card(49..50); Card_KF3.Limf := Input_Msg.card(51..51); Card_KF3.Rlimf := Input_Msg.card(52..52); Card_KF3.Ricdf.YY := Input_Msg.card(53..54); Card_KF3.Ricdf.MM := Input_Msg.card(55..56); Card_KF3.Ricdf.DD := Input_Msg.card(57..58); Card_KF3.Respf := Input_Msg.card(59..63); -- -- DOCNR is required to be reported -- if Card_KF3.Docnr = " " then Error_Message("DOCNR",Field_Required); end if; -- -- SDOC is required to be reported when transaction is Add -- begin if Card_KF3.Sdoc /= " " then Docid_Type := Docid_Types'value(Card_KF3.Sdoc); elsif Valid_Msg.Trtype = ADD then Error_Message("SDOC ",Field_Required); end if; exception when others => Error_Message("SDOC ",Bad_Field); end; -- if Card_KF3.Readf /= " " then Readf_Value := string_to_integer(Card_KF3.Readf); if Readf_Value not in 1..5 then Error_Message("READF",Bad_Field); end if; end if; -- if Card_KF3.Prraf /= " " then Prraf_Value := string_to_integer(Card_KF3.Prraf); if Prraf_Value not in 1..6 then Error_Message("PRRAF",Bad_Field); elsif Prraf_Value /= 6 and Card_KF3.Reasf /= "X" then if Prraf_Value > Readf_Value then Error_Message("PRRAF",Bad_Field); end if; end if; end if; -- begin if Card_KF3.Prref = " " then if Prraf_Value in 2..4 then Error_Message("PRREF",Field_Required); end if; elsif Valid_Msg.Trtype = CHANGE and Card_KF3.Prref = "# " then null; else Prres_Type := Prres_Prres_Types'value(Card_KF3.Prref); end if; exception when others => Error_Message("PRREF",Bad_Field); end; -- if Card_KF3.Esraf /= " " then Esraf_Value := string_to_integer(Card_KF3.Esraf); if Esraf_Value not in 1..6 then Error_Message("ESRAF",Bad_Field); elsif Esraf_Value /= 6 and Card_KF3.Reasf /= "X" then if Esraf_Value > Readf_Value then Error_Message("ESRAF",Bad_Field); end if; end if; end if; -- begin if Card_KF3.Esref = " " then if Esraf_Value in 2..4 then Error_Message("ESREF",Field_Required); end if; elsif Valid_Msg.Trtype = CHANGE and Card_KF3.Esref = "# " then null; else Esres_Type := Esres_Prres_Types'value(Card_KF3.Esref); end if; exception when others => Error_Message("ESREF",Bad_Field); end; -- if Card_KF3.Erraf /= " " then Erraf_Value := string_to_integer(Card_KF3.Erraf); if Erraf_Value not in 1..6 then Error_Message("ERRAF",Bad_Field); elsif Erraf_Value /= 6 and Card_KF3.Reasf /= "X" then if Erraf_Value > Readf_Value then Error_Message("ERRAF",Bad_Field); end if; end if; end if; -- begin if Card_KF3.Erref = " " then if Erraf_Value in 2..4 then Error_Message("ERREF",Field_Required); end if; elsif Valid_Msg.Trtype = CHANGE and Card_KF3.Erref = "# " then null; else Erres_Type := Erres_Prres_Types'value(Card_KF3.Erref); end if; exception when others => Error_Message("ERREF",Bad_Field); end; -- if Card_KF3.Trraf /= " " then Trraf_Value := string_to_integer(Card_KF3.Trraf); if Trraf_Value not in 1..6 then Error_Message("TRRAF",Bad_Field); elsif Trraf_Value /= 6 and Card_KF3.Reasf /= "X" then if Trraf_Value > Readf_Value then Error_Message("TRRAF",Bad_Field); end if; end if; end if; -- begin if Card_KF3.Trref = " " then if Trraf_Value in 2..4 then Error_Message("TRREF",Field_Required); end if; elsif Valid_Msg.Trtype = CHANGE and Card_KF3.Trref = "# " then null; else Trres_Type := Trres_Prres_Types'value(Card_KF3.Trref); end if; exception when others => Error_Message("TRREF",Bad_Field); end; -- begin if Card_KF3.Reasf /= " " then Reasn_Type := Reasn_Types'value(Card_KF3.Reasf); case Reasn_Type is when N | M => if Readf_Value /= 5 then Error_Message("READF",Bad_Field); end if; when X => if Card_KF3.Readf = " " then Error_Message("READF",Field_Required); end if; when others => Valid_Value := 0; if Prraf_Value /= 6 and Prraf_Value > Valid_Value then Valid_Value := Prraf_Value; end if; if Esraf_Value /= 6 and Esraf_Value > Valid_Value then Valid_Value := Esraf_Value; end if; if Erraf_Value /= 6 and Erraf_Value > Valid_Value then Valid_Value := Erraf_Value; end if; if Trraf_Value /= 6 and Trraf_Value > Valid_Value then Valid_Value := Trraf_Value; end if; if Readf_Value /= Valid_Value then Error_Message("READF",Bad_Field); end if; end case; end if; exception when others => Error_Message("REASF",Bad_Field); end; -- -- if SECRF is reported, REASF must be reported on this card or be -- stored already in the database. -- begin if Card_KF3.Secrf /= " " then if Valid_Msg.Trtype = ADD and Card_KF3.Reasf = " " then Error_Message("REASF",Field_Required); elsif Valid_Msg.Trtype = CHANGE and Card_KF3.Reasf = " " then begin idm_command(idmrun,"return_readiness_f_reason $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Working_String(1..1),Length_of_String); if Working_String(1..1) = " " then Error_Message("REASF",Field_Required); end if; exception when others => Error_Message("TERRN",Can_Not_Validate_Correctly); end; end if; if Valid_Msg.Trtype = CHANGE and Card_KF3.Secrf = "# " then null; else Secrn_Type := Prres_Types'value(Card_KF3.Secrf); end if; end if; exception when others => Error_Message("SECRF",Bad_Field); end; -- -- if TERRF is reported, REASF and SECRF must be reported on this -- card or be stored already in the database. TERRF must not be -- equal to SECRF. -- begin if Card_KF3.Terrf /= " " then if Valid_Msg.Trtype = ADD then if Card_KF3.Reasf = " " then Error_Message("REASF",Field_Required); end if; if Card_KF3.Secrf = " " then Error_Message("SECRF",Field_Required); end if; elsif Valid_Msg.Trtype = CHANGE then begin Working_String := " "; if Card_KF3.Secrf = " " then idm_command(idmrun,"return_readiness_f_reason2 $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Working_String(1..1),Length_of_String); if Working_String(1..1) = " " then Error_Message("SECRF",Field_Required); else Secrn_Type := Prres_Types'value(Working_String); end if; end if; if Card_KF3.Reasf = " " then idm_command(idmrun,"return_readiness_f_reason $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Working_String(1..1),Length_of_String); if Working_String(1..1) = " " then Error_Message("REASF",Field_Required); end if; end if; exception when others => Error_Message("TERRF",Can_Not_Validate_Correctly); end; end if; if Valid_Msg.Trtype = CHANGE and Card_KF3.Terrf = "# " then null; else Terrn_Type := Prres_Types'value(Card_KF3.Terrf); if Terrn_Type = Secrn_Type then Error_Message("TERRF",Bad_Field); end if; end if; end if; exception when others => Error_Message("TERRF",Bad_Field); end; -- -- -- CARAF and CADAF are mutually inclusive. these fields can be -- "#" when transaction is Change -- if (Card_KF3.Caraf = " " and Card_KF3.Cadaf.YY & Card_KF3.Cadaf.MM & Card_KF3.Cadaf.DD = " ") or (Valid_Msg.Trtype = CHANGE and Card_KF3.Caraf = "#" and Card_KF3.Cadaf.YY & Card_KF3.Cadaf.MM & Card_KF3.Cadaf.DD = "# ") then null; elsif Card_KF3.Caraf = " " then Error_Message("CARAF",Field_Required); elsif Card_KF3.Cadaf.YY & Card_KF3.Cadaf.MM & Card_KF3.Cadaf.DD = " " then Error_Message("CADAF",Field_Required); else -- -- if CARAF is reported, must equal 1 2 3 4 5 6 and not be equal to -- READF -- Valid_Value := string_to_integer(Card_KF3.Caraf); if Valid_Value not in 1..6 or Card_KF3.Caraf = Card_KF3.Readf then Error_Message("CARAF",Bad_Field); end if; -- -- if CADAF is reported, it must be > the header date -- if Card_KF3.Cadaf.YY & Card_KF3.Cadaf.MM & Card_KF3.Cadaf.DD <= Header_Date then Error_Message("CADAF",Bad_Field); else Validate_YYMMDD(Card_KF3.Cadaf.YY, Card_KF3.Cadaf.MM, Card_KF3.Cadaf.DD, "CADAF"); end if; end if; -- if Card_KF3.Limf /= " " then if Valid_Msg.Trtype = CHANGE and Card_KF3.Limf = "#" then null; else Valid_Value := string_to_integer(Card_KF3.Limf); if Valid_Value not in 1..6 or Card_KF3.Limf = Card_KF3.Readf then Error_Message("LIMF ",Bad_Field); end if; end if; end if; -- begin if Card_KF3.Rlimf /= " " then if Valid_Msg.Trtype = CHANGE and Card_KF3.Rlimf = "#" then null; else Rlim_Type := Rlim_Types'value(Card_KF3.Rlimf); end if; end if; exception when others => Error_Message("RLIMF",Bad_Field); end; -- Validate_YYMMDD(Card_KF3.Ricdf.YY, Card_KF3.Ricdf.MM, Card_KF3.Ricdf.DD, "RICDF"); -- -- if RESPF is reported it is validated the same as TREAD of -- card type K except POMCS is not a valid code. -- begin if Card_KF3.Respf /= " " then if Valid_Msg.Trtype = CHANGE and Card_KF3.Respf = "# " then null; elsif Card_KF3.Respf(3..5) = "HRS" then Valid_Value := string_to_integer(Card_KF3.Respf(1..2)); if Valid_Value not in 1..72 then raise constraint_error; end if; else Tread_Type := Tread_Types'value(Card_KF3.Respf); if Tread_Type = POMCS then raise constraint_error; end if; end if; end if; exception when others => Error_Message("RESPF",Bad_Field); end; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_kf3 := Card_KF3; Link_List; end if; end Process_Card_KF3; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "KF4" card. -- --********************************************************************** procedure Process_Card_KF4 is begin -- -- set up new access pointer for card KF4 -- Card_KF4 := new Card_Type_KF4; -- -- place strings in field components -- Card_KF4.Smcc1 := Input_Msg.card(15..16); Card_KF4.Smra1 := Input_Msg.card(17..18); Card_KF4.Smaa1 := Input_Msg.card(19..20); Card_KF4.Smrc1 := Input_Msg.card(21..22); Card_KF4.Smac1 := Input_Msg.card(23..24); Card_KF4.Smcc2 := Input_Msg.card(25..26); Card_KF4.Smra2 := Input_Msg.card(27..28); Card_KF4.Smaa2 := Input_Msg.card(29..30); Card_KF4.Smrc2 := Input_Msg.card(31..32); Card_KF4.Smac2 := Input_Msg.card(33..34); Card_KF4.Smcc3 := Input_Msg.card(35..36); Card_KF4.Smra3 := Input_Msg.card(37..38); Card_KF4.Smaa3 := Input_Msg.card(39..40); Card_KF4.Smrc3 := Input_Msg.card(41..42); Card_KF4.Smac3 := Input_Msg.card(43..44); Card_KF4.Smcc4 := Input_Msg.card(45..46); Card_KF4.Smra4 := Input_Msg.card(47..48); Card_KF4.Smaa4 := Input_Msg.card(49..50); Card_KF4.Smrc4 := Input_Msg.card(51..52); Card_KF4.Smac4 := Input_Msg.card(53..54); Card_KF4.Gccla := Input_Msg.card(55..56); Card_KF4.Gcclb := Input_Msg.card(57..58); Card_KF4.Gcclc := Input_Msg.card(59..60); Card_KF4.Spclu := Input_Msg.card(61..69); -- -- if SMCC1 is reported, all others fields of the group must be -- reported -- if Card_KF4.Smcc1 /= " " then Valid_Value := string_to_integer(Card_KF4.Smcc1); if Valid_Value not in 1..37 then Error_Message("SMCC1",Bad_Field); end if; Validate_Numeric(Card_KF4.Smra1,"SMRA1"); Validate_Numeric(Card_KF4.Smaa1,"SMAA1"); Validate_Numeric(Card_KF4.Smrc1,"SMRC1"); Validate_Numeric(Card_KF4.Smac1,"SMAC1"); else if Card_KF4.Smra1 /= " " or Card_KF4.Smaa1 /= " " or Card_KF4.Smrc1 /= " " or Card_KF4.Smac1 /= " " then Error_Message("SMCC1",Field_Required); end if; end if; -- -- if SMCC2 is reported, all others fields of the group must be -- reported unless SMCC2 is "# " and transaction is Change. -- if Card_KF4.Smcc2 /= " " then if Valid_Msg.Trtype = CHANGE and Card_KF4.Smcc2 = "# " then null; else Valid_Value := string_to_integer(Card_KF4.Smcc2); if Valid_Value not in 1..37 then Error_Message("SMCC2",Bad_Field); end if; Validate_Numeric(Card_KF4.Smra2,"SMRA2"); Validate_Numeric(Card_KF4.Smaa2,"SMAA2"); Validate_Numeric(Card_KF4.Smrc2,"SMRC2"); Validate_Numeric(Card_KF4.Smac2,"SMAC2"); end if; else if Card_KF4.Smra2 /= " " or Card_KF4.Smaa2 /= " " or Card_KF4.Smrc2 /= " " or Card_KF4.Smac2 /= " " then Error_Message("SMCC2",Field_Required); end if; end if; -- -- if SMCC3 is reported, all others fields of the group must be -- reported unless SMCC3 is "# " and transaction is Change. -- if Card_KF4.Smcc3 /= " " then if Valid_Msg.Trtype = CHANGE and Card_KF4.Smcc3 = "# " then null; else Valid_Value := string_to_integer(Card_KF4.Smcc3); if Valid_Value not in 1..37 then Error_Message("SMCC3",Bad_Field); end if; Validate_Numeric(Card_KF4.Smra3,"SMRA3"); Validate_Numeric(Card_KF4.Smaa3,"SMAA3"); Validate_Numeric(Card_KF4.Smrc3,"SMRC3"); Validate_Numeric(Card_KF4.Smac3,"SMAC3"); end if; else if Card_KF4.Smra3 /= " " or Card_KF4.Smaa3 /= " " or Card_KF4.Smrc3 /= " " or Card_KF4.Smac3 /= " " then Error_Message("SMCC3",Field_Required); end if; end if; -- -- if SMCC4 is reported, all others fields of the group must be -- reported unless SMCC4 is "# " and transaction is Change. -- if Card_KF4.Smcc4 /= " " then if Valid_Msg.Trtype = CHANGE and Card_KF4.Smcc4 = "# " then null; else Valid_Value := string_to_integer(Card_KF4.Smcc4); if Valid_Value not in 1..37 then Error_Message("SMCC4",Bad_Field); end if; Validate_Numeric(Card_KF4.Smra4,"SMRA4"); Validate_Numeric(Card_KF4.Smaa4,"SMAA4"); Validate_Numeric(Card_KF4.Smrc4,"SMRC4"); Validate_Numeric(Card_KF4.Smac4,"SMAC4"); end if; else if Card_KF4.Smra4 /= " " or Card_KF4.Smaa4 /= " " or Card_KF4.Smrc4 /= " " or Card_KF4.Smac4 /= " " then Error_Message("SMCC4",Field_Required); end if; end if; -- -- the fields for Graduated Combat Capability Levels must be -- reported successively: GCCLA before GCCLB, and both GCCLA -- and GCCLB before GCCLC. -- if Card_KF4.Gccla = " " then if Card_KF4.Gcclb /= " " then Error_Message("GCCLB",Bad_Field); end if; if Card_KF4.Gcclc /= " " then Error_Message("GCCLC",Bad_Field); end if; elsif Card_KF4.Gccla = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("GCCLA",Bad_Field); else if Card_KF4.Gccla /= "# " then Validate_Numeric(Card_KF4.Gccla,"GCCLA"); end if; if Card_KF4.Gcclb = " " then if Card_KF4.Gcclc /= " " then Error_Message("GCCLC",Bad_Field); end if; elsif Card_KF4.Gcclb = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("GCCLB",Bad_Field); else if Card_KF4.Gcclb /= "# " then Validate_Numeric(Card_KF4.Gcclb,"GCCLB"); end if; if Card_KF4.Gcclc = " " then null; elsif Card_KF4.Gcclc = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("GCCLC",Bad_Field); else if Card_KF4.Gcclc /= "# " then Validate_Numeric(Card_KF4.Gcclc,"GCCLC"); end if; end if; end if; end if; -- if Valid_Msg.Trtype /= CHANGE and Card_KF4.Spclu = "# " then Error_Message("SPCLU",Bad_Field); end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_kf4 := Card_KF4; Link_List; end if; end Process_Card_KF4; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "KN1" card. -- --********************************************************************** procedure Process_Card_KN1 is begin -- -- set up new access pointer for card KN1 -- Card_KN1 := new Card_Type_KN1; -- -- validate and convert PRMA -- begin Working_String := " "; Working_String(1..5) := Input_Msg.card(15..19); Card_KN1.Prma := Prma_Types'value(Working_String); exception when others => Error_Message("PRMA ",Bad_Field); end; -- -- place strings in field components -- Card_KN1.Marat := Input_Msg.card(20..20); Card_KN1.Marea := Input_Msg.card(21..23); Card_KN1.Chdat.YY := Input_Msg.card(24..25); Card_KN1.Chdat.MM := Input_Msg.card(26..27); Card_KN1.Chdat.DD := Input_Msg.card(28..29); Card_KN1.Fmart := Input_Msg.card(30..30); Card_KN1.Fcdat.YY := Input_Msg.card(31..32); Card_KN1.Fcdat.MM := Input_Msg.card(33..34); Card_KN1.Fcdat.DD := Input_Msg.card(35..36); -- -- if MARAT is reported, it must be 1 2 3 4 5 6. MAREA is required -- to be reported when MARAT is 2 3 4 and must be blank when MARAT -- is 1 5 6. -- begin if Card_KN1.Marat /= " " then Valid_Value := string_to_integer(Card_KN1.Marat); if Valid_Value not in 1..6 then Error_Message("MARAT",Bad_Field); end if; if Valid_Value in 2..4 then Marea_Type := Prres_Types'value(Card_KN1.Marea); elsif Card_KN1.Marea /= " " then raise constraint_error; end if; end if; exception when others => Error_Message("MAREA",Bad_Field); end; -- -- if CHDAT is not reported, use the system date -- if Card_KN1.Chdat.YY = " " and Card_KN1.Chdat.MM = " " and Card_KN1.Chdat.DD = " " then Card_KN1.Chdat.DD := "00"; if System_Day < 10 then Working_String(1..2) := integer'image(System_Day); Card_KN1.Chdat.DD(2..2) := Working_String(2..2); else Working_String(1..3) := integer'image(System_Day); Card_KN1.Chdat.DD := Working_String(2..3); end if; Card_KN1.Chdat.MM := "00"; if System_Month < 10 then Working_String(1..2) := integer'image(System_Month); Card_KN1.Chdat.MM(2..2) := Working_String(2..2); else Working_String(1..3) := integer'image(System_Month); Card_KN1.Chdat.MM := Working_String(2..3); end if; Working_String(1..5) := integer'image(System_Year); Card_KN1.Chdat.YY := Working_String(4..5); else Validate_YYMMDD(Card_KN1.Chdat.YY, Card_KN1.Chdat.MM, Card_KN1.Chdat.DD, "CHDAT"); end if; -- -- FCDAT and FMART are mutually inclusive. FMART must not be equal -- to MARAT. FCDAT must be > Header date. -- if Valid_Msg.Trtype = CHANGE and Card_KN1.Fmart = "#" and Card_KN1.Fcdat.YY & Card_KN1.Fcdat.MM & Card_KN1.Fcdat.DD = "# " then null; elsif Card_KN1.Fmart /= " " or Card_KN1.Fcdat.YY /= " " or Card_KN1.Fcdat.MM /= " " or Card_KN1.Fcdat.DD /= " " then Valid_Value := string_to_integer(Card_KN1.Fmart); if Valid_Value not in 1..6 or Card_KN1.Fmart = Card_KN1.Marat then Error_Message("FMART",Bad_Field); end if; if Card_KN1.Fcdat.YY = " " and Card_KN1.Fcdat.MM = " " and Card_KN1.Fcdat.DD = " " then Error_Message("FCDAT",Bad_Field); end if; Validate_YYMMDD(Card_KN1.Fcdat.YY, Card_KN1.Fcdat.MM, Card_KN1.Fcdat.DD, "FCDAT"); if Card_KN1.Fcdat.YY & Card_KN1.Fcdat.MM & Card_KN1.Fcdat.DD < Header_Date then Error_Message("FCDAT",Bad_Field); end if; end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_kn1 := Card_KN1; Link_List; end if; end Process_Card_KN1; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "TF1" card. -- --********************************************************************** procedure Process_Card_TF1 is begin -- -- set up new access pointer for card TF1 -- Card_TF1 := new Card_Type_TF1; -- -- place strings in field components -- Card_TF1.Ueqpt := Input_Msg.card(15..25); Card_TF1.Mesen := Input_Msg.card(26..29); Card_TF1.Meqs := Input_Msg.card(30..30); Card_TF1.Sedy := Input_Msg.card(31..31); Card_TF1.Tedy := Input_Msg.card(32..32); Card_TF1.Erddy.YY := Input_Msg.card(33..34); Card_TF1.Erddy.MM := Input_Msg.card(35..36); Card_TF1.Erddy.DD := Input_Msg.card(37..38); Card_TF1.Avail := Input_Msg.card(39..39); Card_TF1.Dcndy := Input_Msg.card(40..44); Card_TF1.Eqret.YY := Input_Msg.card(45..46); Card_TF1.Eqret.MM := Input_Msg.card(47..48); Card_TF1.Eqret.DD := Input_Msg.card(49..50); Card_TF1.Geogr := Input_Msg.card(51..54); Card_TF1.Operl.YY := Input_Msg.card(55..56); Card_TF1.Operl.MM := Input_Msg.card(57..58); Card_TF1.Operl.DD := Input_Msg.card(59..60); Card_TF1.Dafld := Input_Msg.card(63..66); -- -- UEQPT is required to be reported and will be validated against an -- IDM database relation MEQPT. -- if Card_TF1.Ueqpt = " " then Error_Message("UEQPT",Field_Required); else Validate_Meqpt(Card_TF1.Ueqpt,"UEQPT"); end if; -- -- MESEN is required to be reported -- if Card_TF1.Mesen = " " then Error_Message("MESEN",Field_Required); end if; -- -- if MEQS is reported validate against the meqs table and -- if MEQS is not equal to "X" or "Z" then OPERL must be reported -- begin if Card_TF1.Meqs /= " " then Meqs_Type := Meqs_Types'value(Card_TF1.Meqs); case Meqs_Type is when X | Z => null; when others => if Card_TF1.Operl.YY & Card_TF1.Operl.MM & Card_TF1.Operl.DD = " " then Error_Message("OPERL",Field_Required); end if; end case; end if; exception when others => Error_Message("MEQS ",Bad_Field); end; -- -- SEDY, when reported, must be 0 5 7 9 A B C F I J M N R V W Y Z X -- begin if Card_TF1.Sedy /= " " then Valid_Value := string_to_integer(Card_TF1.Sedy); if Valid_Value = 0 or Valid_Value = 5 or Valid_Value = 7 or Valid_Value = 9 then null; else Sedy_Type := Sedy_Types'value(Card_TF1.Sedy); end if; end if; exception when others => Error_Message("SEDY ",Bad_Field); end; -- -- if TEDY is reported, validate against the table -- if TEDY is not equal to "X" or "Z" then ERDDY must be reported -- begin if Card_TF1.Tedy /= " " then Tedy_Type := Tedy_Types'value(Card_TF1.Tedy); case Tedy_Type is when X | Z => null; when others => if Card_TF1.Erddy.YY & Card_TF1.Erddy.MM & Card_TF1.Erddy.DD = " " then Error_Message("ERDDY",Field_Required); end if; end case; end if; exception when others => Error_Message("TEDY ",Bad_Field); end; -- Validate_YYMMDD(Card_TF1.Erddy.YY, Card_TF1.Erddy.MM, Card_TF1.Erddy.DD, "ERDDY"); -- -- if AVAIL is reported, validate against AVAIL table. if reported -- as "C" or "D" then DCNDY must be reported. -- begin if Card_TF1.Avail /= " " then Avail_Type := Avail_Types'value(Card_TF1.Avail); if (Avail_Type = C or Avail_Type = D) and Card_TF1.Dcndy = " " then Error_Message("DCNDY",Field_Required); end if; end if; exception when others => Error_Message("AVAIL",Bad_Field); end; -- if Card_TF1.Eqret.YY & Card_TF1.Eqret.MM & Card_TF1.Eqret.DD = "# " and Valid_Msg.Trtype = CHANGE then null; else Validate_YYMMDD(Card_TF1.Eqret.YY, Card_TF1.Eqret.MM, Card_TF1.Eqret.DD, "EQRET"); end if; -- -- if GEOGR is reported, it will be validated against an IDM -- database relation Geolocation database. -- if Card_TF1.Geogr = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("GEOGR",Bad_Field); else Validate_Geolocation(Card_TF1.Geogr,"GEOGR"); end if; -- -- if OPERL is reported it must be >= the header date -- if Card_TF1.Operl.YY & Card_TF1.Operl.MM & Card_TF1.Operl.DD /= " " then if Card_TF1.Operl.YY & Card_TF1.Operl.MM & Card_TF1.Operl.DD < Header_Date then Error_Message("OPERL",Bad_Field); else Validate_YYMMDD(Card_TF1.Operl.YY, Card_TF1.Operl.MM, Card_TF1.Operl.DD, "OPERL"); end if; end if; -- if Card_TF1.Dafld = "# " and Valid_Msg.Trtype /= CHANGE then Error_Message("DALFD",Bad_Field); end if; -- -- if card is valid, place access pointer in message list and -- set up new access pointer for message list -- if not Bad_Message then Valid_Msg.access_tf1 := Card_TF1; Link_List; end if; end Process_Card_TF1; --********************************************************************** -- -- This procedure does the processing for the validation of the -- fields of a "E " card. -- --********************************************************************** procedure Process_Card_E is begin -- -- set up new access pointer for card E -- Card_E := new Card_Type_E; -- -- place card sequence number in card number field -- Valid_Msg.Card_Number := Seq_Number; -- -- validate and convert security classification -- begin Working_String := " "; Working_String(1..1) := Input_Msg.card(4..4); Valid_Msg.Secur := Secur_Types'value(Working_String); exception when others => Error_Message("SECUR",Bad_Field); end; -- -- if card is valid place access pointer in message list and -- set access pointer for message list to null and queue message -- to DBB module -- if not Bad_Message then Valid_Msg.access_e := Card_E; Valid_Msg.next := null; Valid_Message; end if; end Process_Card_E; --********************************************************************** -- -- This procedure will notify the MMI of invalid -- UNITREP messages -- --********************************************************************** procedure Invalid_Unitrep_Message is begin tpsend(mv_id,mmi_id,invalid_message,First_Input_Msg,tp2,tp3,tp4,tp5); tpsend(mv_id,mmi_id,invalid_message,First_Error_Msg,tp2,tp3,tp4,tp5); if Terminate_Module_Flag and Last_Message = -1 then tpsend(mv_id,dbb_id,validated_data,tp1,Last_Message_String,tp3, tp4,tp5); tpsend(mv_id,mmi_id,module_terminated,tp1,tp2,tp3,tp4,tp5); task_initialized := false; end if; Nbr_of_Invalid_Messages := Nbr_of_Invalid_Messages + 1; end Invalid_Unitrep_Message; --********************************************************************** -- -- This procedure will queue validated messages to DBB -- --********************************************************************** procedure Valid_Message is begin if Terminate_Module_Flag and Last_Message = -1 then tpsend(mv_id,dbb_id,validated_data,tp1,Last_Message_String,tp3, tp4,First_Valid_Msg.Next); tpsend(mv_id,mmi_id,module_terminated,tp1,tp2,tp3,tp4,tp5); task_initialized := false; else tpsend(mv_id,dbb_id,validated_data,tp1,tp2,tp3,tp4, First_Valid_Msg.Next); end if; Nbr_of_Valid_Messages := Nbr_of_Valid_Messages + 1; end Valid_Message; --********************************************************************** -- -- This procedure processes the "send statistics" request by -- sending two packets to the MMI. The first one sends Invalid -- Message count; the second sends Valid Message count. -- --********************************************************************** procedure Send_Stats is begin Tmp_Text_Type(1..34) := "Number of Invalid UNITREP Messages"; tpsend(mv_id,mmi_id,statistics,tp1,Tmp_Text_Type, Nbr_of_Invalid_Messages,tp4,tp5); Tmp_Text_Type(1..34) := "Number of Valid UNITREP Messages "; tpsend(mv_id,mmi_id,statistics,tp1,Tmp_Text_Type, Nbr_of_Valid_Messages,tp4,tp5); end Send_Stats; --********************************************************************** -- -- This procedure gets and stores the system date using functions -- of the predefined package CALENDAR. -- --********************************************************************** procedure Get_and_Store_System_Date is begin System_Time := clock; System_Year := year(System_Time); System_Month := month(System_Time); System_Day :=calendar.day(System_Time); end Get_and_Store_System_Date; --********************************************************************** -- -- This procedure updates the recursive access pointer list of -- valid messages. -- --********************************************************************** procedure Link_List is begin Valid_Msg.next := new Msg_List; Valid_Msg := Valid_Msg.next; end Link_List; --********************************************************************** -- -- This procedure writes error messages into a buffer for display -- to the operator. -- --********************************************************************** procedure Error_Message(s : in string; e : in Error_Msg_Types) is begin Bad_Message := true; case e is when Bad_Field => Error_Msg_Text(Bad_Field)(5..9) := s; Error_Msg_Text(Bad_Field)(41..43) := integer_to_string(Seq_Number); Error_Msg.card := Error_Msg_Text(Bad_Field); when Bad_Sequence => Error_Msg.card := Error_Msg_Text(Bad_Sequence); when No_Header => Error_Msg.card := Error_Msg_Text(No_Header); when No_End => Error_Msg.card := Error_Msg_Text(No_End); when Field_Required => Error_Msg_Text(Field_Required)(1..5) := s; Error_Msg_Text(Field_Required)(46..48) := integer_to_string(Seq_Number); Error_Msg.card := Error_Msg_Text(Field_Required); when Bad_Card_Type => Error_Msg_Text(Bad_Card_Type)(36..38) := integer_to_string(Seq_Number); Error_Msg.card := Error_Msg_Text(Bad_Card_Type); when Mutually_Exclusive => Error_Msg_Text(Mutually_Exclusive)(57..59) := integer_to_string(Seq_Number); Error_Msg.card := Error_Msg_Text(Mutually_Exclusive); when Can_Not_Validate_Correctly => Error_Msg_Text(Can_Not_Validate_Correctly)(18..22) := s; Error_Msg_Text(Can_Not_Validate_Correctly)(64..66) := integer_to_string(Seq_Number); end case; Error_Msg.next := new Msg_Card_List; Error_Msg := Error_Msg.next; end Error_Message; --********************************************************************** -- -- This procedure validates the UIC. -- --********************************************************************** procedure Validate_Uic(Uic : in string ; Field_Name : in string) is Department : string(1..1); Nbr : string(1..5); work_nbr : string(1..1); begin Department := Uic(1..1); Nbr := Uic(2..6); if Department = "D" then work_nbr := Nbr(1..1); Uic2_Department_Type := Uic2_Department_Types'value(work_nbr); if Nbr(2..5) = " " then raise constraint_error; else Validate_Numeric(Nbr(2..5),Field_Name); end if; else Department_Type := Department_Types'value(Department); if Nbr = " " then raise constraint_error; else Validate_Numeric(Nbr,Field_Name); end if; end if; if Valid_Msg.Card_Type /= A and Invalid_Uic(Uic) then raise constraint_error; end if; exception when others => Error_Message(Field_Name,Bad_Field); end Validate_Uic; --********************************************************************** -- -- This procedure validates a date in the format YYMMDD. -- --********************************************************************** procedure Validate_YYMMDD(YY : in string ; MM : in string ; DD : in string ; Field_Name : in string) is begin if YY /= " " or MM /= " " or DD /= " " then Valid_Value := string_to_integer(YY); if Valid_Value < 0 then raise constraint_error; end if; Leap_Year := Valid_Value / 4; Leap_Year := Valid_Value - (Leap_Year * 4); if Leap_Year = 0 then Days_in_Month(2) := 29; else Days_in_Month(2) := 28; end if; Month_of_Year := string_to_integer(MM); if Month_of_Year not in 1..12 then raise constraint_error; end if; Valid_Value := string_to_integer(DD); if Valid_Value not in 1..Days_in_Month(Month_of_Year) then raise constraint_error; end if; end if; exception when others => Error_Message(Field_Name,Bad_Field); end Validate_YYMMDD; --********************************************************************** -- -- This procedure validates a date in the format DDDYY. -- --********************************************************************** procedure Validate_DDDYY(DDD : in string ; YY : in string ; Field_Name : in string) is begin if DDD /= " " or YY /= " " then Valid_Value := string_to_integer(YY); if Valid_Value < 1 then raise constraint_error; end if; Leap_Year := Valid_Value / 4; Leap_Year := Valid_Value - (Leap_Year * 4); if Leap_Year = 0 then Days_in_Year := 366; else Days_in_Year := 365; end if; Valid_Value := string_to_integer(DDD); if Valid_Value not in 1..Days_in_Year then raise constraint_error; end if; end if; exception when others => Error_Message(Field_Name,Bad_Field); end Validate_DDDYY; --********************************************************************** -- -- This procedure validates fields using the ORUIC table. -- --********************************************************************** procedure Validate_Oruic(Oruic : in string ; Field_Name : in string) is begin if Oruic /= " " then Oruic_Type := Oruic_Types'value(Oruic); end if; exception when others => Error_Message(Field_Name,Bad_Field); end Validate_Oruic; --********************************************************************** -- -- This procedure validates fields that use the Unit Description Code. -- --********************************************************************** procedure Validate_Udc(Udc : in string ; Field_Name : in string) is begin Udc_Valid := true; if Udc /= " " then Valid_Value := string_to_integer(Udc); if Valid_Value < 0 then Udc_Type := Udc_Types'value(Udc); elsif Valid_Value > 9 then raise constraint_error; end if; end if; exception when others => Error_Message(Field_Name,Bad_Field); Udc_Valid := false; end Validate_Udc; --********************************************************************** -- -- This procedure validates fields that use the Unit Level Code. -- --********************************************************************** procedure Validate_Ulc(Ulc : in string ; Field_Name : in string) is begin if Ulc /= " " then if Ulc /= "FOR" then Ulc_Type := Ulc_Types'value(Ulc); end if; end if; exception when others => Error_Message(Field_Name,Bad_Field); end Validate_Ulc; --********************************************************************** -- -- This procedure validates that a field is all numeric. -- --********************************************************************** procedure Validate_Numeric(num : in string ; Field_Name : in string) is begin working_string := " "; if num(num'first..num'last) /= working_string(1..num'last-num'first+1) then for j in num'range loop if num(j) not in '0'..'9' then Error_Message(Field_Name,Bad_Field); exit; end if; end loop; end if; exception when others => put_line("problem in validate numeric"); end Validate_Numeric; --********************************************************************** -- -- This procedure validates a PIN field. -- -- the field PIN (Plan Identification Number) in card types N,P, -- Q, and T should be validated an follows: -- -- (a) The first character MUST be one of the following: -- -- 0,1,2,3,4,5,6,7,8,9,A,B,D,E,F,G,H,K,L,M,N,P,R,S -- -- (b) If the first character is numeric -- -- the 2nd, 3rd, & 4th character must be numeric -- -- the 5th character must not be numeric -- -- (c) The first four characters may not be 0000 (because numeric -- plan numbers are assigned beginning with plan 0001) -- -- (d) The field may not contain embedded blanks. -- (e) The field may not contain non-alphabetic characters such -- as / # * " etc. -- (f) The field may not be blank (i.e., all spaces). -- --********************************************************************** procedure Validate_Pin(Valid_Pin : in string ; Field_Name : in string) is begin Valid_Value := string_to_integer(Valid_Pin(1..4)); if Valid_Value = -1 then Pin_Type := Pin_Types'value(Valid_Pin(1..1)); Valid_Value := string_to_integer(Valid_Pin(2..4)); if Valid_Value < 1 then raise constraint_error; end if; elsif Valid_Value = 0 then raise constraint_error; elsif Valid_Pin(5) /= ' ' then Pin_Type := Pin_Types'value(Valid_Pin(5..5)); end if; exception when others => Error_Message(Field_Name,Bad_Field); end Validate_Pin; --********************************************************************** -- -- This procedure validates the MEQPT field by doing a look-up -- against an IDM database relation MEQPT. -- --********************************************************************** procedure Validate_Meqpt(Meqpt : in string ; Field_Name : in string) is Tcom : string(1..2); begin -- tell interface which stored command we will be using idm_command(idmrun,"return_meqpt $1"); -- load the parameter(s) for that stored command idm_param(idmrun,"$1",Meqpt,idm_char); -- execute stored command and get data if any idm_execute(idmrun); idm_fetch(idmrun); -- read the column(s) returned by the stored command idm_column(idmrun,1,Tcom,Length_of_String); -- if field is a Telecommunication Equipment field check -- Telecommunication Equipment flag to by sure equipment -- is telecommunication. if Field_Name = "TEQPT" and Tcom = " " then Error_Message(Field_Name,Bad_Field); end if; exception when done_error => Error_Message(Field_Name,Bad_Field); when others => put_line("problems with meqpt validation"); end Validate_Meqpt; --********************************************************************** -- -- This procedure validates the GEOLOCATION fields by doing a -- look up against an IDM database relation GEOLOC. -- --********************************************************************** procedure Validate_Geolocation(Geolocation : in string ; Field_Name : in string) is Geoloc : string(1..4); begin -- tell interface which stored command we will be using idm_command(idmrun,"return_geolocation $1"); -- load the parameter(s) to be used by command idm_param(idmrun,"$1",Geolocation,idm_char); -- execute stored command and get data if any idm_execute(idmrun); idm_fetch(idmrun); -- read in data returned by stored command idm_column(idmrun,1,Geoloc,Length_of_String); exception when done_error => Error_Message(Field_Name,Bad_Field); when others => put_line("problem with geolocation validation"); end Validate_Geolocation; --********************************************************************** -- -- This procedure loads values extracted from the EQUIP relation -- on the IDM. The values will be related to MEPSD. -- --********************************************************************** procedure Load_Meq_Values is begin idm_command(idmrun,"return_meq_fields $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Meord_Value); idm_column(idmrun,2,Meorn_Value); idm_column(idmrun,3,Meorc_Value); idm_column(idmrun,4,Meoro_Value); exception when others => Error_Message("MEPSD",Can_Not_Validate_Correctly); end Load_Meq_Values; --********************************************************************** -- -- This procedure loads values extracted from the EQUIP relation -- on the IDM. The values will be related to CREWF. -- --********************************************************************** procedure Load_Crew_Values is begin idm_command(idmrun,"return_crew_fields $1"); idm_param(idmrun,"$1",Valid_Msg.Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,Crmrd_Value); idm_column(idmrun,2,Crmrn_Value); idm_column(idmrun,3,Crmrc_Value); idm_column(idmrun,4,Crmro_Value); exception when others => Error_Message("MEPSD",Can_Not_Validate_Correctly); end Load_Crew_Values; --********************************************************************** -- -- This function returns "true" if a field is not a valid UIC. -- --********************************************************************** function Invalid_Uic(Uic : in string) return boolean is Working_Uic : string(1..6); begin if Uic(5..6) = " " then return true; else -- -- see if a bide relation exists for this UIC on the IDM -- idm_command(idmrun,"return_uic $1"); idm_param(idmrun,"$1",Uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); Working_Uic := Uic; idm_column(idmrun,1,Working_Uic,Length_of_String); return false; end if; exception when others => return true; end Invalid_Uic; --********************************************************************** -- -- This function returns "true" if a field is not a valid -- Geolocation. Performs a look-up on the Geoloc relation -- on the IDM. -- --********************************************************************** function Invalid_Geo(Geo : in string) return boolean is Working_Geo : string(1..4); begin idm_command(idmrun,"return_geolocation $1"); idm_param(idmrun,"$1",Geo,idm_char); idm_execute(idmrun); idm_fetch(idmrun); Working_Geo := Geo(1..4); idm_column(idmrun,1,Working_Geo,Length_of_String); return false; exception when others => return true; end Invalid_Geo; begin null; exception when others => put_line("message validation module dead"); end Message_Validation_Module; --:::::::::: --dbb.src --:::::::::: with System_Utilities; use System_Utilities; with text_io; use text_io; with MSG_Types; use MSG_Types; with IDM_DEFS; use IDM_DEFS; with IDM_IO; use IDM_IO; with calendar; use calendar; package Database_Build is task Database_Build_Task is entry rendezvous_point(in_packet : in Packet_Access); end Database_Build_Task; end Database_Build; package body Database_Build is working_string : string(1..5) := " "; message_counter : integer; last_message : constant string := "LAST MESSAGE"; terminate_task : boolean; last_msg_received : boolean; type task_state_type is (not_initialized, active, termination_requested); task_state : task_state_type; report_as_of_time : string(1..8); list_item : Access_Msg_List; idmrun : idmrun_type; save_secur : string(1..1); working_secur : string(1..1); save_date : string(1..8); system_time : time; system_year : integer; system_month : integer; system_day : integer; system_date : string(1..8); length_of_string : integer; stats_text : string(1..60) := " "; -- 123456789 123456789 123456789 123456789 123456789 123456789 access_h : Access_Card_Type_H; access_e : Access_Card_Type_E; access_a : Access_Card_Type_A; access_b : Access_Card_Type_B; access_c : Access_Card_Type_C; access_d : Access_Card_Type_D; access_g : Access_Card_Type_G; access_j : Access_Card_Type_J; access_k : Access_Card_Type_K; access_l : Access_Card_Type_L; access_m : Access_Card_Type_M; access_n : Access_Card_Type_N; access_p : Access_Card_Type_P; access_q : Access_Card_Type_Q; access_t : Access_Card_Type_T; access_v : Access_Card_Type_V; access_x : Access_Card_Type_X; access_r : Access_Card_Type_R; access_dm1 : Access_Card_Type_DM1; access_dn1 : Access_Card_Type_DN1; access_jm1 : Access_Card_Type_JM1; access_kf1 : Access_Card_Type_KF1; access_kf2 : Access_Card_Type_KF2; access_kf3 : Access_Card_Type_KF3; access_kf4 : Access_Card_Type_KF4; access_kn1 : Access_Card_Type_KN1; access_tf1 : Access_Card_Type_TF1; procedure process_message; procedure process_card_h; procedure process_card_a; procedure process_card_b; procedure process_card_c; procedure process_card_d; procedure process_card_g; procedure process_card_j; procedure process_card_k; procedure process_card_l; procedure process_card_m; procedure process_card_n; procedure process_card_p; procedure process_card_q; procedure process_card_r; procedure process_card_t; procedure process_card_v; procedure process_card_x; procedure process_card_dm1; procedure process_card_dn1; procedure process_card_jm1; procedure process_card_kf1; procedure process_card_kf2; procedure process_card_kf3; procedure process_card_kf4; procedure process_card_kn1; procedure process_card_tf1; procedure get_and_store_system_date; --********************************************************************* --* --* DATABASE_BUILD_TASK --* --* This task is the main process controlling the database build --* module. The task will process operator commands received from --* the Man/Machine Interface (MMI) module, will construct the --* database commands to be send to the database machine from --* the validated UNITREP message buffers received from the --* Message Validation (MV) module, and will maintain message --* throughput statistics. --* --********************************************************************* task body Database_Build_Task is begin -- loop until the terminate system operator request is -- received from the MV module and the last message is -- processed terminate_task := FALSE; while not terminate_task loop -- accept and process task packet as function of function code -- contained in packet accept rendezvous_point(in_packet : in Packet_Access) do if task_state = not_initialized then if in_packet.FTN = Coldstart_Module or in_packet.FTN = Restart_Module then if in_packet.FTN = Coldstart_Module then message_counter := 0; end if; tpsend(dbb_id,mmi_id,Module_Initialized,tp1,tp2,tp3,tp4,tp5); task_state := active; else tpsend(dbb_id,mmi_id,Fixed_Alert,tp1,tp2,tp3,Invalid_Ftn_Code,tp5); end if; else case in_packet.FTN is when Send_Statistics => stats_text(1..34) := "Number of records processed "; tpsend(dbb_id,mmi_id,Statistics,tp1,stats_text,Message_counter,tp4,tp5); when Terminate_Module => task_state := termination_requested; when Validated_Data => list_item := in_packet.MSG_PTR; if list_item /= null then process_message; message_counter := message_counter + 1; else tpsend(dbb_id,mmi_id,Fixed_Alert,tp1,tp2,tp3,Invalid_Ftn_Code,tp5); end if; when others => tpsend(dbb_id,mmi_id,Fixed_Alert,tp1,tp2,tp3,Invalid_Ftn_Code,tp5); end case; end if; if in_packet.var_string(1 .. last_message'length) = last_message then last_msg_received := TRUE; end if; if last_msg_received or task_state = termination_requested then -- terminate_task := TRUE; last_msg_received := FALSE; task_state := not_initialized; tpsend(dbb_id,mmi_id,Module_Terminated,tp1,tp2,tp3,tp4,tp5); end if; end rendezvous_point; end loop; exception when others => put_line("Database Build task dead"); end Database_Build_Task; --********************************************************************* --* --* PROCESS_MESSAGE --* --* This procedure will process the validated UNITREP message --* received from the MV module. Each item in the received --* linked list is processed as a function of the card type until --* the item containing the End card is detected. --* --********************************************************************* procedure process_message is begin idm_initrun(true); idm_openrun(idmrun,"sys_idm"); idm_opendb(idmrun,"unitrep"); loop case list_item.card_type is when A => process_card_a; when B => process_card_b; when C => process_card_c; when D => process_card_d; when G => process_card_g; when J => process_card_j; when K => process_card_k; when L => process_card_l; when M => process_card_m; when N => process_card_n; when P => process_card_p; when Q => process_card_q; when R | RM3 => process_card_r; when T => process_card_t; when V => process_card_v; when X => process_card_x; when DM1 => process_card_dm1; when DN1 => process_card_dn1; when JM1 => process_card_jm1; when KF1 => process_card_kf1; when KF2 => process_card_kf2; when KF3 => process_card_kf3; when KF4 => process_card_kf4; when KN1 => process_card_kn1; when TF1 => process_card_tf1; when H => process_card_h; when E => exit; end case; list_item := list_item.next; end loop; end process_message; --********************************************************************* --* --* PROCESS_CARD_H --* --* This procedure will process the message header card. --* The report "as of" time is retrieved from the card. --* --********************************************************************* procedure process_card_h is begin access_h := list_item.access_h; report_as_of_time(1..2) := "19"; working_string(1..3) := integer'image(access_h.year); report_as_of_time(3..4) := working_string(2..3); report_as_of_time(5..8) := "0000"; if access_h.day < 10 then working_string(1..2) := integer'image(access_h.day); report_as_of_time(6..6) := working_string(2..2); else working_string(1..3) := integer'image(access_h.day); report_as_of_time(5..6) := working_string(2..3); end if; if access_h.month in JAN..SEP then working_string(1..2) := integer'image(Month_Types'pos(access_h.month)+1); report_as_of_time(8..8) := working_string(2..2); else working_string(1..3) := integer'image(Month_Types'pos(access_h.month)+1); report_as_of_time(7..8) := working_string(2..3); end if; end process_card_h; --********************************************************************* --* --* PROCESS_CARD_A --* --* This procedure will process the message cards of type 'A'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_a is save_aname : string(1..30); save_utc : string(1..5); save_ulc : string(1..3); save_udc : string(1..1); save_reval : string(1..1); save_mjcom : string(1..6); save_major : string(1..1); save_tpsn : string(1..7); save_sclas : string(1..1); begin access_a := list_item.access_a; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_a $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_aname,length_of_string); idm_column(idmrun,4,save_utc,length_of_string); idm_column(idmrun,5,save_ulc,length_of_string); idm_column(idmrun,6,save_udc,length_of_string); idm_column(idmrun,7,save_reval,length_of_string); idm_column(idmrun,8,save_mjcom,length_of_string); idm_column(idmrun,9,save_major,length_of_string); idm_column(idmrun,10,save_tpsn,length_of_string); idm_column(idmrun,11,save_sclas,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_a $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_a $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$5",access_a.aname,idm_char); idm_param(idmrun,"$6",access_a.utc,idm_char); idm_param(idmrun,"$7",access_a.ulc,idm_char); idm_param(idmrun,"$8",access_a.udc,idm_char); idm_param(idmrun,"$9",access_a.reval,idm_char); idm_param(idmrun,"$10",access_a.mjcom,idm_char); idm_param(idmrun,"$11",access_a.major,idm_char); idm_param(idmrun,"$12",access_a.tpsn,idm_char); idm_param(idmrun,"$13",access_a.sclas,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_a.aname /= save_aname and access_a.aname /= " " then idm_param(idmrun,"$5",access_a.aname,idm_char); else idm_param(idmrun,"$5",save_aname,idm_char); end if; if access_a.utc /= save_utc and access_a.utc /= " " then idm_param(idmrun,"$6",access_a.utc,idm_char); else idm_param(idmrun,"$6",save_utc,idm_char); end if; if access_a.ulc /= save_ulc and access_a.ulc /= " " then idm_param(idmrun,"$7",access_a.ulc,idm_char); else idm_param(idmrun,"$7",save_ulc,idm_char); end if; if access_a.udc /= save_udc and access_a.udc /= " " then idm_param(idmrun,"$8",access_a.udc,idm_char); else idm_param(idmrun,"$8",save_udc,idm_char); end if; if access_a.reval /= save_reval and access_a.reval /= " " then idm_param(idmrun,"$9",access_a.reval,idm_char); else idm_param(idmrun,"$9",save_reval,idm_char); end if; if access_a.mjcom /= save_mjcom and access_a.mjcom /= " " then idm_param(idmrun,"$10",access_a.mjcom,idm_char); else idm_param(idmrun,"$10",save_mjcom,idm_char); end if; if access_a.major = "#" then idm_param(idmrun,"$11"," ",idm_char); elsif access_a.major /= save_major and access_a.major /= " " then idm_param(idmrun,"$11",access_a.major,idm_char); else idm_param(idmrun,"$11",save_major,idm_char); end if; if access_a.tpsn /= save_tpsn and access_a.tpsn /= " " then idm_param(idmrun,"$12",access_a.tpsn,idm_char); else idm_param(idmrun,"$12",save_tpsn,idm_char); end if; if access_a.sclas /= save_sclas and access_a.sclas /= " " then idm_param(idmrun,"$13",access_a.sclas,idm_char); else idm_param(idmrun,"$13",save_sclas,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_a; --********************************************************************* --* --* PROCESS_CARD_B --* --* This procedure will process the message cards of type 'B'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_b is save_lname : string(1..55); begin access_b := list_item.access_b; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_b $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_lname,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_b $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_b $1 $2 $3 $4"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$3",system_date,idm_char); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$4",access_b.lname,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if access_b.lname /= save_lname and access_b.lname /= " " then idm_param(idmrun,"$4",access_b.lname,idm_char); else idm_param(idmrun,"$4",save_lname,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_b; --********************************************************************* --* --* PROCESS_CARD_C --* --* This procedure will process the message cards of type 'C'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_c is save_aname : string(1..30); save_utc : string(1..5); save_ulc : string(1..3); save_udc : string(1..1); save_coaff : string(1..2); save_monor : string(1..6); save_sclas : string(1..1); begin access_c := list_item.access_c; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_c $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_aname,length_of_string); idm_column(idmrun,3,save_utc,length_of_string); idm_column(idmrun,4,save_ulc,length_of_string); idm_column(idmrun,5,save_udc,length_of_string); idm_column(idmrun,6,save_coaff,length_of_string); idm_column(idmrun,7,save_monor,length_of_string); idm_column(idmrun,8,save_sclas,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_c $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_c $1 $2 $3 $4 $5 $6 $7 $8 $9 $10"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$3",system_date,idm_char); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$4",access_c.aname,idm_char); idm_param(idmrun,"$5",access_c.utc,idm_char); idm_param(idmrun,"$6",access_c.ulc,idm_char); idm_param(idmrun,"$7",access_c.udc,idm_char); idm_param(idmrun,"$8",access_c.coaff,idm_char); idm_param(idmrun,"$9",access_c.monor,idm_char); idm_param(idmrun,"$10",access_c.sclas,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if access_c.aname /= save_aname and access_c.aname /= " " then idm_param(idmrun,"$4",access_c.aname,idm_char); else idm_param(idmrun,"$4",save_aname,idm_char); end if; if access_c.utc /= save_utc and access_c.utc /= " " then idm_param(idmrun,"$5",access_c.utc,idm_char); else idm_param(idmrun,"$5",save_utc,idm_char); end if; if access_c.ulc /= save_ulc and access_c.ulc /= " " then idm_param(idmrun,"$6",access_c.ulc,idm_char); else idm_param(idmrun,"$6",save_ulc,idm_char); end if; if access_c.udc /= save_udc and access_c.udc /= " " then idm_param(idmrun,"$7",access_c.udc,idm_char); else idm_param(idmrun,"$7",save_udc,idm_char); end if; if access_c.coaff /= save_coaff and access_c.coaff /= " " then idm_param(idmrun,"$8",access_c.coaff,idm_char); else idm_param(idmrun,"$8",save_coaff,idm_char); end if; if access_c.monor /= save_monor and access_c.monor /= " " then idm_param(idmrun,"$9",access_c.monor,idm_char); else idm_param(idmrun,"$9",save_monor,idm_char); end if; if access_c.sclas /= save_sclas and access_c.sclas /= " " then idm_param(idmrun,"$10",access_c.sclas,idm_char); else idm_param(idmrun,"$10",save_sclas,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_c; --********************************************************************* --* --* PROCESS_CARD_D --* --* This procedure will process the message cards of type 'D'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_d is save_opcon : string(1..6); save_adcon : string(1..6); save_cserv : string(1..1); save_hogeo : string(1..4); save_prgeo : string(1..4); save_point : string(1..15); save_embrk : string(1..6); save_activ : string(1..2); save_flag : string(1..1); save_puic : string(1..6); save_cbcom : string(1..1); save_dfcon : string(1..1); save_pctef : string(1..1); save_nucin : string(1..1); begin access_d := list_item.access_d; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_d $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_opcon,length_of_string); idm_column(idmrun,4,save_adcon,length_of_string); idm_column(idmrun,5,save_cserv,length_of_string); idm_column(idmrun,6,save_hogeo,length_of_string); idm_column(idmrun,7,save_prgeo,length_of_string); idm_column(idmrun,8,save_point,length_of_string); idm_column(idmrun,9,save_embrk,length_of_string); idm_column(idmrun,10,save_activ,length_of_string); idm_column(idmrun,11,save_flag,length_of_string); idm_column(idmrun,12,save_puic,length_of_string); idm_column(idmrun,13,save_cbcom,length_of_string); idm_column(idmrun,14,save_dfcon,length_of_string); idm_column(idmrun,15,save_pctef,length_of_string); idm_column(idmrun,16,save_nucin,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_d $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_d $1 $2 $3 $4 $5 $6 $7 $8 $9 " & "$10 $11 $12 $13 $14 $15 $16 $17 $18"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$5",access_d.opcon,idm_char); idm_param(idmrun,"$6",access_d.adcon,idm_char); idm_param(idmrun,"$7",access_d.cserv,idm_char); idm_param(idmrun,"$8",access_d.hogeo,idm_char); idm_param(idmrun,"$9",access_d.prgeo,idm_char); idm_param(idmrun,"$10",access_d.point,idm_char); idm_param(idmrun,"$11",access_d.embrk,idm_char); idm_param(idmrun,"$12",access_d.activ,idm_char); idm_param(idmrun,"$13",access_d.flag,idm_char); idm_param(idmrun,"$14",access_d.puic,idm_char); idm_param(idmrun,"$15",access_d.cbcom,idm_char); idm_param(idmrun,"$16",access_d.dfcon,idm_char); idm_param(idmrun,"$17",access_d.pctef,idm_char); idm_param(idmrun,"$18",access_d.nucin,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_d.opcon /= save_opcon and access_d.opcon /= " " then idm_param(idmrun,"$5",access_d.opcon,idm_char); else idm_param(idmrun,"$5",save_opcon,idm_char); end if; if access_d.adcon /= save_adcon and access_d.adcon /= " " then idm_param(idmrun,"$6",access_d.adcon,idm_char); else idm_param(idmrun,"$6",save_adcon,idm_char); end if; if access_d.cserv /= save_cserv and access_d.cserv /= " " then idm_param(idmrun,"$7",access_d.cserv,idm_char); else idm_param(idmrun,"$7",save_cserv,idm_char); end if; if access_d.hogeo /= save_hogeo and access_d.hogeo /= " " then idm_param(idmrun,"$8",access_d.hogeo,idm_char); else idm_param(idmrun,"$8",save_hogeo,idm_char); end if; if access_d.prgeo /= save_prgeo and access_d.prgeo /= " " then idm_param(idmrun,"$9",access_d.prgeo,idm_char); else idm_param(idmrun,"$9",save_prgeo,idm_char); end if; if access_d.point /= save_point and access_d.point /= " " then idm_param(idmrun,"$10",access_d.point,idm_char); else idm_param(idmrun,"$10",save_point,idm_char); end if; if access_d.embrk /= save_embrk and access_d.embrk /= " " then idm_param(idmrun,"$11",access_d.embrk,idm_char); else idm_param(idmrun,"$11",save_embrk,idm_char); end if; if access_d.activ /= save_activ and access_d.activ /= " " then idm_param(idmrun,"$12",access_d.activ,idm_char); else idm_param(idmrun,"$12",save_activ,idm_char); end if; if access_d.flag = "#" then idm_param(idmrun,"$13"," "); elsif access_d.flag /= save_flag and access_d.flag /= " " then idm_param(idmrun,"$13",access_d.flag,idm_char); else idm_param(idmrun,"$13",save_flag,idm_char); end if; if access_d.puic = "# " then idm_param(idmrun,"$14"," "); elsif access_d.puic /= save_puic and access_d.puic /= " " then idm_param(idmrun,"$14",access_d.puic,idm_char); else idm_param(idmrun,"$14",save_puic,idm_char); end if; if access_d.cbcom = "#" then idm_param(idmrun,"$15"," "); elsif access_d.cbcom /= save_cbcom and access_d.cbcom /= " " then idm_param(idmrun,"$15",access_d.cbcom,idm_char); else idm_param(idmrun,"$15",save_cbcom,idm_char); end if; if access_d.dfcon /= save_dfcon and access_d.dfcon /= " " then idm_param(idmrun,"$16",access_d.dfcon,idm_char); else idm_param(idmrun,"$16",save_dfcon,idm_char); end if; if access_d.pctef = "#" then idm_param(idmrun,"$17"," "); elsif access_d.pctef /= save_pctef and access_d.pctef /= " " then idm_param(idmrun,"$17",access_d.pctef,idm_char); else idm_param(idmrun,"$17",save_pctef,idm_char); end if; if access_d.nucin = "#" then idm_param(idmrun,"$18"," "); elsif access_d.nucin /= save_nucin and access_d.nucin /= " " then idm_param(idmrun,"$18",access_d.nucin,idm_char); else idm_param(idmrun,"$18",save_nucin,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_d; --********************************************************************* --* --* PROCESS_CARD_G --* --* This procedure will process the message cards of type 'G'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_g is save_tcaa : string(1..29); save_tadc : string(1..1); save_media : string(1..1); save_route : string(1..7); save_rwdte : integer; save_xrte : string(1..7); save_xdate : integer; working_rwdte : integer; working_xdate : integer; begin access_g := list_item.access_g; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_g $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_tcaa,length_of_string); idm_column(idmrun,4,save_tadc,length_of_string); idm_column(idmrun,5,save_media,length_of_string); idm_column(idmrun,6,save_route,length_of_string); idm_column(idmrun,7,save_rwdte); idm_column(idmrun,8,save_xrte,length_of_string); idm_column(idmrun,9,save_xdate); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_g $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_g $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); working_rwdte := string_to_integer(access_g.rwdte.ddd & access_g.rwdte.yy); working_xdate := string_to_integer(access_g.xdate.ddd & access_g.xdate.yy); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$5",access_g.tcaa,idm_char); idm_param(idmrun,"$6",access_g.tadc,idm_char); idm_param(idmrun,"$7",access_g.media,idm_char); idm_param(idmrun,"$8",access_g.route,idm_char); idm_param(idmrun,"$9",working_rwdte,idm_int1); idm_param(idmrun,"$10",access_g.xrte,idm_char); idm_param(idmrun,"$11",working_xdate,idm_int1); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_g.tcaa = " " then idm_param(idmrun,"$5"," ",idm_char); elsif access_g.tcaa /= save_tcaa and access_g.tcaa /= " " then idm_param(idmrun,"$5",access_g.tcaa,idm_char); else idm_param(idmrun,"$5",save_tcaa,idm_char); end if; if access_g.tadc = " " then idm_param(idmrun,"$6"," ",idm_char); elsif access_g.tadc /= save_tadc and access_g.tadc /= " " then idm_param(idmrun,"$6",access_g.tadc,idm_char); else idm_param(idmrun,"$6",save_tadc,idm_char); end if; if access_g.media /= save_media and access_g.media /= " " then idm_param(idmrun,"$7",access_g.media,idm_char); else idm_param(idmrun,"$7",save_media,idm_char); end if; if access_g.route = " " then idm_param(idmrun,"$8"," ",idm_char); elsif access_g.route /= save_route and access_g.route /= " " then idm_param(idmrun,"$8",access_g.route,idm_char); else idm_param(idmrun,"$8",save_route,idm_char); end if; if working_rwdte /= save_rwdte and access_g.rwdte.ddd & access_g.rwdte.yy /= " " then idm_param(idmrun,"$9",working_rwdte,idm_int1); else idm_param(idmrun,"$9",save_rwdte,idm_int1); end if; if access_g.xrte = " " then idm_param(idmrun,"$10"," ",idm_char); elsif access_g.xrte /= save_xrte and access_g.xrte /= " " then idm_param(idmrun,"$10",access_g.xrte,idm_char); else idm_param(idmrun,"$10",save_xrte,idm_char); end if; if working_xdate /= save_xdate and access_g.xdate.ddd & access_g.xdate.yy /= " " then idm_param(idmrun,"$11",working_xdate,idm_int1); else idm_param(idmrun,"$11",save_xdate,idm_int1); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_g; --********************************************************************* --* --* PROCESS_CARD_J --* --* This procedure will process the message cards of type 'J'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_j is save_struc : integer; save_auth : integer; save_asgd : integer; save_postr : integer; save_deps : integer; save_tdeps : integer; save_picda : string(1..8); save_caspw : integer; save_ccasp : integer; working_struc : integer; working_auth : integer; working_asgd : integer; working_postr : integer; working_deps : integer; working_tdeps : integer; working_caspw : integer; working_ccasp : integer; working_picda : string(1..8); begin access_j := list_item.access_j; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_j $1 $2 $3 $4"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_j.tpers,idm_char); if access_j.pegeo(5..6) = " " then idm_param(idmrun,"$3",access_j.pegeo(1..4),idm_char); idm_param(idmrun,"$4"," ",idm_char); else idm_param(idmrun,"$3"," ",idm_char); idm_param(idmrun,"$4",access_j.pegeo,idm_char); end if; idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_struc); idm_column(idmrun,4,save_auth); idm_column(idmrun,5,save_asgd); idm_column(idmrun,6,save_postr); idm_column(idmrun,7,save_deps); idm_column(idmrun,8,save_tdeps); idm_column(idmrun,9,save_picda,length_of_string); idm_column(idmrun,10,save_caspw); idm_column(idmrun,11,save_ccasp); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_j $1 $2 $3 $4"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_j.tpers,idm_char); if access_j.pegeo(5..6) = " " then idm_param(idmrun,"$3",access_j.pegeo(1..4),idm_char); idm_param(idmrun,"$4"," ",idm_char); else idm_param(idmrun,"$3"," ",idm_char); idm_param(idmrun,"$4",access_j.pegeo,idm_char); end if; idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_j $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_j.tpers,idm_char); if access_j.pegeo(5..6) = " " then idm_param(idmrun,"$6",access_j.pegeo(1..4),idm_char); idm_param(idmrun,"$7"," ",idm_char); else idm_param(idmrun,"$7",access_j.pegeo,idm_char); idm_param(idmrun,"$6"," ",idm_char); end if; working_struc := string_to_integer(access_j.struc); working_auth := string_to_integer(access_j.auth); working_asgd := string_to_integer(access_j.asgd); working_postr := string_to_integer(access_j.postr); working_deps := string_to_integer(access_j.deps); working_tdeps := string_to_integer(access_j.tdeps); working_caspw := string_to_integer(access_j.caspw); working_ccasp := string_to_integer(access_j.ccasp); if access_j.picda.year = 0 then working_picda(1..4) := " "; else working_string(1..5) := integer'image(access_j.picda.year); working_picda(1..4) := working_string(2..5); end if; if access_j.picda.month = 0 then working_picda(5..6) := " "; elsif access_j.picda.month < 10 then working_picda(5) := '0'; working_string(1..2) := integer'image(access_j.picda.month); working_picda(6..6) := working_string(2..2); else working_string(1..3) := integer'image(access_j.picda.month); working_picda(5..6) := working_string(2..3); end if; if access_j.picda.day = 0 then working_picda(7..8) := " "; elsif access_j.picda.day < 10 then working_picda(7) := '0'; working_string(1..2) := integer'image(access_j.picda.day); working_picda(8..8) := working_string(2..2); else working_string(1..3) := integer'image(access_j.picda.day); working_picda(7..8) := working_string(2..3); end if; working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$8",working_struc,idm_int1); idm_param(idmrun,"$9",working_auth,idm_int1); idm_param(idmrun,"$10",working_asgd,idm_int1); idm_param(idmrun,"$11",working_postr,idm_int1); idm_param(idmrun,"$11",working_deps,idm_int1); idm_param(idmrun,"$13",working_tdeps,idm_int1); idm_param(idmrun,"$14",working_picda,idm_char); idm_param(idmrun,"$15",working_caspw,idm_int1); idm_param(idmrun,"$16",working_ccasp,idm_int1); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if working_struc /= save_struc and access_j.struc /= " " then idm_param(idmrun,"$8",working_struc,idm_int1); else idm_param(idmrun,"$8",save_struc,idm_int1); end if; if working_auth /= save_auth and access_j.auth /= " " then idm_param(idmrun,"$9",working_auth,idm_int1); else idm_param(idmrun,"$9",save_auth,idm_int1); end if; if working_asgd /= save_asgd and access_j.asgd /= " " then idm_param(idmrun,"$10",working_asgd,idm_int1); else idm_param(idmrun,"$10",save_asgd,idm_int1); end if; if access_j.postr = "# " then idm_param(idmrun,"$11",0,idm_int1); elsif working_postr /= save_postr and access_j.postr /= " " then idm_param(idmrun,"$11",working_postr,idm_int1); else idm_param(idmrun,"$11",save_postr,idm_int1); end if; if access_j.deps = "# " then idm_param(idmrun,"$12",0,idm_int1); elsif working_deps /= save_deps and access_j.deps /= " " then idm_param(idmrun,"$12",working_deps,idm_int1); else idm_param(idmrun,"$12",save_deps,idm_int1); end if; if access_j.tdeps = "# " then idm_param(idmrun,"$13",0,idm_int1); elsif working_tdeps /= save_tdeps and access_j.tdeps /= " " then idm_param(idmrun,"$13",working_tdeps,idm_int1); else idm_param(idmrun,"$13",save_tdeps,idm_int1); end if; if working_picda /= save_picda then idm_param(idmrun,"$14",working_picda,idm_char); else idm_param(idmrun,"$14",save_picda,idm_char); end if; if working_caspw /= save_caspw and access_j.caspw /= " " then idm_param(idmrun,"$15",working_caspw,idm_int1); else idm_param(idmrun,"$15",save_caspw,idm_int1); end if; if working_ccasp /= save_ccasp and access_j.ccasp /= " " then idm_param(idmrun,"$16",working_ccasp,idm_int1); else idm_param(idmrun,"$16",save_ccasp,idm_int1); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_j; --********************************************************************* --* --* PROCESS_CARD_K --* --* This procedure will process the message cards of type 'K'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_k is save_tread : string(1..5); save_ready : integer; save_reasn : string(1..1); save_prrat : integer; save_prres : string(1..3); save_esrat : integer; save_esres : string(1..3); save_errat : integer; save_erres : string(1..3); save_trrat : integer; save_trres : string(1..3); save_secrn : string(1..3); save_terrn : string(1..3); save_carat : integer; save_cadat : string(1..8); save_lim : integer; save_rlim : string(1..1); save_ricda : string(1..8); working_ready : integer; working_prrat : integer; working_esrat : integer; working_errat : integer; working_trrat : integer; working_carat : integer; working_cadat : string(1..8) := "19000000"; working_lim : integer; working_ricda : string(1..8) := "19000000"; begin access_k := list_item.access_k; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_k $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_tread,length_of_string); idm_column(idmrun,4,save_ready); idm_column(idmrun,5,save_reasn,length_of_string); idm_column(idmrun,6,save_prrat); idm_column(idmrun,7,save_prres,length_of_string); idm_column(idmrun,8,save_esrat); idm_column(idmrun,9,save_esres,length_of_string); idm_column(idmrun,10,save_errat); idm_column(idmrun,11,save_erres,length_of_string); idm_column(idmrun,12,save_trrat); idm_column(idmrun,13,save_trres,length_of_string); idm_column(idmrun,14,save_secrn,length_of_string); idm_column(idmrun,15,save_terrn,length_of_string); idm_column(idmrun,16,save_carat); idm_column(idmrun,17,save_cadat,length_of_string); idm_column(idmrun,18,save_lim); idm_column(idmrun,19,save_rlim,length_of_string); idm_column(idmrun,20,save_ricda,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_k $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_k $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16 $17 $18 $19 $20 " & "$21 $22"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); working_ready := string_to_integer(access_k.ready); working_prrat := string_to_integer(access_k.prrat); working_esrat := string_to_integer(access_k.esrat); working_errat := string_to_integer(access_k.errat); working_trrat := string_to_integer(access_k.trrat); working_carat := string_to_integer(access_k.carat); working_lim := string_to_integer(access_k.lim); working_cadat(3..8) := access_k.cadat.yy & access_k.cadat.mm & access_k.cadat.dd; working_ricda(3..8) := access_k.ricda.yy & access_k.ricda.mm & access_k.ricda.dd; working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$5",access_k.tread,idm_char); idm_param(idmrun,"$6",working_ready,idm_int1); idm_param(idmrun,"$7",access_k.reasn,idm_char); idm_param(idmrun,"$8",working_prrat,idm_int1); idm_param(idmrun,"$9",access_k.prres,idm_char); idm_param(idmrun,"$10",working_esrat,idm_int1); idm_param(idmrun,"$11",access_k.esres,idm_char); idm_param(idmrun,"$12",working_errat,idm_int1); idm_param(idmrun,"$13",access_k.erres,idm_char); idm_param(idmrun,"$14",working_trrat,idm_int1); idm_param(idmrun,"$15",access_k.trres,idm_char); idm_param(idmrun,"$16",access_k.secrn,idm_char); idm_param(idmrun,"$17",access_k.terrn,idm_char); idm_param(idmrun,"$18",working_carat,idm_int1); idm_param(idmrun,"$19",working_cadat,idm_char); idm_param(idmrun,"$20",working_lim,idm_int1); idm_param(idmrun,"$21",access_k.rlim,idm_char); idm_param(idmrun,"$22",working_ricda,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_k.tread /= save_tread and access_k.tread /= " " then idm_param(idmrun,"$5",access_k.tread,idm_char); else idm_param(idmrun,"$5",save_tread,idm_char); end if; if working_ready /= save_ready and access_k.ready /= " " then idm_param(idmrun,"$6",working_ready,idm_int1); else idm_param(idmrun,"$6",save_ready,idm_int1); end if; if access_k.reasn /= save_reasn and access_k.reasn /= " " then idm_param(idmrun,"$7",access_k.reasn,idm_char); else idm_param(idmrun,"$7",save_reasn,idm_char); end if; if working_prrat /= save_prrat and access_k.prrat /= " " then idm_param(idmrun,"$8",working_prrat,idm_int1); else idm_param(idmrun,"$8",save_prrat,idm_int1); end if; if access_k.prres /= save_prres and access_k.prres /= " " then idm_param(idmrun,"$9",access_k.prres,idm_char); else idm_param(idmrun,"$9",save_prres,idm_char); end if; if working_esrat /= save_esrat and access_k.esrat /= " " then idm_param(idmrun,"$10",working_esrat,idm_int1); else idm_param(idmrun,"$10",save_esrat,idm_int1); end if; if access_k.esres /= save_esres and access_k.esres /= " " then idm_param(idmrun,"$11",access_k.esres,idm_char); else idm_param(idmrun,"$11",save_esres,idm_char); end if; if working_errat /= save_errat and access_k.errat /= " " then idm_param(idmrun,"$12",working_errat,idm_int1); else idm_param(idmrun,"$12",save_errat,idm_int1); end if; if access_k.erres /= save_erres and access_k.erres /= " " then idm_param(idmrun,"$13",access_k.erres,idm_char); else idm_param(idmrun,"$13",save_erres,idm_char); end if; if working_trrat /= save_trrat and access_k.trrat /= " " then idm_param(idmrun,"$14",working_trrat,idm_int1); else idm_param(idmrun,"$14",save_trrat,idm_int1); end if; if access_k.trres /= save_trres and access_k.trres /= " " then idm_param(idmrun,"$15",access_k.trres,idm_char); else idm_param(idmrun,"$15",save_trres,idm_char); end if; if access_k.secrn = "# " then idm_param(idmrun,"$16"," ",idm_char); elsif access_k.secrn /= save_secrn and access_k.secrn /= " " then idm_param(idmrun,"$16",access_k.secrn,idm_char); else idm_param(idmrun,"$16",save_secrn,idm_char); end if; if access_k.terrn = "# " or access_k.secrn = "# " then idm_param(idmrun,"$17"," ",idm_char); elsif access_k.terrn /= save_terrn and access_k.terrn /= " " then idm_param(idmrun,"$17",access_k.terrn,idm_char); else idm_param(idmrun,"$17",save_terrn,idm_char); end if; if access_k.carat = "#" then idm_param(idmrun,"$18",0,idm_int1); elsif working_carat /= save_carat and access_k.carat /= " " then idm_param(idmrun,"$18",working_carat,idm_int1); else idm_param(idmrun,"$18",save_carat,idm_int1); end if; if access_k.cadat.yy = "# " or access_k.carat = "#" then idm_param(idmrun,"$19"," ",idm_char); elsif working_cadat /= save_cadat and working_cadat(3..8) /= " " then idm_param(idmrun,"$19",working_cadat,idm_char); else idm_param(idmrun,"$19",save_cadat,idm_char); end if; if access_k.lim = "#" then idm_param(idmrun,"$20",0,idm_int1); elsif working_lim /= save_lim and access_k.lim /= " " then idm_param(idmrun,"$20",working_lim,idm_int1); else idm_param(idmrun,"$20",save_lim,idm_int1); end if; if access_k.rlim = "#" then idm_param(idmrun,"$21"," ",idm_char); elsif access_k.rlim /= save_rlim and access_k.rlim /= " " then idm_param(idmrun,"$21",access_k.rlim,idm_char); else idm_param(idmrun,"$21",save_rlim,idm_char); end if; if working_ricda /= save_ricda and working_ricda(3..8) /= " " then idm_param(idmrun,"$22",working_ricda,idm_char); else idm_param(idmrun,"$22",save_ricda,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_k; --********************************************************************* --* --* PROCESS_CARD_L --* --* This procedure will process the message cards of type 'L'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_l is save_fordv : string(1..1); save_mepsa : integer; save_metal : integer; save_mepsd : integer; save_meord : integer; save_meorn : integer; save_meorc : integer; save_meoro : integer; save_crewa : integer; save_creal : integer; save_crewf : integer; save_crmrd : integer; save_crmrn : integer; save_crmrc : integer; save_crmro : integer; save_merec : string(1..6); working_merec : string(1..6); working_mepsa : integer; working_metal : integer; working_mepsd : integer; working_meord : integer; working_meorn : integer; working_meorc : integer; working_meoro : integer; working_crewa : integer; working_creal : integer; working_crewf : integer; working_crmrd : integer; working_crmrn : integer; working_crmrc : integer; working_crmro : integer; begin access_l := list_item.access_l; working_merec := " "; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_l $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_l.meqpt,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_fordv,length_of_string); idm_column(idmrun,4,save_mepsa); idm_column(idmrun,5,save_metal); idm_column(idmrun,6,save_mepsd); idm_column(idmrun,7,save_meord); idm_column(idmrun,8,save_meorn); idm_column(idmrun,9,save_meorc); idm_column(idmrun,10,save_meoro); idm_column(idmrun,11,save_crewa); idm_column(idmrun,12,save_creal); idm_column(idmrun,13,save_crewf); idm_column(idmrun,14,save_crmrd); idm_column(idmrun,15,save_crmrn); idm_column(idmrun,16,save_crmrc); idm_column(idmrun,17,save_crmro); -- -- retrieve for merec -- idm_column(idmrun,1,save_merec,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_l $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_l.meqpt,idm_char); idm_execute(idmrun); idm_fetch(idmrun); -- -- delete for merec -- end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_l $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16 $17 $18 $19 $20"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_l.meqpt,idm_char); working_mepsa := string_to_integer(access_l.mepsa); working_metal := string_to_integer(access_l.metal); working_mepsd := string_to_integer(access_l.mepsd); working_meord := string_to_integer(access_l.meord); working_meorn := string_to_integer(access_l.meorn); working_meorc := string_to_integer(access_l.meorc); working_meoro := string_to_integer(access_l.meoro); working_crewa := string_to_integer(access_l.crewa); working_creal := string_to_integer(access_l.creal); working_crewf := string_to_integer(access_l.crewf); working_crmrd := string_to_integer(access_l.crmrd); working_crmrn := string_to_integer(access_l.crmrn); working_crmrc := string_to_integer(access_l.crmrc); working_crmro := string_to_integer(access_l.crmro); working_secur := secur_types'image(list_item.secur); working_merec := access_l.merec_1 & access_l.merec_2 & access_l.merec_3; if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$6",access_l.fordv,idm_char); idm_param(idmrun,"$7",working_mepsa,idm_int1); idm_param(idmrun,"$8",working_metal,idm_int1); idm_param(idmrun,"$9",working_mepsd,idm_int1); idm_param(idmrun,"$10",working_meord,idm_int1); idm_param(idmrun,"$11",working_meorn,idm_int1); idm_param(idmrun,"$12",working_meorc,idm_int1); idm_param(idmrun,"$13",working_meoro,idm_int1); idm_param(idmrun,"$14",working_crewa,idm_int1); idm_param(idmrun,"$15",working_creal,idm_int1); idm_param(idmrun,"$16",working_crewf,idm_int1); idm_param(idmrun,"$17",working_crmrd,idm_int1); idm_param(idmrun,"$18",working_crmrn,idm_int1); idm_param(idmrun,"$19",working_crmrc,idm_int1); idm_param(idmrun,"$20",working_crmro,idm_int1); -- -- add for merec -- idm_param(idmrun,"$1",working_merec,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_l.fordv /= save_fordv and access_l.fordv /= " " then idm_param(idmrun,"$6",access_l.fordv,idm_char); else idm_param(idmrun,"$6",save_fordv,idm_char); end if; if working_mepsa /= save_mepsa and access_l.mepsd /= " " then idm_param(idmrun,"$7",working_mepsd,idm_int1); else idm_param(idmrun,"$7",save_mepsd,idm_int1); end if; if working_metal /= save_metal and access_l.metal /= " " then idm_param(idmrun,"$8",working_metal,idm_int1); else idm_param(idmrun,"$8",save_metal,idm_int1); end if; if working_mepsd /= save_mepsd and access_l.mepsd /= " " then idm_param(idmrun,"$9",working_mepsd,idm_int1); else idm_param(idmrun,"$9",save_mepsd,idm_int1); end if; if working_meord /= save_meord and access_l.meord /= " " then idm_param(idmrun,"$10",working_meord,idm_int1); else idm_param(idmrun,"$10",save_meord,idm_int1); end if; if working_meorn /= save_meorn and access_l.meorn /= " " then idm_param(idmrun,"$11",working_meorn,idm_int1); else idm_param(idmrun,"$11",save_meorn,idm_int1); end if; if working_meorc /= save_meorc and access_l.meorc /= " " then idm_param(idmrun,"$12",working_meorc,idm_int1); else idm_param(idmrun,"$12",save_meorc,idm_int1); end if; if working_meoro /= save_meoro and access_l.meoro /= " " then idm_param(idmrun,"$13",working_meoro,idm_int1); else idm_param(idmrun,"$13",save_meoro,idm_int1); end if; if working_crewa /= save_crewa and access_l.crewa /= " " then idm_param(idmrun,"$14",working_crewa,idm_int1); else idm_param(idmrun,"$14",save_crewa,idm_int1); end if; if working_creal /= save_creal and access_l.creal /= " " then idm_param(idmrun,"$15",working_creal,idm_int1); else idm_param(idmrun,"$15",save_creal,idm_int1); end if; if working_crewf /= save_crewf and access_l.crewf /= " " then idm_param(idmrun,"$16",working_crewf,idm_int1); else idm_param(idmrun,"$16",save_crewf,idm_int1); end if; if working_crmrd /= save_crmrd and access_l.crmrd /= " " then idm_param(idmrun,"$17",working_crmrd,idm_int1); else idm_param(idmrun,"$17",save_crmrd,idm_int1); end if; if working_crmrn /= save_crmrn and access_l.crmrn /= " " then idm_param(idmrun,"$18",working_crmrn,idm_int1); else idm_param(idmrun,"$18",save_crmrn,idm_int1); end if; if working_crmrc /= save_crmrc and access_l.crmrc /= " " then idm_param(idmrun,"$19",working_crmrc,idm_int1); else idm_param(idmrun,"$19",save_crmrc,idm_int1); end if; if working_crmro /= save_crmro and access_l.crmro /= " " then idm_param(idmrun,"$20",working_crmro,idm_int1); else idm_param(idmrun,"$20",save_crmro,idm_int1); end if; -- -- add for merec -- if access_l.merec_1 = "# " then working_merec := " "; elsif access_l.merec_1 /= save_merec(1..2) and access_l.merec_1 /= " " then working_merec(1..2) := access_l.merec_1; else working_merec(1..2) := save_merec(1..2); end if; if access_l.merec_2 = "# " then working_merec(3..6) := " "; elsif access_l.merec_2 /= save_merec(3..4) and access_l.merec_2 /= " " then working_merec(3..4) := access_l.merec_2; else working_merec(3..4) := save_merec(3..4); end if; if access_l.merec_3 = "# " then working_merec(5..6) := " "; elsif access_l.merec_3 /= save_merec(5..6) and access_l.merec_3 /= " " then working_merec(5..6) := access_l.merec_3; else working_merec(5..6) := save_merec(5..6); end if; idm_param(idmrun,"$1",working_merec,idm_char); end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_l; --********************************************************************* --* --* PROCESS_CARD_M --* --* This procedure will process the message cards of type 'M'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_m is save_mepsd : integer; save_meord : integer; save_meorn : integer; save_meorc : integer; save_meoro : integer; save_crewf : integer; save_crmrd : integer; save_crmrn : integer; save_crmrc : integer; save_crmro : integer; save_merec : string(1..6); working_merec : string(1..6); working_mepsd : integer; working_meord : integer; working_meorn : integer; working_meorc : integer; working_meoro : integer; working_crewf : integer; working_crmrd : integer; working_crmrn : integer; working_crmrc : integer; working_crmro : integer; begin access_m := list_item.access_m; working_merec := " "; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_m $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_m.meqpt,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_mepsd); idm_column(idmrun,4,save_meord); idm_column(idmrun,5,save_meorn); idm_column(idmrun,6,save_meorc); idm_column(idmrun,7,save_meoro); idm_column(idmrun,8,save_crewf); idm_column(idmrun,9,save_crmrd); idm_column(idmrun,10,save_crmrn); idm_column(idmrun,11,save_crmrc); idm_column(idmrun,12,save_crmro); -- -- retrieve for merec -- idm_column(idmrun,1,save_merec,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_m $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_m.meqpt,idm_char); idm_execute(idmrun); idm_fetch(idmrun); -- -- delete for merec -- end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_m $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_m.meqpt,idm_char); working_mepsd := string_to_integer(access_m.mepsd); working_meord := string_to_integer(access_m.meord); working_meorn := string_to_integer(access_m.meorn); working_meorc := string_to_integer(access_m.meorc); working_meoro := string_to_integer(access_m.meoro); working_crewf := string_to_integer(access_m.crewf); working_crmrd := string_to_integer(access_m.crmrd); working_crmrn := string_to_integer(access_m.crmrn); working_crmrc := string_to_integer(access_m.crmrc); working_crmro := string_to_integer(access_m.crmro); working_secur := secur_types'image(list_item.secur); working_merec := access_m.merec_1 & access_m.merec_2 & access_m.merec_3; if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$6",working_mepsd,idm_int1); idm_param(idmrun,"$7",working_meord,idm_int1); idm_param(idmrun,"$8",working_meorn,idm_int1); idm_param(idmrun,"$9",working_meorc,idm_int1); idm_param(idmrun,"$10",working_meoro,idm_int1); idm_param(idmrun,"$11",working_crewf,idm_int1); idm_param(idmrun,"$12",working_crmrd,idm_int1); idm_param(idmrun,"$13",working_crmrn,idm_int1); idm_param(idmrun,"$14",working_crmrc,idm_int1); idm_param(idmrun,"$15",working_crmro,idm_int1); -- -- add for merec -- idm_param(idmrun,"$16",working_merec,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if working_mepsd /= save_mepsd and access_m.mepsd /= " " then idm_param(idmrun,"$6",working_mepsd,idm_int1); else idm_param(idmrun,"$6",save_mepsd,idm_int1); end if; if working_meord /= save_meord and access_m.meord /= " " then idm_param(idmrun,"$7",working_meord,idm_int1); else idm_param(idmrun,"$7",save_meord,idm_int1); end if; if working_meorn /= save_meorn and access_m.meorn /= " " then idm_param(idmrun,"$8",working_meorn,idm_int1); else idm_param(idmrun,"$8",save_meorn,idm_int1); end if; if working_meorc /= save_meorc and access_m.meorc /= " " then idm_param(idmrun,"$9",working_meorc,idm_int1); else idm_param(idmrun,"$9",access_m.meorc,idm_int1); end if; if working_meoro /= save_meoro and access_m.meoro /= " " then idm_param(idmrun,"$10",working_meoro,idm_int1); else idm_param(idmrun,"$10",save_meoro,idm_int1); end if; if working_crewf /= save_crewf and access_m.crewf /= " " then idm_param(idmrun,"$11",working_crewf,idm_int1); else idm_param(idmrun,"$11",save_crewf,idm_int1); end if; if working_crmrd /= save_crmrd and access_m.crmrd /= " " then idm_param(idmrun,"$12",working_crmrd,idm_int1); else idm_param(idmrun,"$12",save_crmrd,idm_int1); end if; if working_crmrn /= save_crmrn and access_m.crmrn /= " " then idm_param(idmrun,"$13",working_crmrn,idm_int1); else idm_param(idmrun,"$13",save_crmrn,idm_int1); end if; if working_crmrc /= save_crmrc and access_m.crmrc /= " " then idm_param(idmrun,"$14",working_crmrc,idm_int1); else idm_param(idmrun,"$14",save_crmrc,idm_int1); end if; if working_crmro /= save_crmro and access_m.crmro /= " " then idm_param(idmrun,"$15",working_crmro,idm_int1); else idm_param(idmrun,"$15",save_crmro,idm_int1); end if; -- -- add for merec -- if access_m.merec_1 = "# " then working_merec := " "; elsif access_m.merec_1 /= save_merec(1..2) and access_m.merec_1 /= " " then working_merec(1..2) := access_m.merec_1; else working_merec(1..2) := save_merec(1..2); end if; if access_m.merec_2 = "# " then working_merec(3..6) := " "; elsif access_m.merec_2 /= save_merec(3..4) and access_m.merec_2 /= " " then working_merec(3..4) := access_m.merec_2; else working_merec(3..4) := save_merec(3..4); end if; if access_m.merec_3 = "# " then working_merec(5..6) := " "; elsif access_m.merec_3 /= save_merec(5..6) and access_m.merec_3 /= " " then working_merec(5..6) := access_m.merec_3; else working_merec(5..6) := save_merec(5..6); end if; idm_param(idmrun,"$16",working_merec,idm_char); end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_m; --********************************************************************* --* --* PROCESS_CARD_N --* --* This procedure will process the message cards of type 'N'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_n is save_putc : string(1..5); save_frqno : string(1..5); save_pleac : string(1..1); save_ddp : string(1..2); save_ddp_d : string(1..8); save_ddp_h : integer; save_mdt : integer; working_ddp_d : string(1..8) := "19000000"; working_ddp_h : integer; working_mdt : integer; begin access_n := list_item.access_n; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_n $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_n.pin,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_putc,length_of_string); idm_column(idmrun,4,save_frqno,length_of_string); idm_column(idmrun,5,save_pleac,length_of_string); idm_column(idmrun,6,save_ddp,length_of_string); idm_column(idmrun,7,save_ddp_d,length_of_string); idm_column(idmrun,8,save_ddp_h); idm_column(idmrun,9,save_mdt); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_n $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_n.pin,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_n $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_n.pin,idm_char); working_ddp_d(3..8) := access_n.ddprd.yy & access_n.ddprd.mm & access_n.ddprd.dd; working_ddp_h := string_to_integer(access_n.ddp); working_mdt := string_to_integer(access_n.mdt.DDD & access_n.mdt.HH); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$6",access_n.putc,idm_char); idm_param(idmrun,"$7",access_n.frqno,idm_char); idm_param(idmrun,"$8",access_n.pleac,idm_char); idm_param(idmrun,"$9",access_n.ddp,idm_char); idm_param(idmrun,"$10",working_ddp_d,idm_char); idm_param(idmrun,"$11",working_ddp_h,idm_int1); idm_param(idmrun,"$12",working_mdt,idm_int1); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_n.putc = "# " then idm_param(idmrun,"$6"," ",idm_char); elsif access_n.putc /= save_putc and access_n.putc /= " " then idm_param(idmrun,"$6",access_n.putc,idm_char); else idm_param(idmrun,"$6",save_putc,idm_char); end if; if access_n.frqno /= save_frqno and access_n.frqno /= " " then idm_param(idmrun,"$7",access_n.frqno,idm_char); else idm_param(idmrun,"$7",save_frqno,idm_char); end if; if access_n.pleac /= save_pleac and access_n.pleac /= " " then idm_param(idmrun,"$8",access_n.pleac,idm_char); else idm_param(idmrun,"$8",save_pleac,idm_char); end if; if access_n.ddp /= save_ddp and access_n.ddp /= " " then idm_param(idmrun,"$9",access_n.ddp,idm_char); else idm_param(idmrun,"$9",save_ddp,idm_char); end if; if working_ddp_d /= save_ddp_d and working_ddp_d(3..8) /= " " then idm_param(idmrun,"$10",working_ddp_d,idm_char); else idm_param(idmrun,"$10",save_ddp_d,idm_char); end if; if working_ddp_h /= save_ddp_h and access_n.ddprd.hh /= " " then idm_param(idmrun,"$11",working_ddp_h,idm_int1); else idm_param(idmrun,"$11",save_ddp_h,idm_int1); end if; if working_mdt /= save_mdt and access_n.mdt.ddd & access_n.mdt.hh /= " " then idm_param(idmrun,"$12",working_mdt,idm_int1); else idm_param(idmrun,"$12",save_mdt,idm_int1); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_n; --********************************************************************* --* --* PROCESS_CARD_P --* --* This procedure will process the message cards of type 'P'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_p is save_tpgeo : string(1..4); save_tpuic : string(1..6); save_numbr : integer; save_numea : integer; save_alret : integer; working_numbr : integer; working_numea : integer; working_alret : integer; working_altyp : string(1..2); begin access_p := list_item.access_p; working_altyp := altyp_types'image(access_p.altyp); if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_p $1 $2 $3 $4"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_p.meqpt,idm_char); idm_param(idmrun,"$3",access_p.pin,idm_char); idm_param(idmrun,"$4",working_altyp,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_tpgeo,length_of_string); idm_column(idmrun,4,save_tpuic,length_of_string); idm_column(idmrun,5,save_numbr); idm_column(idmrun,6,save_numea); idm_column(idmrun,7,save_alret); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_p $1 $2 $3 $4"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_p.meqpt,idm_char); idm_param(idmrun,"$3",access_p.pin,idm_char); idm_param(idmrun,"$4",working_altyp,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_p $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_p.meqpt,idm_char); idm_param(idmrun,"$6",access_p.pin,idm_char); idm_param(idmrun,"$7",working_altyp,idm_char); working_numbr := string_to_integer(access_p.numbr); working_numea := string_to_integer(access_p.numea); working_alret := string_to_integer(access_p.alret.hhh & access_p.alret.mm); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); if access_p.tpgeo(5..6) = " " then idm_param(idmrun,"$8",access_p.tpgeo(1..4),idm_char); idm_param(idmrun,"$9"," ",idm_char); else idm_param(idmrun,"$9",access_p.tpgeo,idm_char); idm_param(idmrun,"$8"," ",idm_char); end if; idm_param(idmrun,"$10",working_numbr,idm_int1); idm_param(idmrun,"$11",working_numea,idm_int1); idm_param(idmrun,"$12",working_alret,idm_int1); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_p.tpgeo(5..6) = " " then if access_p.tpgeo(1..4) /= save_tpgeo and access_p.tpgeo(1..4) /= " " then idm_param(idmrun,"$8",access_p.tpgeo(1..4),idm_char); else idm_param(idmrun,"$8",save_tpgeo(1..4),idm_char); end if; elsif access_p.tpgeo /= save_tpuic and access_p.tpgeo /= " " then idm_param(idmrun,"$9",access_p.tpgeo,idm_char); else idm_param(idmrun,"$9",save_tpuic,idm_char); end if; if working_numbr /= save_numbr and access_p.numbr /= " " then idm_param(idmrun,"$10",working_numbr,idm_int1); else idm_param(idmrun,"$10",save_numbr,idm_int1); end if; if working_numea /= save_numea and access_p.numea /= " " then idm_param(idmrun,"$11",working_numea,idm_int1); else idm_param(idmrun,"$11",save_numea,idm_int1); end if; if working_alret /= save_alret and access_p.alret.hhh & access_p.alret.mm /= " " then idm_param(idmrun,"$12",working_alret,idm_int1); else idm_param(idmrun,"$12",save_alret,idm_int1); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_p; --********************************************************************* --* --* PROCESS_CARD_Q --* --* This procedure will process the message cards of type 'Q'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_q is save_pin : string(1..5); save_altyp : string(1..2); save_wpnco : string(1..7); save_nuqpt : string(1..13); save_numwr : integer; save_nugun : integer; save_numwb : integer; save_nusto : string(1..3); save_nuecc : integer; save_rtime : integer; save_dssta : string(1..1); save_dsgeo : string(1..4); save_dsuic : string(1..6); save_rfdgs : string(1..5); working_numwr : integer; working_nugun : integer; working_numwb : integer; working_nuecc : integer; working_rtime : integer; begin access_q := list_item.access_q; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_q $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_q.nuseq,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_pin,length_of_string); idm_column(idmrun,4,save_altyp,length_of_string); idm_column(idmrun,5,save_wpnco,length_of_string); idm_column(idmrun,6,save_nuqpt,length_of_string); idm_column(idmrun,7,save_numwr); idm_column(idmrun,8,save_nugun); idm_column(idmrun,9,save_numwb); idm_column(idmrun,10,save_nusto,length_of_string); idm_column(idmrun,11,save_nuecc); idm_column(idmrun,12,save_rtime); idm_column(idmrun,13,save_dssta,length_of_string); idm_column(idmrun,14,save_dsgeo,length_of_string); idm_column(idmrun,15,save_dsuic,length_of_string); -- -- retrieve for RFDGS -- idm_column(idmrun,1,save_rfdgs,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_q $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_q.nuseq,idm_char); idm_execute(idmrun); idm_fetch(idmrun); -- -- delete for RFDGS -- end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_q $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16 $17 $18 $19"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_q.nuseq,idm_char); working_numwr := string_to_integer(access_q.numwr); working_nugun := string_to_integer(access_q.nugun); working_numwb := string_to_integer(access_q.numwb); working_nuecc := string_to_integer(access_q.nuecc); working_rtime := string_to_integer(access_q.rtime); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$6",access_q.pin,idm_char); idm_param(idmrun,"$7",access_q.altyp,idm_char); idm_param(idmrun,"$8",access_q.wpnco,idm_char); idm_param(idmrun,"$9",access_q.nuqpt,idm_char); idm_param(idmrun,"$10",working_numwr,idm_int1); idm_param(idmrun,"$11",working_nugun,idm_int1); idm_param(idmrun,"$12",working_numwb,idm_int1); idm_param(idmrun,"$13",access_q.nusto,idm_char); idm_param(idmrun,"$14",working_nuecc,idm_int1); idm_param(idmrun,"$15",working_rtime,idm_int1); idm_param(idmrun,"$16",access_q.dssta,idm_char); if access_q.dsgeo(5..6) = " " then idm_param(idmrun,"$17",access_q.dsgeo(1..4),idm_char); idm_param(idmrun,"$18"," ",idm_char); else idm_param(idmrun,"$18",access_q.dsgeo,idm_char); idm_param(idmrun,"$17"," ",idm_char); end if; -- -- add for RFDGS -- idm_param(idmrun,"$19",access_q.rfdgs,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_q.pin /= save_pin and access_q.pin /= " " then idm_param(idmrun,"$6",access_q.pin,idm_char); else idm_param(idmrun,"$6",save_pin,idm_char); end if; if access_q.altyp = "# " then idm_param(idmrun,"$7"," ",idm_char); elsif access_q.altyp /= save_altyp and access_q.altyp /= " " then idm_param(idmrun,"$7",access_q.altyp,idm_char); else idm_param(idmrun,"$7",save_altyp,idm_char); end if; if access_q.wpnco /= save_wpnco and access_q.wpnco /= " " then idm_param(idmrun,"$8",access_q.wpnco,idm_char); else idm_param(idmrun,"$8",save_wpnco,idm_char); end if; if access_q.nuqpt /= save_nuqpt(1..10) and access_q.nuqpt /= " " then idm_param(idmrun,"$9",access_q.nuqpt,idm_char); else idm_param(idmrun,"$9",save_nuqpt,idm_char); end if; if access_q.numwr = "# " then idm_param(idmrun,"$10",0,idm_int1); elsif working_numwr /= save_numwr and access_q.numwr /= " " then idm_param(idmrun,"$10",working_numwr,idm_int1); else idm_param(idmrun,"$10",save_numwr,idm_int1); end if; if access_q.nugun = "# " then idm_param(idmrun,"$11",0,idm_int1); elsif working_nugun /= save_nugun and access_q.nugun /= " " then idm_param(idmrun,"$11",working_nugun,idm_int1); else idm_param(idmrun,"$11",save_nugun,idm_int1); end if; if access_q.numwb = "# " then idm_param(idmrun,"$12",0,idm_int1); elsif working_numwb /= save_numwb and access_q.numwb /= " " then idm_param(idmrun,"$12",working_numwb,idm_int1); else idm_param(idmrun,"$12",save_numwb,idm_int1); end if; if access_q.nusto = "# " then idm_param(idmrun,"$13"," ",idm_char); elsif access_q.nusto /= save_nusto and access_q.nusto /= " " then idm_param(idmrun,"$13",access_q.nusto,idm_char); else idm_param(idmrun,"$13",save_nusto,idm_char); end if; if access_q.nuecc = "# " then idm_param(idmrun,"$14",0,idm_int1); elsif working_nuecc /= save_nuecc and access_q.nuecc /= " " then idm_param(idmrun,"$14",working_nuecc,idm_int1); else idm_param(idmrun,"$14",save_nuecc,idm_int1); end if; if working_rtime /= save_rtime and access_q.rtime /= " " then idm_param(idmrun,"$15",working_rtime,idm_int1); else idm_param(idmrun,"$15",save_rtime,idm_int1); end if; if access_q.dssta = "#" then idm_param(idmrun,"$16"," ",idm_char); elsif access_q.dssta /= save_dssta and access_q.dssta /= " " then idm_param(idmrun,"$16",access_q.dssta,idm_char); else idm_param(idmrun,"$16",save_dssta,idm_char); end if; if access_q.dsgeo(5..6) = " " then if access_q.dsgeo(1..4) /= save_dsgeo and access_q.dsgeo(1..4) /= " " then idm_param(idmrun,"$17",access_q.dsgeo(1..4),idm_char); else idm_param(idmrun,"$17",save_dsgeo,idm_char); end if; elsif access_q.dsgeo /= save_dsuic and access_q.dsgeo /= " " then idm_param(idmrun,"$18",access_q.dsgeo,idm_char); else idm_param(idmrun,"$18",save_dsuic,idm_char); end if; -- -- add for RFDGS -- if access_q.rfdgs = "# " then idm_param(idmrun,"$19"," ",idm_char); elsif access_q.rfdgs /= save_rfdgs and access_q.rfdgs /= " " then idm_param(idmrun,"$19",access_q.rfdgs,idm_char); else idm_param(idmrun,"$19",save_rfdgs,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_q; --********************************************************************* --* --* PROCESS_CARD_R --* --* This procedure will process the message cards of type 'R'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_r is save_label : string(1..5); save_remrk : string(1..240); save_remrk_x : string(1..210); begin access_r := list_item.access_r; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_r $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_r.rmkid,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_label,length_of_string); idm_column(idmrun,4,save_remrk,length_of_string); idm_column(idmrun,5,save_remrk_x,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_r $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_r.rmkid,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_r $1 $2 $3 $4 $5 $6 $7 $8"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_r.rmkid,idm_char); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$6",access_r.label,idm_char); idm_param(idmrun,"$7",access_r.remrk,idm_char); idm_param(idmrun,"$8",save_remrk_x,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_r.label /= save_label and access_r.label /= " " then idm_param(idmrun,"$6",access_r.label,idm_char); else idm_param(idmrun,"$6",save_label,idm_char); end if; if access_r.remrk /= save_remrk and access_r.remrk /= " " then idm_param(idmrun,"$7",access_r.remrk,idm_char); else idm_param(idmrun,"$7",save_remrk,idm_char); end if; idm_param(idmrun,"$8",save_remrk_x,idm_char); end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_r; --********************************************************************* --* --* PROCESS_CARD_T --* --* This procedure will process the message cards of type 'T'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_t is save_decon : string(1..1); save_mecus : string(1..2); save_avcat : string(1..1); save_resnd : string(1..1); save_erdte : string(1..8); save_exdac : string(1..1); save_cpgeo : string(1..4); save_cfgeo : string(1..4); save_eqdep : string(1..8); save_eqarr : string(1..8); save_pin : string(1..5); save_tleac : string(1..1); save_tleqe : integer; working_tleqe : integer; working_erdte : string(1..8) := "19000000"; working_eqdep : string(1..8) := "19000000"; working_eqarr : string(1..8) := "19000000"; begin access_t := list_item.access_t; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_t $1 $2 $3"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_t.teqpt,idm_char); idm_param(idmrun,"$3",access_t.mesen,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_decon,length_of_string); idm_column(idmrun,4,save_mecus,length_of_string); idm_column(idmrun,5,save_avcat,length_of_string); idm_column(idmrun,6,save_resnd,length_of_string); idm_column(idmrun,7,save_erdte,length_of_string); idm_column(idmrun,8,save_exdac,length_of_string); idm_column(idmrun,9,save_cpgeo,length_of_string); idm_column(idmrun,10,save_cfgeo,length_of_string); idm_column(idmrun,11,save_eqdep,length_of_string); idm_column(idmrun,12,save_eqarr,length_of_string); idm_column(idmrun,13,save_pin,length_of_string); idm_column(idmrun,14,save_tleac,length_of_string); idm_column(idmrun,15,save_tleqe); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_t $1 $2 $3"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_t.teqpt,idm_char); idm_param(idmrun,"$3",access_t.mesen,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_t $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16 $17 $18 $19"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_t.teqpt,idm_char); idm_param(idmrun,"$6",access_t.mesen,idm_char); working_tleqe := string_to_integer(access_t.tleqe); working_secur := secur_types'image(list_item.secur); working_erdte(3..8) := access_t.erdte.yy & access_t.erdte.mm & access_t.erdte.dd; working_eqdep(3..8) := access_t.eqdep.yy & access_t.eqdep.mm & access_t.eqdep.dd; working_eqarr(3..8) := access_t.eqarr.yy & access_t.eqarr.mm & access_t.eqarr.dd; if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$7",access_t.decon,idm_char); idm_param(idmrun,"$8",access_t.mecus,idm_char); idm_param(idmrun,"$9",access_t.avcat,idm_char); idm_param(idmrun,"$10",access_t.resnd,idm_char); idm_param(idmrun,"$11",working_erdte,idm_char); idm_param(idmrun,"$12",access_t.exdac,idm_char); idm_param(idmrun,"$13",access_t.cpgeo,idm_char); idm_param(idmrun,"$14",access_t.cfgeo,idm_char); idm_param(idmrun,"$15",working_eqdep,idm_char); idm_param(idmrun,"$16",working_eqarr,idm_char); idm_param(idmrun,"$17",access_t.pin,idm_char); idm_param(idmrun,"$18",access_t.tleac,idm_char); idm_param(idmrun,"$19",working_tleqe,idm_int1); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_t.decon /= save_decon and access_t.decon /= " " then idm_param(idmrun,"$7",access_t.decon,idm_char); else idm_param(idmrun,"$7",save_decon,idm_char); end if; if access_t.mecus /= save_mecus and access_t.mecus /= " " then idm_param(idmrun,"$8",access_t.mecus,idm_char); else idm_param(idmrun,"$8",save_mecus,idm_char); end if; if access_t.avcat /= save_avcat and access_t.avcat /= " " then idm_param(idmrun,"$9",access_t.avcat,idm_char); else idm_param(idmrun,"$9",save_avcat,idm_char); end if; if access_t.resnd /= save_resnd and access_t.resnd /= " " then idm_param(idmrun,"$10",access_t.resnd,idm_char); else idm_param(idmrun,"$10",save_resnd,idm_char); end if; if working_erdte /= save_erdte and working_erdte(3..8) /= " " then idm_param(idmrun,"$11",working_erdte,idm_char); else idm_param(idmrun,"$11",save_erdte,idm_char); end if; if access_t.exdac /= save_exdac and access_t.exdac /= " " then idm_param(idmrun,"$12",access_t.exdac,idm_char); else idm_param(idmrun,"$12",save_exdac,idm_char); end if; if access_t.cpgeo = "# " then idm_param(idmrun,"$13"," ",idm_char); elsif access_t.cpgeo /= save_cpgeo and access_t.cpgeo /= " " then idm_param(idmrun,"$13",access_t.cpgeo,idm_char); else idm_param(idmrun,"$13",save_cpgeo,idm_char); end if; if access_t.cfgeo = "# " then idm_param(idmrun,"$14"," ",idm_char); elsif access_t.cfgeo /= save_cfgeo and access_t.cfgeo /= " " then idm_param(idmrun,"$14",access_t.cfgeo,idm_char); else idm_param(idmrun,"$14",save_cfgeo,idm_char); end if; if working_eqdep(3..8) = "# " then idm_param(idmrun,"$15"," ",idm_char); elsif working_eqdep /= save_eqdep and working_eqdep(3..8) /= " " then idm_param(idmrun,"$15",working_eqdep,idm_char); else idm_param(idmrun,"$15",save_eqdep,idm_char); end if; if working_eqarr(3..8) = "# " then idm_param(idmrun,"$16"," ",idm_char); elsif working_eqarr /= save_eqarr and working_eqarr(3..8) /= " " then idm_param(idmrun,"$16",working_eqarr,idm_char); else idm_param(idmrun,"$16",save_eqarr,idm_char); end if; if access_t.pin = "# " then idm_param(idmrun,"$17"," ",idm_char); elsif access_t.pin /= save_pin and access_t.pin /= " " then idm_param(idmrun,"$17",access_t.pin,idm_char); else idm_param(idmrun,"$17",save_pin,idm_char); end if; if access_t.tleac = "#" then idm_param(idmrun,"$18"," ",idm_char); elsif access_t.tleac /= save_tleac and access_t.tleac /= " " then idm_param(idmrun,"$18",access_t.tleac,idm_char); else idm_param(idmrun,"$18",save_tleac,idm_char); end if; if access_t.tleqe = "# " then idm_param(idmrun,"$19",0,idm_int1); elsif working_tleqe /= save_tleqe and access_t.tleqe /= " " then idm_param(idmrun,"$19",working_tleqe,idm_int1); else idm_param(idmrun,"$19",save_tleqe,idm_int1); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_t; --********************************************************************* --* --* PROCESS_CARD_V --* --* This procedure will process the message cards of type 'V'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_v is save_acgeo : string(1..4); save_acity : string(1..2); save_adate : string(1..8); save_rdate : string(1..8); save_mdate : integer; working_adate : string(1..8) := "19000000"; working_rdate : string(1..8) := "19000000"; working_mdate : integer; begin access_v := list_item.access_v; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_v $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_acgeo,length_of_string); idm_column(idmrun,4,save_acity,length_of_string); idm_column(idmrun,5,save_adate,length_of_string); idm_column(idmrun,6,save_rdate,length_of_string); idm_column(idmrun,7,save_mdate); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_v $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_v $1 $2 $3 $4 $5 $6 $7 $8 $9"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); working_adate(3..8) := access_v.adate.yy & access_v.adate.mm & access_v.adate.dd; working_rdate(3..8) := access_v.rdate.yy & access_v.rdate.mm & access_v.rdate.dd; working_mdate := string_to_integer(access_v.mdate); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$5",access_v.acgeo,idm_char); idm_param(idmrun,"$6",access_v.acity,idm_char); idm_param(idmrun,"$7",working_adate,idm_char); idm_param(idmrun,"$8",working_rdate,idm_char); idm_param(idmrun,"$9",working_mdate,idm_int1); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_v.acgeo /= save_acgeo and access_v.acgeo /= " " then idm_param(idmrun,"$5",access_v.acgeo,idm_char); else idm_param(idmrun,"$5",save_acgeo,idm_char); end if; if access_v.acity /= save_acity and access_v.acity /= " " then idm_param(idmrun,"$6",access_v.acity,idm_char); else idm_param(idmrun,"$6",save_acity,idm_char); end if; if working_adate(3..8) = "# " then idm_param(idmrun,"$7"," ",idm_char); elsif working_adate /= save_adate and working_adate(3..8) /= " " then idm_param(idmrun,"$7",working_adate,idm_char); else idm_param(idmrun,"$7",save_adate,idm_char); end if; if working_rdate(3..8) = "# " then idm_param(idmrun,"$8"," ",idm_char); elsif working_rdate /= save_rdate and working_rdate(3..8) /= " " then idm_param(idmrun,"$8",working_rdate,idm_char); else idm_param(idmrun,"$8",save_rdate,idm_char); end if; if working_mdate /= save_mdate and access_v.mdate /= " " then idm_param(idmrun,"$9",working_mdate,idm_int1); else idm_param(idmrun,"$9",save_mdate,idm_int1); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_v; --********************************************************************* --* --* PROCESS_CARD_X --* --* This procedure will process the message cards of type 'X'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_x is save_gcmd : string(1..6); save_rptor : string(1..6); save_sbrpt : string(1..6); save_intr1 : string(1..6); save_intr2 : string(1..6); save_tdate : string(1..8); save_trgeo : string(1..4); save_depdt : string(1..8); save_arrdt : string(1..8); working_tdate : string(1..8) := "19000000"; working_depdt : string(1..8) := "19000000"; working_arrdt : string(1..8) := "19000000"; begin access_x := list_item.access_x; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_x $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_gcmd,length_of_string); idm_column(idmrun,4,save_rptor,length_of_string); idm_column(idmrun,5,save_sbrpt,length_of_string); idm_column(idmrun,6,save_intr1,length_of_string); idm_column(idmrun,7,save_intr2,length_of_string); idm_column(idmrun,8,save_tdate,length_of_string); idm_column(idmrun,9,save_trgeo,length_of_string); idm_column(idmrun,10,save_depdt,length_of_string); idm_column(idmrun,11,save_arrdt,length_of_string); idm_command(idmrun,"delete_card_x $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_command(idmrun,"add_card_x $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11 $12 $13"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); working_secur := secur_types'image(list_item.secur); working_tdate(3..8) := access_x.tdate.yy & access_x.tdate.mm & access_x.tdate.dd; working_depdt(3..8) := access_x.depdt.yy & access_x.depdt.mm & access_x.depdt.dd; working_arrdt(3..8) := access_x.arrdt.yy & access_x.arrdt.mm & access_x.arrdt.dd; if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_x.gcmd = "# " then idm_param(idmrun,"$5"," ",idm_char); elsif access_x.gcmd /= save_gcmd and access_x.gcmd /= " " then idm_param(idmrun,"$5",access_x.gcmd,idm_char); else idm_param(idmrun,"$5",save_gcmd,idm_char); end if; if access_x.rptor /= save_rptor and access_x.rptor /= " " then idm_param(idmrun,"$6",access_x.rptor,idm_char); else idm_param(idmrun,"$6",save_rptor,idm_char); end if; if access_x.sbrpt /= save_sbrpt and access_x.sbrpt /= " " then idm_param(idmrun,"$7",access_x.sbrpt,idm_char); else idm_param(idmrun,"$7",save_sbrpt,idm_char); end if; if access_x.intr1 = "# " then idm_param(idmrun,"$8"," ",idm_char); elsif access_x.intr1 /= save_intr1 and access_x.intr1 /= " " then idm_param(idmrun,"$8",access_x.intr1,idm_char); else idm_param(idmrun,"$8",save_intr1,idm_char); end if; if access_x.intr2 = "# " then idm_param(idmrun,"$9"," ",idm_char); elsif access_x.intr2 /= save_intr2 and access_x.intr2 /= " " then idm_param(idmrun,"$9",access_x.intr2,idm_char); else idm_param(idmrun,"$9",save_intr2,idm_char); end if; if access_x.gcmd = "# " then idm_param(idmrun,"$10"," ",idm_char); elsif working_tdate /= save_tdate and working_tdate(3..8) /= " " then idm_param(idmrun,"$10",working_tdate,idm_char); else idm_param(idmrun,"$10",save_tdate,idm_char); end if; if access_x.gcmd = "# " then idm_param(idmrun,"$11"," ",idm_char); elsif access_x.trgeo /= save_trgeo and access_x.trgeo /= " " then idm_param(idmrun,"$11",access_x.trgeo,idm_char); else idm_param(idmrun,"$11",save_trgeo,idm_char); end if; if access_x.gcmd = "# " then idm_param(idmrun,"$12"," ",idm_char); elsif working_depdt /= save_depdt and working_depdt(3..8) /= " " then idm_param(idmrun,"$12",working_depdt,idm_char); else idm_param(idmrun,"$12",save_depdt,idm_char); end if; if working_arrdt /= save_arrdt and working_arrdt(3..8) /= " " then idm_param(idmrun,"$13",working_arrdt,idm_char); else idm_param(idmrun,"$13",save_arrdt,idm_char); end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_x; --********************************************************************* --* --* PROCESS_CARD_DM1 --* --* This procedure will process the message cards of type 'DM1'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_dm1 is save_billet : string(1..3); save_cornk : string(1..5); save_conam : string(1..17); begin access_dm1 := list_item.access_dm1; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_dm1 $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_billet,length_of_string); idm_column(idmrun,4,save_cornk,length_of_string); idm_column(idmrun,5,save_conam,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_dm1 $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_dm1 $1 $2 $3 $4 $5 $6 $7"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$5",access_dm1.billet,idm_char); idm_param(idmrun,"$6",access_dm1.cornk,idm_char); idm_param(idmrun,"$7",access_dm1.conam,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_dm1.billet /= save_billet and access_dm1.billet /= " " then idm_param(idmrun,"$5",access_dm1.billet,idm_char); else idm_param(idmrun,"$5",save_billet,idm_char); end if; if access_dm1.cornk /= save_cornk and access_dm1.cornk /= " " then idm_param(idmrun,"$6",access_dm1.cornk,idm_char); else idm_param(idmrun,"$6",save_cornk,idm_char); end if; if access_dm1.conam /= save_conam and access_dm1.conam /= " " then idm_param(idmrun,"$7",access_dm1.conam,idm_char); else idm_param(idmrun,"$7",save_conam,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_dm1; --********************************************************************* --* --* PROCESS_CARD_DN1 --* --* This procedure will process the message cards of type 'DN1'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_dn1 is save_ntask : string(1..13); save_prgeo : string(1..4); save_point : string(1..11); save_ndest : string(1..11); save_ple_d : string(1..8); save_ple_h : integer; save_det_d : string(1..8); save_det_h : integer; save_modfg : string(1..1); save_cxmrs : string(1..1); working_ple_d : string(1..8); working_ple_h : integer; working_det_d : string(1..8); working_det_h : integer; begin access_dn1 := list_item.access_dn1; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_dn1 $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_ntask,length_of_string); idm_column(idmrun,4,save_prgeo,length_of_string); idm_column(idmrun,5,save_point,length_of_string); idm_column(idmrun,6,save_ndest,length_of_string); idm_column(idmrun,7,save_ple_d,length_of_string); idm_column(idmrun,8,save_ple_h); idm_column(idmrun,9,save_det_d,length_of_string); idm_column(idmrun,10,save_det_h); idm_column(idmrun,11,save_modfg,length_of_string); idm_column(idmrun,12,save_cxmrs,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_dn1 $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_dn1 $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); if access_dn1.pletd.year = 0 then working_ple_d(1..4) := " "; else working_string(1..3) := integer'image(access_dn1.pletd.year); working_ple_d(3..4) := working_string(2..3); end if; working_ple_d(5..8) := access_dn1.pletd.mm & access_dn1.pletd.dd; working_ple_h := string_to_integer(access_dn1.pletd.hh); if access_dn1.deta.year = 0 then working_det_d(1..4) := " "; else working_string(1..3) := integer'image(access_dn1.deta.year); working_det_d(3..4) := working_string(2..3); end if; working_det_d(5..8) := access_dn1.deta.mm & access_dn1.deta.dd; working_det_h := string_to_integer(access_dn1.deta.hh); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$5",access_dn1.ntask,idm_char); idm_param(idmrun,"$6",access_dn1.prgeo,idm_char); idm_param(idmrun,"$7",access_dn1.point,idm_char); idm_param(idmrun,"$8",access_dn1.ndest,idm_char); idm_param(idmrun,"$9",working_ple_d,idm_char); idm_param(idmrun,"$10",working_ple_h,idm_int1); idm_param(idmrun,"$11",working_det_d,idm_char); idm_param(idmrun,"$12",working_det_h,idm_int1); idm_param(idmrun,"$13",access_dn1.modfg,idm_char); idm_param(idmrun,"$14",access_dn1.cxmrs,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_dn1.ntask /= save_ntask and access_dn1.ntask /= " " then idm_param(idmrun,"$5",access_dn1.ntask,idm_char); else idm_param(idmrun,"$5",save_ntask,idm_char); end if; if access_dn1.prgeo /= save_prgeo and access_dn1.prgeo /= " " then idm_param(idmrun,"$6",access_dn1.prgeo,idm_char); else idm_param(idmrun,"$6",save_prgeo,idm_char); end if; if access_dn1.point /= save_point and access_dn1.point /= " " then idm_param(idmrun,"$7",access_dn1.point,idm_char); else idm_param(idmrun,"$7",save_point,idm_char); end if; if access_dn1.ndest /= save_ndest and access_dn1.ndest /= " " then idm_param(idmrun,"$8",access_dn1.ndest,idm_char); else idm_param(idmrun,"$8",save_ndest,idm_char); end if; if working_ple_d /= save_ple_d and working_ple_d(3..8) /= " " then idm_param(idmrun,"$9",working_ple_d,idm_char); else idm_param(idmrun,"$9",save_ple_d,idm_char); end if; if working_ple_h /= save_ple_h and access_dn1.pletd.hh /= " " then idm_param(idmrun,"$10",working_ple_h,idm_int1); else idm_param(idmrun,"$10",save_ple_h,idm_int1); end if; if working_det_d /= save_det_d and working_det_d(3..8) /= " " then idm_param(idmrun,"$11",working_det_d,idm_char); else idm_param(idmrun,"$11",save_det_d,idm_char); end if; if working_det_h /= save_det_h and access_dn1.deta.hh /= " " then idm_param(idmrun,"$12",working_det_h,idm_int1); else idm_param(idmrun,"$12",save_det_h,idm_int1); end if; if access_dn1.modfg /= save_modfg and access_dn1.modfg /= " " then idm_param(idmrun,"$13",access_dn1.modfg,idm_char); else idm_param(idmrun,"$13",save_modfg,idm_char); end if; if access_dn1.cxmrs /= save_cxmrs and access_dn1.cxmrs /= " " then idm_param(idmrun,"$14",access_dn1.cxmrs,idm_char); else idm_param(idmrun,"$14",save_cxmrs,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_dn1; --********************************************************************* --* --* PROCESS_CARD_JM1 --* --* This procedure will process the message cards of type 'JM1'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_jm1 is save_mgo : integer; save_ago : integer; save_na : integer; save_nfo : integer; save_menl : integer; save_navo : integer; save_nave : integer; save_othof : integer; save_othen : integer; save_piaod : string(1..6); working_mgo : integer; working_ago : integer; working_na : integer; working_nfo : integer; working_menl : integer; working_navo : integer; working_nave : integer; working_othof : integer; working_othen : integer; begin access_jm1 := list_item.access_jm1; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_jm1 $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_mgo); idm_column(idmrun,4,save_ago); idm_column(idmrun,5,save_na); idm_column(idmrun,6,save_nfo); idm_column(idmrun,7,save_menl); idm_column(idmrun,8,save_navo); idm_column(idmrun,9,save_nave); idm_column(idmrun,10,save_othof); idm_column(idmrun,11,save_othen); idm_column(idmrun,12,save_piaod,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_jm1 $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_jm1 $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); working_mgo := string_to_integer(access_jm1.mgo); working_ago := string_to_integer(access_jm1.ago); working_na := string_to_integer(access_jm1.na); working_nfo := string_to_integer(access_jm1.nfo); working_menl := string_to_integer(access_jm1.menl); working_navo := string_to_integer(access_jm1.navo); working_nave := string_to_integer(access_jm1.nave); working_othof := string_to_integer(access_jm1.othof); working_othen := string_to_integer(access_jm1.othen); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$5",working_mgo,idm_int1); idm_param(idmrun,"$6",working_ago,idm_int1); idm_param(idmrun,"$7",working_na,idm_int1); idm_param(idmrun,"$8",working_nfo,idm_int1); idm_param(idmrun,"$9",working_menl,idm_int1); idm_param(idmrun,"$10",working_navo,idm_int1); idm_param(idmrun,"$11",working_nave,idm_int1); idm_param(idmrun,"$12",working_othof,idm_int1); idm_param(idmrun,"$13",working_othen,idm_int1); idm_param(idmrun,"$14",access_jm1.piaod,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if working_mgo /= save_mgo and access_jm1.mgo /= " " then idm_param(idmrun,"$5",working_mgo,idm_int1); else idm_param(idmrun,"$5",save_mgo,idm_int1); end if; if working_ago /= save_ago and access_jm1.ago /= " " then idm_param(idmrun,"$6",working_ago,idm_int1); else idm_param(idmrun,"$6",save_ago,idm_int1); end if; if working_na /= save_na and access_jm1.na /= " " then idm_param(idmrun,"$7",working_na,idm_int1); else idm_param(idmrun,"$7",save_na,idm_int1); end if; if working_nfo /= save_nfo and access_jm1.nfo /= " " then idm_param(idmrun,"$8",working_nfo,idm_int1); else idm_param(idmrun,"$8",save_nfo,idm_int1); end if; if working_menl /= save_menl and access_jm1.menl /= " " then idm_param(idmrun,"$9",working_menl,idm_int1); else idm_param(idmrun,"$9",save_menl,idm_int1); end if; if working_navo /= save_navo and access_jm1.navo /= " " then idm_param(idmrun,"$10",working_navo,idm_int1); else idm_param(idmrun,"$10",save_navo,idm_int1); end if; if working_nave /= save_nave and access_jm1.nave /= " " then idm_param(idmrun,"$11",working_nave,idm_int1); else idm_param(idmrun,"$11",save_nave,idm_int1); end if; if working_othof /= save_othof and access_jm1.othof /= " " then idm_param(idmrun,"$12",working_othof,idm_int1); else idm_param(idmrun,"$12",save_othof,idm_int1); end if; if working_othen /= save_othen and access_jm1.othen /= " " then idm_param(idmrun,"$13",working_othen,idm_int1); else idm_param(idmrun,"$13",save_othen,idm_int1); end if; if access_jm1.piaod /= save_piaod and access_jm1.piaod /= " " then idm_param(idmrun,"$14",access_jm1.piaod,idm_char); else idm_param(idmrun,"$14",save_piaod,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_jm1; --********************************************************************* --* --* PROCESS_CARD_KF1 --* --* This procedure will process the message cards of type 'KF1'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_kf1 is save_docid : string(1..4); save_tpaut : integer; save_tpasg : integer; save_tpavl : integer; save_cpaur : integer; save_cpasg : integer; save_cpavl : integer; save_tmthd : string(1..1); save_tcarq : integer; save_tcras : integer; save_tcrav : integer; save_trsa1 : integer; save_trsa2 : integer; save_trsa3 : integer; save_trsa4 : integer; save_trsa5 : integer; working_tpaut : integer; working_tpasg : integer; working_tpavl : integer; working_cpaur : integer; working_cpasg : integer; working_cpavl : integer; working_tcarq : integer; working_tcras : integer; working_tcrav : integer; working_trsa1 : integer; working_trsa2 : integer; working_trsa3 : integer; working_trsa4 : integer; working_trsa5 : integer; begin access_kf1 := list_item.access_kf1; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_kf1 $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_kf1.docnr,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_docid,length_of_string); idm_column(idmrun,4,save_tpaut); idm_column(idmrun,5,save_tpasg); idm_column(idmrun,6,save_tpavl); idm_column(idmrun,7,save_cpaur); idm_column(idmrun,8,save_cpasg); idm_column(idmrun,9,save_cpavl); idm_column(idmrun,10,save_tmthd,length_of_string); idm_column(idmrun,11,save_tcarq); idm_column(idmrun,12,save_tcras); idm_column(idmrun,13,save_tcrav); -- -- retrieve for trsa* -- idm_column(idmrun,15,save_trsa1); idm_column(idmrun,16,save_trsa2); idm_column(idmrun,17,save_trsa3); idm_column(idmrun,18,save_trsa4); idm_column(idmrun,19,save_trsa5); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_kf1 $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_kf1.docnr,idm_char); idm_execute(idmrun); idm_fetch(idmrun); -- -- delete for trsa* -- end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_kf1 $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16 $17 $18 $19 $20 $21"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_kf1.docnr,idm_char); working_tpaut := string_to_integer(access_kf1.tpaut); working_tpasg := string_to_integer(access_kf1.tpasg); working_tpavl := string_to_integer(access_kf1.tpavl); working_cpaur := string_to_integer(access_kf1.cpaur); working_cpasg := string_to_integer(access_kf1.cpasg); working_cpavl := string_to_integer(access_kf1.cpavl); working_tcarq := string_to_integer(access_kf1.tcarq); working_tcras := string_to_integer(access_kf1.tcras); working_tcrav := string_to_integer(access_kf1.tcrav); working_trsa1 := string_to_integer(access_kf1.trsa1); working_trsa2 := string_to_integer(access_kf1.trsa2); working_trsa3 := string_to_integer(access_kf1.trsa3); working_trsa4 := string_to_integer(access_kf1.trsa4); working_trsa5 := string_to_integer(access_kf1.trsa5); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$6",access_kf1.docid,idm_char); idm_param(idmrun,"$7",working_tpaut,idm_int1); idm_param(idmrun,"$8",working_tpasg,idm_int1); idm_param(idmrun,"$9",working_tpavl,idm_int1); idm_param(idmrun,"$10",working_cpaur,idm_int1); idm_param(idmrun,"$11",working_cpasg,idm_int1); idm_param(idmrun,"$12",working_cpavl,idm_int1); idm_param(idmrun,"$13",access_kf1.tmthd,idm_char); idm_param(idmrun,"$14",working_tcarq,idm_int1); idm_param(idmrun,"$15",working_tcras,idm_int1); idm_param(idmrun,"$16",working_tcrav,idm_int1); -- -- add for trsa* -- idm_param(idmrun,"$17",working_trsa1,idm_int1); idm_param(idmrun,"$18",working_trsa2,idm_int1); idm_param(idmrun,"$19",access_kf1.trsa3,idm_int1); idm_param(idmrun,"$20",access_kf1.trsa4,idm_int1); idm_param(idmrun,"$21",access_kf1.trsa5,idm_int1); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_kf1.docid /= save_docid and access_kf1.docid /= " " then idm_param(idmrun,"$6",access_kf1.docid,idm_char); else idm_param(idmrun,"$6",save_docid,idm_char); end if; if access_kf1.tpaut = "# " then idm_param(idmrun,"$7",0,idm_int1); elsif working_tpaut /= save_tpaut and access_kf1.tpaut /= " " then idm_param(idmrun,"$7",working_tpaut,idm_int1); else idm_param(idmrun,"$7",save_tpaut,idm_int1); end if; if access_kf1.tpasg = "# " then idm_param(idmrun,"$8",0,idm_int1); elsif working_tpasg /= save_tpasg and access_kf1.tpasg /= " " then idm_param(idmrun,"$8",working_tpasg,idm_int1); else idm_param(idmrun,"$8",save_tpasg,idm_int1); end if; if access_kf1.tpavl = "# " then idm_param(idmrun,"$9",0,idm_int1); elsif working_tpavl /= save_tpavl and access_kf1.tpavl /= " " then idm_param(idmrun,"$9",working_tpavl,idm_int1); else idm_param(idmrun,"$9",save_tpavl,idm_int1); end if; if access_kf1.cpaur = "# " then idm_param(idmrun,"$10",0,idm_int1); elsif working_cpaur /= save_cpaur and access_kf1.cpaur /= " " then idm_param(idmrun,"$10",working_cpaur,idm_int1); else idm_param(idmrun,"$10",save_cpaur,idm_int1); end if; if access_kf1.cpasg = "# " then idm_param(idmrun,"$11",0,idm_int1); elsif working_cpasg /= save_cpasg and access_kf1.cpasg /= " " then idm_param(idmrun,"$11",working_cpasg,idm_int1); else idm_param(idmrun,"$11",save_cpasg,idm_int1); end if; if access_kf1.cpavl = "# " then idm_param(idmrun,"$12",0,idm_int1); elsif working_cpavl /= save_cpavl and access_kf1.cpavl /= " " then idm_param(idmrun,"$12",working_cpavl,idm_int1); else idm_param(idmrun,"$12",save_cpavl,idm_int1); end if; if access_kf1.tmthd /= save_tmthd and access_kf1.tmthd /= " " then idm_param(idmrun,"$13",access_kf1.tmthd,idm_char); else idm_param(idmrun,"$13",save_tmthd,idm_char); end if; if access_kf1.tcarq = "# " then idm_param(idmrun,"$14",0,idm_int1); elsif working_tcarq /= save_tcarq and access_kf1.tcarq /= " " then idm_param(idmrun,"$14",working_tcarq,idm_int1); else idm_param(idmrun,"$14",save_tcarq,idm_int1); end if; if access_kf1.tcras = "# " then idm_param(idmrun,"$15",0,idm_int1); elsif working_tcras /= save_tcras and access_kf1.tcras /= " " then idm_param(idmrun,"$15",working_tcras,idm_int1); else idm_param(idmrun,"$15",save_tcras,idm_int1); end if; if access_kf1.tcrav = "# " then idm_param(idmrun,"$16",0,idm_int1); elsif working_tcrav /= save_tcrav and access_kf1.tcrav /= " " then idm_param(idmrun,"$16",working_tcrav,idm_int1); else idm_param(idmrun,"$16",save_tcrav,idm_int1); end if; -- -- add for trsa* -- if access_kf1.trsa1 = "# " then idm_param(idmrun,"$17",0,idm_int1); elsif working_trsa1 /= save_trsa1 and access_kf1.trsa1 /= " " then idm_param(idmrun,"$17",working_trsa1,idm_int1); else idm_param(idmrun,"$17",save_trsa1,idm_int1); end if; if access_kf1.trsa2 = "# " then idm_param(idmrun,"$18",0,idm_int1); elsif working_trsa2 /= save_trsa2 and access_kf1.trsa2 /= " " then idm_param(idmrun,"$18",working_trsa2,idm_int1); else idm_param(idmrun,"$18",save_trsa2,idm_int1); end if; if access_kf1.trsa3 = "# " then idm_param(idmrun,"$19",0,idm_int1); elsif working_trsa3 /= save_trsa3 and access_kf1.trsa3 /= " " then idm_param(idmrun,"$19",working_trsa3,idm_int1); else idm_param(idmrun,"$19",save_trsa3,idm_int1); end if; if access_kf1.trsa4 = "# " then idm_param(idmrun,"$20",0,idm_int1); elsif working_trsa4 /= save_trsa4 and access_kf1.trsa4 /= " " then idm_param(idmrun,"$20",working_trsa4,idm_int1); else idm_param(idmrun,"$20",save_trsa4,idm_int1); end if; if access_kf1.trsa5 = "# " then idm_param(idmrun,"$21",0,idm_int1); elsif working_trsa5 /= save_trsa5 and access_kf1.trsa5 /= " " then idm_param(idmrun,"$21",working_trsa5,idm_int1); else idm_param(idmrun,"$21",save_trsa5,idm_int1); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_kf1; --********************************************************************* --* --* PROCESS_CARD_KF2 --* --* This procedure will process the message cards of type 'KF2'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_kf2 is save_meard : integer; save_measq : integer; save_mepos : integer; save_memra : integer; save_eqsee : integer; save_eqsse : integer; save_eqree : integer; save_eqred : integer; save_essa1 : integer; save_essa2 : integer; save_essa3 : integer; save_essa4 : integer; save_essa5 : integer; save_essa6 : integer; save_essa7 : integer; save_essa8 : integer; save_essa9 : integer; save_ersa1 : integer; save_ersa2 : integer; save_ersa3 : integer; save_ersa4 : integer; save_ersa5 : integer; save_ersa6 : integer; save_ersa7 : integer; save_ersa8 : integer; save_ersa9 : integer; working_meard : integer; working_measq : integer; working_mepos : integer; working_memra : integer; working_eqsee : integer; working_eqsse : integer; working_eqree : integer; working_eqred : integer; working_essa1 : integer; working_essa2 : integer; working_essa3 : integer; working_essa4 : integer; working_essa5 : integer; working_essa6 : integer; working_essa7 : integer; working_essa8 : integer; working_essa9 : integer; working_ersa1 : integer; working_ersa2 : integer; working_ersa3 : integer; working_ersa4 : integer; working_ersa5 : integer; working_ersa6 : integer; working_ersa7 : integer; working_ersa8 : integer; working_ersa9 : integer; begin access_kf2 := list_item.access_kf2; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_kf2 $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_kf2.docnr,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_meard); idm_column(idmrun,4,save_measq); idm_column(idmrun,5,save_mepos); idm_column(idmrun,6,save_memra); idm_column(idmrun,7,save_eqsee); idm_column(idmrun,8,save_eqsse); idm_column(idmrun,9,save_eqree); idm_column(idmrun,10,save_eqred); -- -- retrieve for essa* -- idm_column(idmrun,11,save_essa1); idm_column(idmrun,12,save_essa2); idm_column(idmrun,13,save_essa3); idm_column(idmrun,14,save_essa4); idm_column(idmrun,15,save_essa5); idm_column(idmrun,16,save_essa6); idm_column(idmrun,17,save_essa7); idm_column(idmrun,18,save_essa8); idm_column(idmrun,19,save_essa9); -- -- retrieve for ers1* -- idm_column(idmrun,20,save_ersa1); idm_column(idmrun,21,save_ersa2); idm_column(idmrun,22,save_ersa3); idm_column(idmrun,23,save_ersa4); idm_column(idmrun,24,save_ersa5); idm_column(idmrun,25,save_ersa6); idm_column(idmrun,26,save_ersa7); idm_column(idmrun,27,save_ersa8); idm_column(idmrun,28,save_ersa9); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_kf2 $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_kf2.docnr,idm_char); idm_execute(idmrun); idm_fetch(idmrun); -- -- delete for essa* and ersa* -- end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_kf2 $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16 $17 $18 $19 $20 $21 " & "$22 $23 $24 $25 $26 $27 $28 $29 $30 $31"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_kf2.docnr,idm_char); working_meard := string_to_integer(access_kf2.meard); working_measq := string_to_integer(access_kf2.measq); working_mepos := string_to_integer(access_kf2.mepos); working_memra := string_to_integer(access_kf2.memra); working_eqsee := string_to_integer(access_kf2.eqsee); working_eqsse := string_to_integer(access_kf2.eqsse); working_eqree := string_to_integer(access_kf2.eqree); working_eqred := string_to_integer(access_kf2.eqred); working_essa1 := string_to_integer(access_kf2.essa1); working_essa2 := string_to_integer(access_kf2.essa2); working_essa3 := string_to_integer(access_kf2.essa3); working_essa4 := string_to_integer(access_kf2.essa4); working_essa5 := string_to_integer(access_kf2.essa5); working_essa6 := string_to_integer(access_kf2.essa6); working_essa7 := string_to_integer(access_kf2.essa7); working_essa8 := string_to_integer(access_kf2.essa8); working_essa9 := string_to_integer(access_kf2.essa9); working_ersa1 := string_to_integer(access_kf2.ersa1); working_ersa2 := string_to_integer(access_kf2.ersa2); working_ersa3 := string_to_integer(access_kf2.ersa3); working_ersa4 := string_to_integer(access_kf2.ersa4); working_ersa5 := string_to_integer(access_kf2.ersa5); working_ersa6 := string_to_integer(access_kf2.ersa6); working_ersa7 := string_to_integer(access_kf2.ersa7); working_ersa8 := string_to_integer(access_kf2.ersa8); working_ersa9 := string_to_integer(access_kf2.ersa9); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$6",working_meard,idm_int1); idm_param(idmrun,"$7",working_measq,idm_int1); idm_param(idmrun,"$8",working_mepos,idm_int1); idm_param(idmrun,"$9",working_memra,idm_int1); idm_param(idmrun,"$10",working_eqsee,idm_int1); idm_param(idmrun,"$11",working_eqsse,idm_int1); idm_param(idmrun,"$12",working_eqree,idm_int1); idm_param(idmrun,"$13",working_eqred,idm_int1); -- -- add for essa* -- idm_param(idmrun,"$14",working_essa1,idm_int1); idm_param(idmrun,"$15",working_essa2,idm_int1); idm_param(idmrun,"$16",working_essa3,idm_int1); idm_param(idmrun,"$17",working_essa4,idm_int1); idm_param(idmrun,"$18",working_essa5,idm_int1); idm_param(idmrun,"$19",working_essa6,idm_int1); idm_param(idmrun,"$20",working_essa7,idm_int1); idm_param(idmrun,"$21",working_essa8,idm_int1); idm_param(idmrun,"$22",working_essa9,idm_int1); -- -- add for ersa* -- idm_param(idmrun,"$23",working_ersa1,idm_int1); idm_param(idmrun,"$24",working_ersa2,idm_int1); idm_param(idmrun,"$25",working_ersa3,idm_int1); idm_param(idmrun,"$26",working_ersa4,idm_int1); idm_param(idmrun,"$27",working_ersa5,idm_int1); idm_param(idmrun,"$28",working_ersa6,idm_int1); idm_param(idmrun,"$29",working_ersa7,idm_int1); idm_param(idmrun,"$30",working_ersa8,idm_int1); idm_param(idmrun,"$31",working_ersa9,idm_int1); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_kf2.meard = "# " then idm_param(idmrun,"$6",0,idm_int1); elsif working_meard /= save_meard and access_kf2.meard /= " " then idm_param(idmrun,"$6",working_meard,idm_int1); else idm_param(idmrun,"$6",save_meard,idm_int1); end if; if access_kf2.measq = "# " then idm_param(idmrun,"$7",0,idm_int1); elsif working_measq /= save_measq and access_kf2.measq /= " " then idm_param(idmrun,"$7",working_measq,idm_int1); else idm_param(idmrun,"$7",save_measq,idm_int1); end if; if access_kf2.mepos = "# " then idm_param(idmrun,"$8",0,idm_int1); elsif working_mepos /= save_mepos and access_kf2.mepos /= " " then idm_param(idmrun,"$8",working_mepos,idm_int1); else idm_param(idmrun,"$8",save_mepos,idm_int1); end if; if access_kf2.memra = "# " then idm_param(idmrun,"$9",0,idm_int1); elsif working_memra /= save_memra and access_kf2.memra /= " " then idm_param(idmrun,"$9",working_memra,idm_int1); else idm_param(idmrun,"$9",save_memra,idm_int1); end if; if access_kf2.eqsee = "# " then idm_param(idmrun,"$10",0,idm_int1); elsif working_eqsee /= save_eqsee and access_kf2.eqsee /= " " then idm_param(idmrun,"$10",working_eqsee,idm_int1); else idm_param(idmrun,"$10",save_eqsee,idm_int1); end if; if access_kf2.eqsse = "# " then idm_param(idmrun,"$11",0,idm_int1); elsif working_eqsse /= save_eqsse and access_kf2.eqsse /= " " then idm_param(idmrun,"$11",working_eqsse,idm_int1); else idm_param(idmrun,"$11",save_eqsse,idm_int1); end if; if access_kf2.eqree = "# " then idm_param(idmrun,"$12",0,idm_int1); elsif working_eqree /= save_eqree and access_kf2.eqree /= " " then idm_param(idmrun,"$12",working_eqree,idm_int1); else idm_param(idmrun,"$12",save_eqree,idm_int1); end if; if access_kf2.eqred = "# " then idm_param(idmrun,"$13",0,idm_int1); elsif working_eqred /= save_eqred and access_kf2.eqred /= " " then idm_param(idmrun,"$13",working_eqred,idm_int1); else idm_param(idmrun,"$13",save_eqred,idm_int1); end if; -- -- add for essa* -- if access_kf2.essa1 = "# " then idm_param(idmrun,"$14",0,idm_int1); elsif working_essa1 /= save_essa1 and access_kf2.essa1 /= " " then idm_param(idmrun,"$14",working_essa1,idm_int1); else idm_param(idmrun,"$14",save_essa1,idm_int1); end if; if access_kf2.essa2 = "# " then idm_param(idmrun,"$15",0,idm_int1); elsif working_essa2 /= save_essa2 and access_kf2.essa2 /= " " then idm_param(idmrun,"$15",working_essa2,idm_int1); else idm_param(idmrun,"$15",save_essa2,idm_int1); end if; if access_kf2.essa3 = "# " then idm_param(idmrun,"$16",0,idm_int1); elsif working_essa3 /= save_essa3 and access_kf2.essa3 /= " " then idm_param(idmrun,"$16",working_essa3,idm_int1); else idm_param(idmrun,"$16",save_essa3,idm_int1); end if; if access_kf2.essa4 = "# " then idm_param(idmrun,"$17",0,idm_int1); elsif working_essa4 /= save_essa4 and access_kf2.essa4 /= " " then idm_param(idmrun,"$17",working_essa4,idm_int1); else idm_param(idmrun,"$17",save_essa4,idm_int1); end if; if access_kf2.essa5 = "# " then idm_param(idmrun,"$18",0,idm_int1); elsif working_essa5 /= save_essa5 and access_kf2.essa5 /= " " then idm_param(idmrun,"$18",working_essa5,idm_int1); else idm_param(idmrun,"$18",save_essa5,idm_int1); end if; if access_kf2.essa6 = "# " then idm_param(idmrun,"$19",0,idm_int1); elsif working_essa6 /= save_essa6 and access_kf2.essa6 /= " " then idm_param(idmrun,"$19",working_essa6,idm_int1); else idm_param(idmrun,"$19",save_essa6,idm_int1); end if; if access_kf2.essa7 = "# " then idm_param(idmrun,"$20",0,idm_int1); elsif working_essa7 /= save_essa7 and access_kf2.essa7 /= " " then idm_param(idmrun,"$20",working_essa7,idm_int1); else idm_param(idmrun,"$20",save_essa7,idm_int1); end if; if access_kf2.essa8 = "# " then idm_param(idmrun,"$21",0,idm_int1); elsif working_essa8 /= save_essa8 and access_kf2.essa8 /= " " then idm_param(idmrun,"$21",working_essa8,idm_int1); else idm_param(idmrun,"$21",save_essa8,idm_int1); end if; if access_kf2.essa9 = "# " then idm_param(idmrun,"$22",0,idm_int1); elsif working_essa9 /= save_essa9 and access_kf2.essa9 /= " " then idm_param(idmrun,"$22",working_essa9,idm_int1); else idm_param(idmrun,"$22",save_essa9,idm_int1); end if; -- -- add for ersa* -- if access_kf2.ersa1 = "# " then idm_param(idmrun,"$23",0,idm_int1); elsif working_ersa1 /= save_ersa1 and access_kf2.ersa1 /= " " then idm_param(idmrun,"$23",working_ersa1,idm_int1); else idm_param(idmrun,"$23",save_ersa1,idm_int1); end if; if access_kf2.ersa2 = "# " then idm_param(idmrun,"$24",0,idm_int1); elsif working_ersa2 /= save_ersa2 and access_kf2.ersa2 /= " " then idm_param(idmrun,"$24",working_ersa2,idm_int1); else idm_param(idmrun,"$24",save_ersa2,idm_int1); end if; if access_kf2.ersa3 = "# " then idm_param(idmrun,"$25",0,idm_int1); elsif working_ersa3 /= save_ersa3 and access_kf2.ersa3 /= " " then idm_param(idmrun,"$25",working_ersa3,idm_int1); else idm_param(idmrun,"$25",save_ersa3,idm_int1); end if; if access_kf2.ersa4 = "# " then idm_param(idmrun,"$26",0,idm_int1); elsif working_ersa4 /= save_ersa4 and access_kf2.ersa4 /= " " then idm_param(idmrun,"$26",working_ersa4,idm_int1); else idm_param(idmrun,"$26",save_ersa4,idm_int1); end if; if access_kf2.ersa5 = "# " then idm_param(idmrun,"$27",0,idm_int1); elsif working_ersa5 /= save_ersa5 and access_kf2.ersa5 /= " " then idm_param(idmrun,"$27",working_ersa5,idm_int1); else idm_param(idmrun,"$27",save_ersa5,idm_int1); end if; if access_kf2.ersa6 = "# " then idm_param(idmrun,"$28",0,idm_int1); elsif working_ersa6 /= save_ersa6 and access_kf2.ersa6 /= " " then idm_param(idmrun,"$28",working_ersa6,idm_int1); else idm_param(idmrun,"$28",save_ersa6,idm_int1); end if; if access_kf2.ersa7 = "# " then idm_param(idmrun,"$29",0,idm_int1); elsif working_ersa7 /= save_ersa7 and access_kf2.ersa7 /= " " then idm_param(idmrun,"$29",working_ersa7,idm_int1); else idm_param(idmrun,"$29",save_ersa7,idm_int1); end if; if access_kf2.ersa8 = "# " then idm_param(idmrun,"$30",0,idm_int1); elsif working_ersa8 /= save_ersa8 and access_kf2.ersa8 /= " " then idm_param(idmrun,"$30",working_ersa8,idm_int1); else idm_param(idmrun,"$30",save_ersa8,idm_int1); end if; if access_kf2.ersa9 = "# " then idm_param(idmrun,"$31",0,idm_int1); elsif working_ersa9 /= save_ersa9 and access_kf2.ersa9 /= " " then idm_param(idmrun,"$31",working_ersa9,idm_int1); else idm_param(idmrun,"$31",save_ersa9,idm_int1); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_kf2; --********************************************************************* --* --* PROCESS_CARD_KF3 --* --* This procedure will process the message cards of type 'KF3'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_kf3 is save_sdoc : string(1..4); save_respf : string(1..5); save_readf : integer; save_reasf : string(1..1); save_prraf : integer; save_prref : string(1..3); save_esraf : integer; save_esref : string(1..3); save_erraf : integer; save_erref : string(1..3); save_trraf : integer; save_trref : string(1..3); save_secrf : string(1..3); save_terrf : string(1..3); save_caraf : integer; save_cadaf : string(1..8); save_limf : integer; save_rlimf : string(1..2); save_ricdf : string(1..8); working_readf : integer; working_prraf : integer; working_esraf : integer; working_erraf : integer; working_trraf : integer; working_caraf : integer; working_cadaf : string(1..8) := "19000000"; working_limf : integer; working_ricdf : string(1..8) := "19000000"; begin access_kf3 := list_item.access_kf3; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_kf3 $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_kf3.docnr,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_sdoc,length_of_string); idm_column(idmrun,4,save_respf,length_of_string); idm_column(idmrun,5,save_readf); idm_column(idmrun,6,save_reasf,length_of_string); idm_column(idmrun,7,save_prraf); idm_column(idmrun,8,save_prref,length_of_string); idm_column(idmrun,9,save_esraf); idm_column(idmrun,10,save_esref,length_of_string); idm_column(idmrun,11,save_erraf); idm_column(idmrun,12,save_erref,length_of_string); idm_column(idmrun,13,save_trraf); idm_column(idmrun,14,save_trref,length_of_string); idm_column(idmrun,15,save_secrf,length_of_string); idm_column(idmrun,16,save_terrf,length_of_string); idm_column(idmrun,17,save_caraf); idm_column(idmrun,18,save_cadaf,length_of_string); idm_column(idmrun,19,save_limf); idm_column(idmrun,20,save_rlimf,length_of_string); idm_column(idmrun,21,save_ricdf,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_kf3 $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_kf3.docnr,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_kf3 $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16 $17 $18 $19 $20 $21 " & "$22 $23 $24"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_kf3.docnr,idm_char); working_readf := string_to_integer(access_kf3.readf); working_prraf := string_to_integer(access_kf3.prraf); working_esraf := string_to_integer(access_kf3.esraf); working_erraf := string_to_integer(access_kf3.erraf); working_trraf := string_to_integer(access_kf3.trraf); working_caraf := string_to_integer(access_kf3.caraf); working_cadaf(3..8) := access_kf3.cadaf.yy & access_kf3.cadaf.mm & access_kf3.cadaf.dd; working_limf := string_to_integer(access_kf3.limf); working_ricdf(3..8) := access_kf3.ricdf.yy & access_kf3.ricdf.mm & access_kf3.ricdf.dd; working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$6",access_kf3.sdoc,idm_char); idm_param(idmrun,"$7",access_kf3.respf,idm_char); idm_param(idmrun,"$8",working_readf,idm_int1); idm_param(idmrun,"$9",access_kf3.reasf,idm_char); idm_param(idmrun,"$10",working_prraf,idm_int1); idm_param(idmrun,"$11",access_kf3.prref,idm_char); idm_param(idmrun,"$12",working_esraf,idm_int1); idm_param(idmrun,"$13",access_kf3.esref,idm_char); idm_param(idmrun,"$14",working_erraf,idm_int1); idm_param(idmrun,"$15",access_kf3.erref,idm_char); idm_param(idmrun,"$16",working_trraf,idm_int1); idm_param(idmrun,"$17",access_kf3.trref,idm_char); idm_param(idmrun,"$18",access_kf3.secrf,idm_char); idm_param(idmrun,"$19",access_kf3.terrf,idm_char); idm_param(idmrun,"$20",working_caraf,idm_int1); idm_param(idmrun,"$21",working_cadaf,idm_char); idm_param(idmrun,"$22",working_limf,idm_int1); idm_param(idmrun,"$23",access_kf3.rlimf,idm_char); idm_param(idmrun,"$24",working_ricdf,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_kf3.sdoc /= save_sdoc and access_kf3.sdoc /= " " then idm_param(idmrun,"$6",access_kf3.sdoc,idm_char); else idm_param(idmrun,"$6",save_sdoc,idm_char); end if; if access_kf3.respf = "# " then idm_param(idmrun,"$7"," ",idm_char); elsif access_kf3.respf /= save_respf and access_kf3.respf /= " " then idm_param(idmrun,"$7",access_kf3.respf,idm_char); else idm_param(idmrun,"$7",save_respf,idm_char); end if; if working_readf /= save_readf and access_kf3.readf /= " " then idm_param(idmrun,"$8",working_readf,idm_int1); else idm_param(idmrun,"$8",save_readf,idm_int1); end if; if access_kf3.reasf /= save_reasf and access_kf3.reasf /= " " then idm_param(idmrun,"$9",access_kf3.reasf,idm_char); else idm_param(idmrun,"$9",save_reasf,idm_char); end if; if working_prraf /= save_prraf and access_kf3.prraf /= " " then idm_param(idmrun,"$10",working_prraf,idm_int1); else idm_param(idmrun,"$10",save_prraf,idm_int1); end if; if access_kf3.prref = "# " then idm_param(idmrun,"$11"," ",idm_char); elsif access_kf3.prref /= save_prref and access_kf3.prref /= " " then idm_param(idmrun,"$11",access_kf3.prref,idm_char); else idm_param(idmrun,"$11",save_prref,idm_char); end if; if working_esraf /= save_esraf and access_kf3.esraf /= " " then idm_param(idmrun,"$12",working_esraf,idm_int1); else idm_param(idmrun,"$12",save_esraf,idm_int1); end if; if access_kf3.esref = "# " then idm_param(idmrun,"$13"," ",idm_char); elsif access_kf3.esref /= save_esref and access_kf3.esref /= " " then idm_param(idmrun,"$13",access_kf3.esref,idm_char); else idm_param(idmrun,"$13",save_esref,idm_char); end if; if working_erraf /= save_erraf and access_kf3.erraf /= " " then idm_param(idmrun,"$14",working_erraf,idm_int1); else idm_param(idmrun,"$14",save_erraf,idm_int1); end if; if access_kf3.erref = "# " then idm_param(idmrun,"$15"," ",idm_char); elsif access_kf3.erref /= save_erref and access_kf3.erref /= " " then idm_param(idmrun,"$15",access_kf3.erref,idm_char); else idm_param(idmrun,"$15",save_erref,idm_char); end if; if working_trraf /= save_trraf and access_kf3.trraf /= " " then idm_param(idmrun,"$16",working_trraf,idm_int1); else idm_param(idmrun,"$16",save_trraf,idm_int1); end if; if access_kf3.trref = "# " then idm_param(idmrun,"$17"," ",idm_char); elsif access_kf3.trref /= save_trref and access_kf3.trref /= " " then idm_param(idmrun,"$17",access_kf3.trref,idm_char); else idm_param(idmrun,"$17",save_trref,idm_char); end if; if access_kf3.secrf = "# " then idm_param(idmrun,"$18"," ",idm_char); elsif access_kf3.secrf /= save_secrf and access_kf3.secrf /= " " then idm_param(idmrun,"$18",access_kf3.secrf,idm_char); else idm_param(idmrun,"$18",save_secrf,idm_char); end if; if access_kf3.terrf = "# " or access_kf3.secrf = "# " then idm_param(idmrun,"$19"," ",idm_char); elsif access_kf3.terrf /= save_terrf and access_kf3.terrf /= " " then idm_param(idmrun,"$19",access_kf3.terrf,idm_char); else idm_param(idmrun,"$19",save_terrf,idm_char); end if; if access_kf3.caraf = "#" then idm_param(idmrun,"$20",0,idm_int1); elsif working_caraf /= save_caraf and access_kf3.caraf /= " " then idm_param(idmrun,"$20",working_caraf,idm_int1); else idm_param(idmrun,"$20",save_caraf,idm_int1); end if; if working_cadaf(3..8) = "# " or access_kf3.caraf = "#" then idm_param(idmrun,"$21"," ",idm_char); elsif working_cadaf /= save_cadaf and working_cadaf(3..8) /= " " then idm_param(idmrun,"$21",working_cadaf,idm_char); else idm_param(idmrun,"$21",save_cadaf,idm_char); end if; if access_kf3.limf = "#" then idm_param(idmrun,"$22",0,idm_int1); elsif working_limf /= save_limf and access_kf3.limf /= " " then idm_param(idmrun,"$22",working_limf,idm_int1); else idm_param(idmrun,"$22",save_limf,idm_int1); end if; if access_kf3.rlimf = "# " then idm_param(idmrun,"$23"," ",idm_char); elsif access_kf3.rlimf /= save_rlimf and access_kf3.rlimf /= " " then idm_param(idmrun,"$23",access_kf3.rlimf,idm_char); else idm_param(idmrun,"$23",save_rlimf,idm_char); end if; if working_ricdf /= save_ricdf and working_ricdf(3..8) /= " " then idm_param(idmrun,"$24",working_ricdf,idm_char); else idm_param(idmrun,"$24",save_ricdf,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_kf3; --********************************************************************* --* --* PROCESS_CARD_KF4 --* --* This procedure will process the message cards of type 'KF4'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_kf4 is save_gccla : integer; save_gcclb : integer; save_gcclc : integer; save_spclu : string(1..9); save_smra1 : integer; save_smaa1 : integer; save_smrc1 : integer; save_smac1 : integer; save_smcc2 : integer; save_smra2 : integer; save_smaa2 : integer; save_smrc2 : integer; save_smac2 : integer; save_smcc3 : integer; save_smra3 : integer; save_smaa3 : integer; save_smrc3 : integer; save_smac3 : integer; save_smcc4 : integer; save_smra4 : integer; save_smaa4 : integer; save_smrc4 : integer; save_smac4 : integer; working_gccla : integer; working_gcclb : integer; working_gcclc : integer; working_smra1 : integer; working_smaa1 : integer; working_smrc1 : integer; working_smac1 : integer; working_smcc2 : integer; working_smra2 : integer; working_smaa2 : integer; working_smrc2 : integer; working_smac2 : integer; working_smcc3 : integer; working_smra3 : integer; working_smaa3 : integer; working_smrc3 : integer; working_smac3 : integer; working_smcc4 : integer; working_smra4 : integer; working_smaa4 : integer; working_smrc4 : integer; working_smac4 : integer; begin access_kf4 := list_item.access_kf4; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_kf4 $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_gccla); idm_column(idmrun,4,save_gcclb); idm_column(idmrun,5,save_gcclc); idm_column(idmrun,6,save_spclu,length_of_string); -- -- retrieve for smcc1 -- idm_column(idmrun,7,save_smra1); idm_column(idmrun,8,save_smaa1); idm_column(idmrun,9,save_smrc1); idm_column(idmrun,10,save_smac1); idm_column(idmrun,11,save_smcc2); idm_column(idmrun,12,save_smra2); idm_column(idmrun,13,save_smaa2); idm_column(idmrun,14,save_smrc2); idm_column(idmrun,15,save_smac2); idm_column(idmrun,16,save_smcc3); idm_column(idmrun,17,save_smra3); idm_column(idmrun,18,save_smaa3); idm_column(idmrun,19,save_smrc3); idm_column(idmrun,20,save_smac3); idm_column(idmrun,21,save_smcc4); idm_column(idmrun,22,save_smra4); idm_column(idmrun,23,save_smaa4); idm_column(idmrun,24,save_smrc4); idm_column(idmrun,25,save_smac4); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_kf4 $1"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_execute(idmrun); idm_fetch(idmrun); -- -- delete for smcc1 -- end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_kf4 $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16 $17 $18 $19 $20 $21 " & "$22 $23 $24 $25 $26 $27 $28"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$9",access_kf4.smcc1,idm_char); working_gccla := string_to_integer(access_kf4.gccla); working_gcclb := string_to_integer(access_kf4.gcclb); working_gcclc := string_to_integer(access_kf4.gcclc); working_smra1 := string_to_integer(access_kf4.smra1); working_smaa1 := string_to_integer(access_kf4.smaa1); working_smrc1 := string_to_integer(access_kf4.smrc1); working_smac1 := string_to_integer(access_kf4.smac1); working_smcc2 := string_to_integer(access_kf4.smcc2); working_smra2 := string_to_integer(access_kf4.smra2); working_smaa2 := string_to_integer(access_kf4.smaa2); working_smrc2 := string_to_integer(access_kf4.smrc2); working_smac2 := string_to_integer(access_kf4.smac2); working_smcc3 := string_to_integer(access_kf4.smcc3); working_smra3 := string_to_integer(access_kf4.smra3); working_smaa3 := string_to_integer(access_kf4.smaa3); working_smrc3 := string_to_integer(access_kf4.smrc3); working_smac3 := string_to_integer(access_kf4.smac3); working_smcc4 := string_to_integer(access_kf4.smcc4); working_smra4 := string_to_integer(access_kf4.smra4); working_smaa4 := string_to_integer(access_kf4.smaa4); working_smrc4 := string_to_integer(access_kf4.smrc4); working_smac4 := string_to_integer(access_kf4.smac4); working_secur := secur_types'image(list_item.secur); if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$5",working_gccla,idm_int1); idm_param(idmrun,"$6",working_gcclb,idm_int1); idm_param(idmrun,"$7",working_gcclc,idm_int1); idm_param(idmrun,"$8",access_kf4.spclu,idm_char); -- -- add for smcc1 -- idm_param(idmrun,"$10",working_smra1,idm_int1); idm_param(idmrun,"$11",working_smaa1,idm_int1); idm_param(idmrun,"$12",working_smrc1,idm_int1); idm_param(idmrun,"$13",working_smac1,idm_int1); idm_param(idmrun,"$14",working_smcc2,idm_int1); idm_param(idmrun,"$15",working_smra2,idm_int1); idm_param(idmrun,"$16",working_smaa2,idm_int1); idm_param(idmrun,"$17",working_smrc2,idm_int1); idm_param(idmrun,"$18",working_smac2,idm_int1); idm_param(idmrun,"$19",working_smcc3,idm_int1); idm_param(idmrun,"$20",working_smra3,idm_int1); idm_param(idmrun,"$21",working_smaa3,idm_int1); idm_param(idmrun,"$22",working_smrc3,idm_int1); idm_param(idmrun,"$23",working_smac3,idm_int1); idm_param(idmrun,"$24",working_smcc4,idm_int1); idm_param(idmrun,"$25",working_smra4,idm_int1); idm_param(idmrun,"$26",working_smaa4,idm_int1); idm_param(idmrun,"$27",working_smrc4,idm_int1); idm_param(idmrun,"$28",working_smac4,idm_int1); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_kf4.gccla = "# " then idm_param(idmrun,"$5",0,idm_int1); elsif working_gccla /= save_gccla and access_kf4.gccla /= " " then idm_param(idmrun,"$5",working_gccla,idm_int1); else idm_param(idmrun,"$5",save_gccla,idm_int1); end if; if access_kf4.gcclb = "# " or access_kf4.gccla = "# " then idm_param(idmrun,"$6",0,idm_int1); elsif working_gcclb /= save_gcclb and access_kf4.gcclb /= " " then idm_param(idmrun,"$6",working_gcclb,idm_int1); else idm_param(idmrun,"$6",save_gcclb,idm_int1); end if; if access_kf4.gcclc = "# " or access_kf4.gcclb = "# " or access_kf4.gccla = "# " then idm_param(idmrun,"$7",0,idm_int1); elsif working_gcclc /= save_gcclc and access_kf4.gcclc /= " " then idm_param(idmrun,"$7",working_gcclc,idm_int1); else idm_param(idmrun,"$7",save_gcclc,idm_int1); end if; if access_kf4.spclu = "# " then idm_param(idmrun,"$8"," ",idm_char); elsif access_kf4.spclu /= save_spclu and access_kf4.spclu /= " " then idm_param(idmrun,"$8",access_kf4.spclu,idm_char); else idm_param(idmrun,"$8",save_spclu,idm_char); end if; -- -- add for smcc1 -- if working_smra1 /= save_smra1 and access_kf4.smra1 /= " " then idm_param(idmrun,"$10",working_smra1,idm_int1); else idm_param(idmrun,"$10",save_smra1,idm_int1); end if; if working_smaa1 /= save_smaa1 and access_kf4.smaa1 /= " " then idm_param(idmrun,"$11",working_smaa1,idm_int1); else idm_param(idmrun,"$11",save_smaa1,idm_int1); end if; if working_smrc1 /= save_smrc1 and access_kf4.smrc1 /= " " then idm_param(idmrun,"$12",working_smrc1,idm_int1); else idm_param(idmrun,"$12",save_smrc1,idm_int1); end if; if working_smac1 /= save_smac1 and access_kf4.smac1 /= " " then idm_param(idmrun,"$13",working_smac1,idm_int1); else idm_param(idmrun,"$13",save_smac1,idm_int1); end if; if access_kf4.smcc2 = "# " then idm_param(idmrun,"$14",0,idm_int1); elsif working_smcc2 /= save_smcc2 and access_kf4.smcc2 /= " " then idm_param(idmrun,"$14",working_smcc2,idm_int1); else idm_param(idmrun,"$14",save_smcc2,idm_int1); end if; if access_kf4.smcc2 = "# " then idm_param(idmrun,"$15",0,idm_int1); elsif working_smra2 /= save_smra2 and access_kf4.smra2 /= " " then idm_param(idmrun,"$15",working_smra2,idm_int1); else idm_param(idmrun,"$15",save_smra2,idm_int1); end if; if access_kf4.smcc2 = "# " then idm_param(idmrun,"$16",0,idm_int1); elsif working_smaa2 /= save_smaa2 and access_kf4.smaa2 /= " " then idm_param(idmrun,"$16",working_smaa2,idm_int1); else idm_param(idmrun,"$16",save_smaa2,idm_int1); end if; if access_kf4.smcc2 = "# " then idm_param(idmrun,"$17",0,idm_int1); elsif working_smrc2 /= save_smrc2 and access_kf4.smrc2 /= " " then idm_param(idmrun,"$17",working_smrc2,idm_int1); else idm_param(idmrun,"$17",save_smrc2,idm_int1); end if; if access_kf4.smcc2 = "# " then idm_param(idmrun,"$18",0,idm_int1); elsif working_smac2 /= save_smac2 and access_kf4.smac2 /= " " then idm_param(idmrun,"$18",working_smac2,idm_int1); else idm_param(idmrun,"$18",save_smac2,idm_int1); end if; if access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$19",0,idm_int1); elsif working_smcc3 /= save_smcc3 and access_kf4.smcc3 /= " " then idm_param(idmrun,"$19",working_smcc3,idm_int1); else idm_param(idmrun,"$19",save_smcc3,idm_int1); end if; if access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$20",0,idm_int1); elsif working_smra3 /= save_smra3 and access_kf4.smra3 /= " " then idm_param(idmrun,"$20",working_smra3,idm_int1); else idm_param(idmrun,"$20",save_smra3,idm_int1); end if; if access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$21",0,idm_int1); elsif working_smaa3 /= save_smaa3 and access_kf4.smaa3 /= " " then idm_param(idmrun,"$21",working_smaa3,idm_int1); else idm_param(idmrun,"$21",save_smaa3,idm_int1); end if; if access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$22",0,idm_int1); elsif working_smrc3 /= save_smrc3 and access_kf4.smrc3 /= " " then idm_param(idmrun,"$22",working_smrc3,idm_int1); else idm_param(idmrun,"$22",save_smrc3,idm_int1); end if; if access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$23",0,idm_int1); elsif working_smac3 /= save_smac3 and access_kf4.smac3 /= " " then idm_param(idmrun,"$23",working_smac3,idm_int1); else idm_param(idmrun,"$23",save_smac3,idm_int1); end if; if access_kf4.smcc4 = "# " or access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$24",0,idm_int1); elsif working_smcc4 /= save_smcc4 and access_kf4.smcc4 /= " " then idm_param(idmrun,"$24",working_smcc4,idm_int1); else idm_param(idmrun,"$24",save_smcc4,idm_int1); end if; if access_kf4.smcc4 = "# " or access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$25",0,idm_int1); elsif working_smra4 /= save_smra4 and access_kf4.smra4 /= " " then idm_param(idmrun,"$25",working_smra4,idm_int1); else idm_param(idmrun,"$25",save_smra4,idm_int1); end if; if access_kf4.smcc4 = "# " or access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$26",0,idm_int1); elsif working_smaa4 /= save_smaa4 and access_kf4.smaa4 /= " " then idm_param(idmrun,"$26",working_smaa4,idm_int1); else idm_param(idmrun,"$26",save_smaa4,idm_int1); end if; if access_kf4.smcc4 = "# " or access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$27",0,idm_int1); elsif working_smrc4 /= save_smrc4 and access_kf4.smrc4 /= " " then idm_param(idmrun,"$27",working_smrc4,idm_int1); else idm_param(idmrun,"$27",save_smrc4,idm_int1); end if; if access_kf4.smcc4 = "# " or access_kf4.smcc3 = "# " or access_kf4.smcc2 = "# " then idm_param(idmrun,"$28",0,idm_int1); elsif working_smac4 /= save_smac4 and access_kf4.smac4 /= " " then idm_param(idmrun,"$28",working_smac4,idm_int1); else idm_param(idmrun,"$28",save_smac4,idm_int1); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_kf4; --********************************************************************* --* --* PROCESS_CARD_KN1 --* --* This procedure will process the message cards of type 'KN1'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_kn1 is working_prma : string(1..3); save_marat : string(1..1); save_marea : string(1..3); save_chdat : string(1..8); save_fmart : string(1..1); save_fcdat : string(1..8); working_chdat : string(1..8) := "19000000"; working_fcdat : string(1..8) := "19000000"; begin access_kn1 := list_item.access_kn1; working_prma := prma_types'image(access_kn1.prma); if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_kn1 $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",working_prma,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_marat,length_of_string); idm_column(idmrun,4,save_marea,length_of_string); idm_column(idmrun,5,save_chdat,length_of_string); idm_column(idmrun,6,save_fmart,length_of_string); idm_column(idmrun,7,save_fcdat,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_kn1 $1 $2"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",working_prma,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_kn1 $1 $2 $3 $4 $5 $6 $7 $8 $9 $10"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",working_prma,idm_char); working_secur := secur_types'image(list_item.secur); working_chdat(3..8) := access_kn1.chdat.yy & access_kn1.chdat.mm & access_kn1.chdat.dd; working_fcdat(3..8) := access_kn1.fcdat.yy & access_kn1.fcdat.mm & access_kn1.fcdat.dd; if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$6",access_kn1.marat,idm_char); idm_param(idmrun,"$7",access_kn1.marea,idm_char); idm_param(idmrun,"$8",working_chdat,idm_char); idm_param(idmrun,"$9",access_kn1.fmart,idm_char); idm_param(idmrun,"$10",working_fcdat,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_kn1.marat /= save_marat and access_kn1.marat /= " " then idm_param(idmrun,"$6",access_kn1.marat,idm_char); else idm_param(idmrun,"$6",save_marat,idm_char); end if; if access_kn1.marea /= save_marea and access_kn1.marea /= " " then idm_param(idmrun,"$7",access_kn1.marea,idm_char); else idm_param(idmrun,"$7",save_marea,idm_char); end if; if working_chdat /= save_chdat and working_chdat(3..8) /= " " then idm_param(idmrun,"$8",working_chdat,idm_char); else idm_param(idmrun,"$8",save_chdat,idm_char); end if; if access_kn1.fmart = "#" or working_fcdat(3..8) = "# " then idm_param(idmrun,"$9"," ",idm_char); idm_param(idmrun,"$10"," ",idm_char); else if access_kn1.fmart /= save_fmart and access_kn1.fmart /= " " then idm_param(idmrun,"$9",access_kn1.fmart,idm_char); else idm_param(idmrun,"$9",save_fmart,idm_char); end if; if working_fcdat /= save_fcdat and working_fcdat(3..8) /= " " then idm_param(idmrun,"$10",working_fcdat,idm_char); else idm_param(idmrun,"$10",save_fcdat,idm_char); end if; end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_kn1; --********************************************************************* --* --* PROCESS_CARD_TF1 --* --* This procedure will process the message cards of type 'TF1'. --* The record containing the card data is retrieved from the list, --* and the card is processed as a function of the transaction --* code. --* --********************************************************************* procedure process_card_tf1 is save_meqs : string(1..1); save_sedy : string(1..1); save_tedy : string(1..1); save_erddy : string(1..8); save_avail : string(1..1); save_eqret : string(1..8); save_geogr : string(1..4); save_operl : string(1..8); save_dafld : string(1..4); save_dcndy : string(1..5); working_erddy : string(1..8) := "19000000"; working_eqret : string(1..8) := "19000000"; working_operl : string(1..8) := "19000000"; begin access_tf1 := list_item.access_tf1; if list_item.Trtype = CHANGE then idm_command(idmrun,"return_card_tf1 $1 $2 $3"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_tf1.ueqpt,idm_char); idm_param(idmrun,"$3",access_tf1.mesen,idm_char); idm_execute(idmrun); idm_fetch(idmrun); idm_column(idmrun,1,save_secur,length_of_string); idm_column(idmrun,2,save_date,length_of_string); idm_column(idmrun,3,save_meqs,length_of_string); idm_column(idmrun,4,save_sedy,length_of_string); idm_column(idmrun,5,save_tedy,length_of_string); idm_column(idmrun,6,save_erddy,length_of_string); idm_column(idmrun,7,save_avail,length_of_string); idm_column(idmrun,8,save_eqret,length_of_string); idm_column(idmrun,9,save_geogr,length_of_string); idm_column(idmrun,10,save_operl,length_of_string); idm_column(idmrun,11,save_dafld,length_of_string); idm_column(idmrun,12,save_dcndy,length_of_string); end if; if list_item.Trtype /= ADD then idm_command(idmrun,"delete_card_tf1 $1 $2 $3"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$2",access_tf1.ueqpt,idm_char); idm_param(idmrun,"$3",access_tf1.mesen,idm_char); idm_execute(idmrun); idm_fetch(idmrun); end if; if list_item.Trtype /= DELETE then idm_command(idmrun,"add_card_tf1 $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 " & "$11 $12 $13 $14 $15 $16"); idm_param(idmrun,"$1",list_item.uic,idm_char); idm_param(idmrun,"$4",system_date,idm_char); idm_param(idmrun,"$5",access_tf1.ueqpt,idm_char); idm_param(idmrun,"$6",access_tf1.mesen,idm_char); working_secur := secur_types'image(list_item.secur); working_erddy(3..8) := access_tf1.erddy.yy & access_tf1.erddy.mm & access_tf1.erddy.dd; working_eqret(3..8) := access_tf1.eqret.yy & access_tf1.eqret.mm & access_tf1.eqret.dd; working_operl(3..8) := access_tf1.operl.yy & access_tf1.operl.mm & access_tf1.operl.dd; if list_item.Trtype /= CHANGE then idm_param(idmrun,"$2",working_secur,idm_char); idm_param(idmrun,"$3",report_as_of_time,idm_char); idm_param(idmrun,"$7",access_tf1.meqs,idm_char); idm_param(idmrun,"$8",access_tf1.sedy,idm_char); idm_param(idmrun,"$9",access_tf1.tedy,idm_char); idm_param(idmrun,"$10",working_erddy,idm_char); idm_param(idmrun,"$11",access_tf1.avail,idm_char); idm_param(idmrun,"$12",working_eqret,idm_char); idm_param(idmrun,"$13",access_tf1.geogr,idm_char); idm_param(idmrun,"$14",working_operl,idm_char); idm_param(idmrun,"$15",access_tf1.dafld,idm_char); idm_param(idmrun,"$16",access_tf1.dcndy,idm_char); else if working_secur /= save_secur then idm_param(idmrun,"$2",working_secur,idm_char); else idm_param(idmrun,"$2",save_secur,idm_char); end if; if report_as_of_time /= save_date then idm_param(idmrun,"$3",report_as_of_time,idm_char); else idm_param(idmrun,"$3",save_date,idm_char); end if; if access_tf1.meqs /= save_meqs and access_tf1.meqs /= " " then idm_param(idmrun,"$7",access_tf1.meqs,idm_char); else idm_param(idmrun,"$7",save_meqs,idm_char); end if; if access_tf1.sedy /= save_sedy and access_tf1.sedy /= " " then idm_param(idmrun,"$8",access_tf1.sedy,idm_char); else idm_param(idmrun,"$8",save_sedy,idm_char); end if; if access_tf1.tedy /= save_tedy and access_tf1.tedy /= " " then idm_param(idmrun,"$9",access_tf1.tedy,idm_char); else idm_param(idmrun,"$9",save_tedy,idm_char); end if; if working_erddy /= save_erddy and working_erddy(3..8) /= " " then idm_param(idmrun,"$10",working_erddy,idm_char); else idm_param(idmrun,"$10",save_erddy,idm_char); end if; if access_tf1.avail /= save_avail and access_tf1.avail /= " " then idm_param(idmrun,"$11",access_tf1.avail,idm_char); else idm_param(idmrun,"$11",save_avail,idm_char); end if; if working_eqret(3..8) = "# " then idm_param(idmrun,"$12"," ",idm_char); elsif working_eqret /= save_eqret and working_eqret(3..8) /= " " then idm_param(idmrun,"$12",working_eqret,idm_char); else idm_param(idmrun,"$12",save_eqret,idm_char); end if; if access_tf1.geogr = "# " then idm_param(idmrun,"$13"," ",idm_char); elsif access_tf1.geogr /= save_geogr and access_tf1.geogr /= " " then idm_param(idmrun,"$13",access_tf1.geogr,idm_char); else idm_param(idmrun,"$13",save_geogr,idm_char); end if; if working_operl /= save_operl and working_operl(3..8) /= " " then idm_param(idmrun,"$14",working_operl,idm_char); else idm_param(idmrun,"$14",save_operl,idm_char); end if; if access_tf1.dafld = "# " then idm_param(idmrun,"$15"," ",idm_char); elsif access_tf1.dafld /= save_dafld and access_tf1.dafld /= " " then idm_param(idmrun,"$15",access_tf1.dafld,idm_char); else idm_param(idmrun,"$15",save_dafld,idm_char); end if; if access_tf1.dcndy /= save_dcndy and access_tf1.dcndy /= " " then idm_param(idmrun,"$16",access_tf1.dcndy,idm_char); else idm_param(idmrun,"$16",save_dcndy,idm_char); end if; end if; idm_execute(idmrun); idm_fetch(idmrun); end if; end process_card_tf1; --********************************************************************* --* --* GET_AND_STORE_SYSTEM_DATE --* --* This procedure will get the system date and store in --* system_date a variable defined as a string of 8 characters --* --********************************************************************* procedure get_and_store_system_date is begin system_time := clock; system_year := year(system_time); system_month := month(system_time); system_day := day(system_time); system_date := "00000000"; working_string(1..5) := integer'image(system_year); system_date(1..4) := working_string(2..5); if system_month < 10 then working_string(1..2) := integer'image(system_month); system_date(6..6) := working_string(2..2); else working_string(1..3) := integer'image(system_month); system_date(5..6) := working_string(2..3); end if; if system_day < 10 then working_string(1..2) := integer'image(system_day); system_date(8..8) := working_string(2..2); else working_string(1..3) := integer'image(system_day); system_date(7..8) := working_string(2..3); end if; end get_and_store_system_date; end Database_Build; --:::::::::: --modcoms.src --:::::::::: --********************************************************************** -- -- -- M O D U L E C O M M U N I C A T I O N S -- -- --********************************************************************* with System_Utilities, Man_Machine_Interface, text_io; with Message_Input_Module, Message_Validation_Module; with Database_Build; use System_Utilities, text_io; package Module_Communications is task MMI_Monitor; task MI_Monitor; task MV_Monitor; task DBB_Monitor; end Module_Communications; package body Module_Communications is --********************************************************************** -- MMI_MONITOR -- -- This routine is the task monitoring the task packet queue for the -- MMI module. It will pick the oldest task packet from the queue of -- packets designated for the MMI module. It will call the MMI module -- with that packet at a rendezvous then update the queue pointers. --********************************************************************** task body MMI_Monitor is P : Packet_Access; begin loop if MMI_Queue.Count > 0 then P:= MMI_Queue.First; if P = MMI_Queue.Last then MMI_Queue.First:= null; MMI_Queue.Last:= null; MMI_Queue.Count:= 0; else MMI_Queue.First:= P.Next; MMI_Queue.Count:= MMI_Queue.Count-1; end if; Man_Machine_Interface.MMI_Packet_Path.Packet_Process(P); end if; end loop; exception when others => put_line("mmi monitor dead"); end MMI_Monitor; --********************************************************************** -- MI_MONITOR -- -- This routine is the task monitoring the task packet queue for the MI -- module. It will pick the oldest task packet from the queue of -- packet designated for the MI module. It will call the MI module -- with that packet at a rendezvous then update the queue pointers. --********************************************************************** task body MI_Monitor is P : packet_access; begin loop if MI_Queue.Count > 0 then P:= MI_Queue.First; if P = MI_Queue.Last then MI_Queue.First:= null; MI_Queue.Last:= null; MI_Queue.Count:= 0; else MI_Queue.First:= P.Next; MI_Queue.Count:= MI_Queue.Count-1; end if; Message_Input_Module.Message_Request.Request_Function(P); end if; end loop; exception when others => put_line("mi monitor dead"); end MI_Monitor; --********************************************************************** -- MV_MONITOR -- -- This routine is the task monitoring the task packet queue for the MV -- module. It will pick the oldest task packet from the queue of -- packets designated for the MV module. It will call the MV module -- with that packet at a rendezvous then update the queue pointers. --********************************************************************** task body MV_Monitor is P : packet_access; begin loop if MV_Queue.Count > 0 then P:= MV_Queue.First; if P = MV_Queue.Last then MV_Queue.First:= null; MV_Queue.Last:= null; MV_Queue.Count:= 0; else MV_Queue.First:= P.Next; MV_Queue.Count:= MV_Queue.Count-1; end if; Message_Validation_Module.Message_Receive.Receive_Function(P); end if; end loop; exception when others => put_line("mv monitor dead"); end MV_Monitor; --********************************************************************** -- DBB_MONITOR -- -- This routine is the task monitoring the task packet queue for the -- DBB module. It will pick the oldest task packet from the queue of -- packets designated for the DBB module. It will call the DBB module -- with that packet at a rendezvous then update the queue pointers. --********************************************************************** task body DBB_Monitor is P : packet_access; begin loop if DBB_Queue.Count > 0 then P:= DBB_Queue.First; if P = DBB_Queue.Last then DBB_Queue.First:= null; DBB_Queue.Last:= null; DBB_Queue.Count:= 0; else DBB_Queue.First:= P.Next; DBB_Queue.Count:= DBB_Queue.Count-1; end if; Database_Build.Database_Build_Task.Rendezvous_Point(P); end if; end loop; exception when others => put_line("dbb monitor dead"); end DBB_Monitor; begin null; exception when others => put_line("module communications dead"); end Module_Communications; --:::::::::: --main.src --:::::::::: with text_io; with Module_communications; procedure main is begin loop null; end loop; exception when others => text_io.put_line("Main dead"); end main;