Subroutine and Dictionary for: Flags, Reason Codes & Descriptions for Specific Account

spraytownspeakerΤεχνίτη Νοημοσύνη και Ρομποτική

16 Οκτ 2013 (πριν από 4 χρόνια και 28 μέρες)

81 εμφανίσεις

Subroutine and Dictionary for
:

Flags, Reason Codes & Descriptions for Specific Account


All items are loaded at the Real TCL prompt, not XTCL if using MESA. If you
are not able to get to Real TCL, please contact me and I will give you some
assistance.


Th
e subroutine listed below is stored in a directory called SUBR.BP for no
other reason than this is what I decided to call it. If I have performed work
for your CU in the past and have loaded a subroutine, it would have been loaded
in this file. To determ
ine if this file exists, type LIST SUBR.BP and if items
list, you will not have to create the file as in step 1.


Follow each step below by using a copy/paste from this document to your Telnet
session.


1.

At TCL, type
CREATE
-
FILE DIR SUBR.BP


2.

After the file
is created, type
AE SUBR.BP
FLAGS.REASON


3.

Assuming this name has not been used, the screen will display:




Top of New “FLAGS.REASON” in “SUBR.BP”


4.

Type
I

for insert to get to line 001= and then copy/paste the following
lines:


SUBROUTINE FLAGS.REASON(RESU
LT, ACCOUNT)

MAIN:


RESULT = ""


CLIENT = ""


ACCTLEV = ""


ACCTNBR = ""


ACCTLEN = LEN(ACCOUNT)


REC = 0


FOR IDX = 1 TO ACCTLEN


CHAR = SUBSTRINGS(ACCOUNT, IDX, 1)


IF CHAR = "S" OR CHAR = "I" OR CHAR = "L" THEN



REC = 1


END


IF

CHAR = "." THEN


REC = 2


END


IF REC = 0 THEN



CLIENT = CLIENT : CHAR


END


IF REC = 1 THEN



ACCTNBR = ACCTNBR : CHAR



ACCTLEV = ACCTLEV : CHAR


END


IF REC = 2 THEN



ACCTNBR = ACCTNBR : CHAR


END


NEXT IDX


OPEN "", "IC.CONTROL" TO F_CONTROL ELSE GO ERR


READV IRADATA FROM F_CONTROL, ACCTLEV : "*", 7 ELSE GO DONE


CLOSE F_CONTROL


IF IRADATA = "1" OR IRADATA = "2" OR IRADATA = "7" THEN


IRA = 1


END ELSE


IRA = 0


END


OPEN "", "FLAG" TO F_FLAG

ELSE GO ERR


READV FLAGS FROM F_FLAG, CLIENT, 1 ELSE GO DONE


READV STATUS FROM F_FLAG, CLIENT, 2 ELSE GO ERR


READV EXPIRES FROM F_FLAG, CLIENT, 6 ELSE GO ERR


READV CODES FROM F_FLAG, CLIENT, 7 ELSE GO ERR


READV ACCOUNTS FROM F_FLAG, CLIENT, 8 ELS
E GO ERR


CLOSE F_FLAG


CLEV = FIELD(FIELD(ACCOUNTS, @VM, 1), @SVM, 1)


ACCOUNTCOUNT = DCOUNT(FLAGS, @VM)


FOR IDX = 1 TO ACCOUNTCOUNT


GOTFLAG = 0


ACCT = FIELD(ACCOUNTS, @VM, IDX)


IF (IRA = 0 AND CLEV = "C") OR ACCT = ACCTNBR THEN



STA
T = FIELD(STATUS, @VM, IDX)



IF STAT = "A" THEN



EXPIRE = FIELD(EXPIRES, @VM, IDX)



IF EXPIRE = "" OR EXPIRE >= @DATE THEN



FLAG = FIELD(FLAGS, @VM, IDX)



ACCCODES = FIELD(CODES, @VM, IDX)



GOTFLAG = 1



END



END


END


IF GOTFLAG = 1 THEN


CODECOUNT = DCOUNT(ACCCODES, @SVM)


IF CODECOUNT = 0 THEN


ACCCODES = FIELD(CODES, @VM, 1)


CODECOUNT = DCOUNT(ACCCODES, @SVM)


IF CODECOUNT = 0 THEN


CODECOUNT = 1



ACCCODES = "X"


END


END


FLAGPRINTED = 0


FOR CIDX = 1 TO CODECOUNT


IF RESULT <> "" THEN


RESULT = RESULT : @VM


END


CODE = FIELD(ACCCODES, @SVM, CIDX)


IF CODE = "X" THEN


CODE
= ""


REASON = ""


END ELSE


OPEN "", "IC.CONTROL" TO F_CONTROL ELSE GO ERR


READV REASON FROM F_CONTROL, "FLAG.REASON", CODE ELSE GO ERR


CLOSE F_CONTROL


END


CALL SUBR.PADOUT(CODE, 2, " ", "R")



CALL SUBR.PADOUT(REASON, 20, " ", "L")


IF FLAGPRINTED = 0 THEN


CALL SUBR.PADOUT(FLAG, 2, " ", "R")


RESULT = RESULT : FLAG


FLAGPRINTED = 1


END ELSE


RESULT = RESULT : " "


END


RESUL
T = RESULT : " " : CODE : " " : REASON


NEXT CIDX


END


NEXT IDX


GO DONE

ERR:


RESULT = "E"

DONE:


RETURN


5.

When the copy is complete, hit
RETURN

to get to the prompt line *
--
: and
type
FI

to file item


6.

At TCL, type
BASIC SUBR.BP
FLAGS.REASON

t
o compile the subroutine


7.

At TCL, type
CATALOG SUBR.BP
FLAGS.REASON

LOCAL

to catalog the
subroutine


8.

At TCL,
AE SUBR.BP
SUBR.PADOUT


9.

Assuming this name has not been used, the screen will display:




Top of New “SUBR.PADOUT” in “SUBR.BP”


10.

Type
I

for inser
t to get to line 001= and then copy/paste the following
lines:


SUBROUTINE SUBR.PADOUT(STRING, SPACE, PAD_CHAR, DIRECTION)


LEN = LEN(STRING) + 1


IF LEN > SPACE THEN RETURN


OUTPUT = STRING


FOR COUNTER = LEN TO SPACE


IF DIRECTION = "L" THEN OUTPU
T = OUTPUT:PAD_CHAR


IF DIRECTION = "R" THEN OUTPUT = PAD_CHAR:OUTPUT


NEXT COUNTER


STRING = OUTPUT


RETURN

END


11.

When the copy is complete, hit
RETURN

to get to the prompt line *
--
: and
type
FI

to file item


12.

At TCL, type
BASIC SUBR.BP
SUBR.PADOUT

to

compile the subroutine


13.

At TCL, type
CATALOG SUBR.BP
SUBR.PADOUT

LOCAL

to catalog the
subroutine. This subroutine is called by the subroutine FLAGS.REASON
and is used to format the output designated from that subroutine.



14.

Create the following dictiona
ry at Real TCL:


AE DICT ACCOUNT FLAGS.REASON


I

SUBR('FLAGS.REASON', @ID)

(hit the space bar for a blank space on line 003)

FLAG, REASON CODE & DESC

26R

M