Writing a fresh cobol program from a SAS job

nithinlenin · New User Joined: 06 Feb 2007 Posts: 19 Location: Hyderabad

can anyone help me in writing a fresh cobol program from a SAS job.
iam not having any knowledge on SAS jobs ..

am attaching the sas job

nithinlenin · New User Joined: 06 Feb 2007 Posts: 19 Location: Hyderabad

sorry ..
here is the sas job attached

*********************************************************************;
* PROGRAM: R1BSA81
* LANGUAGE: SAS
* *
* PURPOSE: THIS PROGRAM WILL VALIDATE THE SA-RMS DETAIL CONTROL
* FILE FROM SALES AUDIT AGAINST THE SA-RMS STORE CONTROL
* FILE FROM SALES AUDIT. IT WILL ALSO CREATE A REGISTER
* SUMMARY FILE FROM THE SA-RMS DETAIL CONTROL FILE.
* OUTPUT FILES WILL BE TRANSFERED TO THE UNIX AND
* COMPARED TO THE DATA IN THE RMS SALES TABLES.
*********************************************************************;
*

*************************************************************;
* READ THE SA-RMS DETAIL ITEM CONTROL FILE.
* VALIDATE:
* 1. BALANCING DATE ON FDETL MATCHES FHEAD
* 2. DETAIL COUNT ON FTAIL MATCHES ACTUAL FDETL COUNT
*
* ADD THESE FIELDS TO THE RECORD:
* 1. SALES SIGN
* 2. SALES TRAN ID
* 3. SALES ITEM ID
*************************************************************;
DATA DTL DTLHEAD DTLERR;
INFILE INDTL END=DONE;

ERR=0;
ERRMSG='----+----1----+----2----+----3----+----4----+';
TITLE1 'R1SA81 SA-RMS SALES INTERFACE AUDITS & CONTROLS';

INPUT @1 RECTYP $CHAR5.
@6 SEQ 10.
@;

IF RECTYP = 'FHEAD' THEN DO;
INPUT @16 FILEID $CHAR4.
@20 HBALDATE $CHAR8.
@28 RUNDATE $CHAR8.
@1 INREC $CHAR135.
;
RETAIN HBALDATE;
FILE OTDTL;
PUT @1 INREC;
OUTPUT DTLHEAD;
END;

IF RECTYP = 'FDETL' THEN DO;
FDETLCNT+1;
INPUT @16 BALDATE $CHAR8.
@24 STORE $CHAR4.
@28 DOLSIGN $CHAR1.
@28 DOL 21.4
@49 QTYSIGN $CHAR1.
@49 QTY 13.4
@62 TRANDATE $CHAR8.
@70 REGID $CHAR4.
@74 TRANNO $CHAR4.
@78 VERNO $CHAR4.
@82 REV $CHAR1.
@83 ITEMSEQ $CHAR4.
@87 TRANTYPE $CHAR1.
@88 DEPT $CHAR4.
@92 CLASS $CHAR4.
@96 SUBCL $CHAR4.
@100 SKU $CHAR8.
@108 UPC $CHAR13.
@121 SATYPE $CHAR4.
@125 SASTAT $CHAR1.
@126 VOIDREG $CHAR4.
@130 VOIDTRAN $CHAR4.
@134 SERVTYPE $CHAR2.
@1 INREC $CHAR135.
;

*************************************************************;
* BUILD KEYS
*************************************************************;
IF REV = 'N' THEN REV1 = '0';
ELSE REV1 = '1';

TRANID=TRANDATE||STORE||REGID||TRANNO||VERNO||REV1;
ITEMID=TRANID ||ITEMSEQ;

*************************************************************;
* VALIDATIONS
*************************************************************;
IF REV = 'Y' OR
SATYPE = 'VOID' THEN SALESIGN = 'N';
ELSE SALESIGN = 'P';

IF ((TRANTYPE = 'S' AND SALESIGN = 'P') OR
(TRANTYPE = 'R' AND SALESIGN = 'N')) AND
((DOLSIGN = '-' OR QTYSIGN = '-')) THEN DO;
ERR=6;
ERRMSG="'-' SIGN INCONSISTENT WITH TYPE "||
TRANTYPE||'/'||SALESIGN;
DOLSIGN = '+';
DOL = ABS(DOL);
QTYSIGN = '+';
QTY = ABS(QTY);
OUTPUT DTLERR;
END;

IF ((TRANTYPE = 'S' AND SALESIGN = 'N') OR
(TRANTYPE = 'R' AND SALESIGN = 'P')) AND
((DOLSIGN = '+' OR QTYSIGN = '+')) THEN DO;
ERR=6;
ERRMSG="'+' SIGN INCONSISTENT WITH TYPE "||
TRANTYPE||'/'||SALESIGN;
DOLSIGN = '-';
DOL = ABS(DOL) * -1;
QTYSIGN = '-';
QTY = ABS(QTY) * -1;
OUTPUT DTLERR;
END;

IF BALDATE NE HBALDATE THEN DO;
ERR=8;
ERRMSG='FHEAD DATE '||HBALDATE||' <> FDETL';
OUTPUT DTLERR;
END;

*************************************************************;
* WRITE DETAIL OUTPUT
*************************************************************;
OUTPUT DTL;

FILE OTDTL;
PUT @1 INREC $CHAR135.
@28 DOLSIGN $CHAR1.
@49 QTYSIGN $CHAR1.
@136 SALESIGN $CHAR1.
@137 ITEMID $CHAR29. ;

END;

******************************************************************;
IF RECTYP = 'FTAIL' THEN DO;
INPUT @16 FTAILCNT 10.
@1 INREC $CHAR135.
;
RETAIN FTAILCNT;
FILE OTDTL;
PUT @1 INREC
@16 FDETLCNT Z10.;
END;

IF DONE THEN DO;
IF FTAILCNT NE FDETLCNT THEN DO;
ERR=7;
ERRMSG='FTAIL COUNT '||TRIM(LEFT(PUT(FTAILCNT,10.)))||
' <> FDETL '||TRIM(LEFT(PUT(FDETLCNT,10.)));
OUTPUT DTLERR;
END;
END;
RUN;
*******************************************************************;
* PRINT ANY DETAIL CONTROL ERRORS
*******************************************************************;
PROC SORT DATA=DTLERR;
BY ERRMSG STORE;

PROC PRINT UNIFORM NOOBS LABEL SPLIT='/' DATA=DTLERR;
BY ERRMSG;
ID ERRMSG;
VAR RECTYP SEQ BALDATE ITEMID TRANTYPE SALESIGN REV SATYPE
SASTAT DOL QTY;

TITLE2 'DETAIL CONTROL VALIDATION';
LABEL BALDATE ='FDETL/BAL/DATE'
RECTYP ='RECORD/TYPE'
SEQ ='REC/SEQ'
ITEMID ='SALES ITEM ID'
ERRMSG ='ERROR MESSAGE'
TRANTYPE ='TRN/TYP'
SATYPE ='LONG/TYPE'
REV ='REV'
SASTAT ='STAT'
SALESIGN ='NEG/POS'
DOL ='RTL'
QTY ='QTY'
;
RUN;
*************************************************************;
* CREATE THE REGISTER SUMMARY CONTROL FILE
*************************************************************;
PROC SORT DATA=DTL;
BY BALDATE TRANDATE STORE REGID TRANTYPE SALESIGN;

DATA _NULL_;
SET DTL;
BY BALDATE TRANDATE STORE REGID TRANTYPE SALESIGN;

IF FIRST.SALESIGN THEN DO;
R_DOL = 0;
R_QTY = 0;
R_CNT = 0;
END;

RETAIN R_DOL R_QTY R_CNT;

R_DOL = R_DOL + ABS(DOL * 10000);
R_QTY = R_QTY + ABS(QTY * 10000);
R_CNT + 1;

IF LAST.SALESIGN THEN DO;
FILE OTREG;
PUT @1 BALDATE $CHAR8.
@9 TRANDATE $CHAR8.
@17 STORE $CHAR4.
@21 REGID $CHAR4.
@25 TRANTYPE $CHAR1.
@26 SALESIGN $CHAR1.
@27 R_CNT Z8.
@35 R_QTY Z12.
@47 R_DOL Z20.
;
END;
RUN;
*************************************************************;
* VALIDATE THE DETAIL FILE AGAINST THE STORE CONTROL FILE
*************************************************************;

*************************************************************;
* SUMMARIZE THE SA-RMS DETAIL CONTROL FILE BY
* BALANCING DATE AND STORE.
*************************************************************;
PROC SORT DATA=DTL;
BY BALDATE STORE;

DATA DTLSTR;
SET DTL;
BY BALDATE STORE;
IF FIRST.STORE THEN DO;
D_DOL =0;
D_QTY =0;
D_CNT =0;
END;

D_DOL =D_DOL + DOL;
D_QTY =D_QTY + QTY;
D_CNT+1;

RETAIN D_DOL D_QTY D_CNT;
KEEP BALDATE STORE D_DOL D_QTY D_CNT;

IF LAST.STORE THEN OUTPUT;
RUN;
*************************************************************;
* READ THE SA-RMS STORE CONTROL FILE BY AND SORT BY
* BALANCING DATE AND STORE
*************************************************************;
DATA STR STRHEAD STRERR;
INFILE INSTR END=DONE;

INPUT @1 RECTYP $CHAR5.
@6 SEQ 10.
@;

IF RECTYP EQ 'FHEAD' THEN DO;
INPUT @20 HBALDATE $CHAR8.;
RETAIN HBALDATE;
OUTPUT STRHEAD;
END;

IF RECTYP EQ 'FDETL' THEN DO;
FDETLCNT+1;
INPUT @16 BALDATE $CHAR8.
@24 STORE $CHAR4.
@28 T_DOL 21.4
@49 T_QTY 13.4
;
OUTPUT STR;
IF BALDATE NE HBALDATE THEN DO;
ERR=9;
ERRMSG='FHEAD DATE '||HBALDATE||' <> FDETL';
OUTPUT STRERR;
END;
END;

IF RECTYP = 'FTAIL' THEN DO;
INPUT @16 FTAILCNT 10.;
RETAIN FTAILCNT;
END;

IF DONE THEN DO;
IF FTAILCNT NE FDETLCNT THEN DO;
ERR=10;
ERRMSG='FTAIL COUNT '||TRIM(LEFT(PUT(FTAILCNT,10.)))||
' <> FDETL '||TRIM(LEFT(PUT(FDETLCNT,10.)));
OUTPUT STRERR;
END;
END;
RUN;
*******************************************************************;
* PRINT ANY STORE CONTROL ERRORS
*******************************************************************;
PROC SORT DATA=STRERR;
BY ERRMSG STORE;

PROC PRINT UNIFORM NOOBS LABEL SPLIT='/' DATA=STRERR;
BY ERRMSG;
ID ERRMSG;
VAR SEQ STORE BALDATE;

TITLE2 'STORE CONTROL VALIDATION';
LABEL BALDATE ='FDETL/BALANCING/DATE'
STORE ='STORE'
SEQ ='RECORD/SEQUENCE'
ERRMSG ='ERROR MESSAGE'
;
RUN;

*************************************************************;
PROC SORT DATA=STR;
BY BALDATE STORE;
RUN;
*************************************************************;
* VALIDATE THE DETAIL AGAINST THE STORE CONTROL FILE
* 1) MERGE THE TOTALS FROM BOTH SOURCES AND COMPARE
* 2) PRINT THE DIFFERENCES
*************************************************************;
DATA MRG;
MERGE DTLSTR (IN=INDTL)
STR (IN=INSTR);
BY BALDATE STORE;

IF T_DOL = . THEN T_DOL = 0;
IF D_DOL = . THEN D_DOL = 0;
IF T_QTY = . THEN T_QTY = 0;
IF D_QTY = . THEN D_QTY = 0;
IF D_CNT = . THEN D_CNT = 0;

ERR=0;

X_DOL = ROUND(D_DOL,.01) - ROUND(T_DOL,.01);
X_QTY = ROUND(D_QTY,.01) - ROUND(T_QTY,.01);

IF ABS(X_DOL) NE 0 THEN ERR=3;
IF ABS(X_QTY) NE 0 THEN ERR=4;

IF (ABS(X_DOL) NE 0) AND
(ABS(X_QTY) NE 0) THEN ERR=5;

IF INDTL AND NOT INSTR THEN ERR=1;
IF INSTR AND NOT INDTL THEN ERR=2;

IF ERR=0 THEN ERRMSG='NO DIFFERENCES ';
IF ERR=1 THEN ERRMSG='MISSING FROM STORE CONTROL ';
IF ERR=2 THEN ERRMSG='MISSING FROM DETAIL CONTROL';
IF ERR=3 THEN ERRMSG='DOLLARS ARE DIFFERENT ';
IF ERR=4 THEN ERRMSG='UNITS ARE DIFFERENT ';
IF ERR=5 THEN ERRMSG='UNITS/DOLLARS ARE DIFFERENT';

PROC SORT DATA=MRG;
BY ERRMSG BALDATE STORE;

PROC PRINT UNIFORM NOOBS LABEL SPLIT='/' DATA=MRG;
BY ERRMSG;
ID ERRMSG;
VAR BALDATE STORE
D_CNT
T_DOL D_DOL X_DOL
T_QTY D_QTY X_QTY;

TITLE2 'STORE CONTROL / DETAIL CONTROL VALIDATION';
LABEL BALDATE ='BALANCING/DATE'
STORE ='STORE'
D_CNT ='DETAIL/CONTROL/COUNT'
T_DOL ='STORE/CONTROL/DOLLARS'
D_DOL ='DETAIL/CONTROL/DOLLARS'
X_DOL ='DIFF/DOLLARS'
T_QTY ='STORE/CONTROL/UNITS'
D_QTY ='STORE/CONTROL/UNITS'
X_QTY ='DIFF/UNITS'
ERRMSG ='ERROR MESSAGE'
;

FORMAT T_DOL D_DOL X_DOL COMMA13.2
D_CNT
T_QTY D_QTY X_QTY COMMA10.;
RUN;
*************************************************************;
* VALIDATE THE STORE HEADER AGAINST THE DETAIL HEADER
*************************************************************;
DATA _NULL_;
MERGE STRHEAD (IN=INSTR)
DTLHEAD (IN=INDTL);
BY HBALDATE;

PUT HBALDATE= INSTR= INDTL= ;

IF INSTR AND INDTL THEN
DELETE;
ELSE DO;
FILE PRINT;
PUT '*********** FATAL ERROR ****************';
PUT '* INCONSISTENT BALANCING DATES BETWEEN ';
PUT '* STORE AND DETAIL CONTROL FILES.';
PUT '****************************************';
ABORT 255;
END;
RUN;
*******************************************************************;
* CHECK IF THERE WERE ANY NON-FATAL ERRORS DETECTED
* IF SO, ABORT WITH A NON-FATAL RETURN CODE
*******************************************************************;
DATA _NULL_;
SET DTLERR STRERR MRG;
WHERE ERR NOT IN (.,0);
ABORT 1;
RUN;

Phrzby Phil · Posted: Wed Jun 13, 2007 5:34 pm

This will be fairly non-trivial. If you have the original specs or can work them out with the user, I suggest rewriting in COBOL from them. A straightword rewrite does not seem clean.

Among the interesting SAS features used (I'm sure I've missed a few):

1. Multiple steps, passing internal SAS datasets
2. SAS sets the end-of-file var (e.g., DONE) when on the last observation (record), rather then when after
3. SAS has the concept of a missing value and your program tests for that here; e.g., if T_DOL = .
4. Your program has an internal SORT step
5. Your program has a read that holds the current record for re-read; e.g.:

INPUT @1 RECTYP $CHAR5.
@6 SEQ 10.
@;

IF RECTYP EQ 'FHEAD' THEN DO;
INPUT @20 HBALDATE $CHAR8.;

6. The PROC PRINT must be replaced by a simple report program
7. The MERGE statement is a high level parallel pass record matching by key command:

MERGE STRHEAD (IN=INSTR)
DTLHEAD (IN=INDTL);
BY HBALDATE

8. Your program uses SAS constructs that indicate when you are on the FIRST or LAST record of a group sorted by your key:

SET DTL;
BY BALDATE TRANDATE STORE REGID TRANTYPE SALESIGN;

IF FIRST.SALESIGN THEN DO;

=========================

IF LAST.STORE THEN OUTPUT;

=========================

nithinlenin · New User Joined: 06 Feb 2007 Posts: 19 Location: Hyderabad

Hi
thanks for the reply and again sorry for the PM

i don't think i ccan get a prog spec at this stage.. is there no way out.

also iam supposed to get the output of the internal sort step and then write it into a new dataset.. how can i acheive that

thanks and regards

dick scherrer · Posted: Wed Jun 13, 2007 10:27 pm

Hello,

A few times in the past, when source code had mysteriously disappeared, i've had clients ask if i could/would replace their missing source for them.

What worked for me a few times is to look at the inputs and the outputs and create specs/code from there. After getting the initial testing to be successful, being able to run several "sets" of previous production input is a good thing. The biggest danger is that there was some condition in the missing code for which there is only rarely data in the input - so missing something or having incorrect code is possible. You have the advantage that you do have source even though it is not in "your" coding language.

You might also make copies of the sas code and the inputs and experiment with a change here and there in the sas code to see what happens. Hopefully, this is not something needed "yesterday".