<![CDATA[
Typical DCL Command Procedure to run the program :
$!
$! THIS COMMAND PROCEDURE RUNS THE PROCESS THAT SENDS OUT
$! REMINDERS FOR REQUISITION APPROVALS.
$!
$ DELETE/LOG FR$FEX:*.FTM;*
$ DELETE/LOG FR$FEX:*.MAS;*
$ DELETE/LOG FR$FEX:PLAY.PRT;*
$ DELETE/LOG FR$FEX:PLAY.LIS;*
$!
$ DEFINE FOC$DIR1 FR$DATA
$ DEFINE FOC$DIR2 FR$FEX,FR$MFD
$!
$ COPY/LOG FR$FEX:ZBA110.MFD; FR$FEX:*.MAS;
$!
$! RUN ZBA110 TO RETRIEVE VMS USERNAME DATA.
$!
$ ASSIGN/USER_MODE ZS$DATA:ZCFILE.DAT ZCFILE
$ ASSIGN/USER_MODE ZS$DATA:NAMEFL.DAT NAMEFL
$ ASSIGN/USER_MODE SYS$INPUT: CARDFL
$ RUN ZS$EXE:ZBA110
PGM=ZBA110,DATE=TODAY,SYSTEM=002,ACCESS-LIST=Y,BRIEF=Y,SELECT-BY=OPERID
$!
$! RUN FOCUS PROGRAM TO RETRIEVE UNAPPROVED REQUISITIONS.
$!
$ SET DEFAULT FR$FEX
$ FOCUS
EXEC (file name)
FIN
$!
$! CREATE AND E-MAIL OUT REMINDERS FOR REQUISITION APPROVALS.
$!
$ OPEN/READ input_file FR$FEX:PLAY.FTM
$ READ/END=END_FILE_A input_file in_record
$!
$ EMAIL_ID_MAIN = F$EDIT(F$EXTRACT(0,23,in_record),"TRIM")
$ CLOSE input_file
$ OPEN/READ input_file FR$FEX:PLAY.FTM
$ GOSUB DO_RPT_HEAD
$!
$READ_FILE_A:
$!
$ READ/END=END_FILE_A input_file in_record
$!
$ REQ_NUM = F$EXTRACT(23,7,in_record)
$ REQ_YR = F$EXTRACT(30,4,in_record)
$ REQ_MON = F$EXTRACT(34,2,in_record)
$ REQ_DAY = F$EXTRACT(36,2,in_record)
$!
$ VEN_NAME = F$EXTRACT(38,30,in_record)
$ VEN_NUM = F$EXTRACT(68,11,in_record)
$ REQ_AMT = F$EXTRACT(79,13,in_record)
$!
$ EMAIL_ID_CHK = F$EDIT(F$EXTRACT(0,23,in_record),"TRIM")
$ IF EMAIL_ID_MAIN .NES. EMAIL_ID_CHK
$ THEN
$ CLOSE output_file
$ GOSUB MAIL_PRT
$ GOSUB MAIL_COPY
$ GOSUB DO_RPT_HEAD
$ EMAIL_ID_MAIN = F$EDIT(F$EXTRACT(0,23,in_record),"TRIM")
$ ENDIF
$!
$ WRITE output_file REQ_NUM + " " + REQ_MON + "/" + REQ_DAY + "/" + REQ_YR + " " + VEN_NAME + -
" " + VEN_NUM + " " + REQ_AMT
$ GOTO READ_FILE_A
$!
$END_FILE_A:
$!
$ CLOSE input_file
$ CLOSE output_file
$ GOSUB MAIL_PRT
$ GOSUB MAIL_COPY
$!
$! CREATE AND E-MAIL OUT LISTS OF UNAPPROVED REQUISITIONS TO
$! REQUESTORS.
$!
$ SORT/KEY=(POSITION:93,SIZE:23)/KEY=(POSITION:24,SIZE:7) -
FR$FEX:PLAY.FTM FR$FEX:PLAY.LIS
$ OPEN/READ input_file FR$FEX:PLAY.LIS
$ READ/END=END_FILE_B input_file in_record
$!
$ EMAIL_ID_MAIN = F$EDIT(F$EXTRACT(92,23,in_record),"TRIM")
$ CLOSE input_file
$ OPEN/READ input_file FR$FEX:PLAY.LIS
$ GOSUB DO_RPT_HEAD
$!
$READ_FILE_B:
$!
$ READ/END=END_FILE_B input_file in_record
$!
$ REQ_APP = F$EDIT(F$EXTRACT(0,23,in_record),"TRIM")
$ REQ_NUM = F$EXTRACT(23,7,in_record)
$ REQ_YR = F$EXTRACT(30,4,in_record)
$ REQ_MON = F$EXTRACT(34,2,in_record)
$ REQ_DAY = F$EXTRACT(36,2,in_record)
$!
$ VEN_NAME = F$EXTRACT(38,30,in_record)
$ VEN_NUM = F$EXTRACT(68,11,in_record)
$ REQ_AMT = F$EXTRACT(79,13,in_record)
$!
$ EMAIL_ID_CHK = F$EDIT(F$EXTRACT(92,23,in_record),"TRIM")
$ IF EMAIL_ID_MAIN .NES. EMAIL_ID_CHK
$ THEN
$ CLOSE output_file
$ GOSUB MAIL_PRT
$ GOSUB DO_RPT_HEAD
$ EMAIL_ID_MAIN = F$EDIT(F$EXTRACT(92,23,in_record),"TRIM")
$ ENDIF
$!
$ WRITE output_file REQ_NUM + " " + REQ_MON + "/" + REQ_DAY + "/" + REQ_YR + " " + VEN_NAME + -
" " + VEN_NUM + " " + REQ_AMT + " " + REQ_APP
$ GOTO READ_FILE_B
$!
$END_FILE_B:
$!
$ CLOSE input_file
$ CLOSE output_file
$ GOSUB MAIL_PRT
$ EXIT
$!
$DO_RPT_HEAD:
$!
$ OPEN/WRITE output_file FR$FEX:PLAY.PRT
$ IF F$SEARCH("FR$FEX:PLAY.LIS;") .EQS. ""
$ THEN
$ WRITE output_file " "
$ WRITE output_file "Requisition Requisition Vendor Vendor Requisition"
$ WRITE output_file " Number Date Name Number Amount"
$ WRITE output_file "----------- ----------- ------ ------ -----------"
$ ELSE
$ WRITE output_file " "
$ WRITE output_file "Requisition Requisition Vendor Vendor Requisition Approval"
$ WRITE output_file " Number Date Name Number Amount Needed"
$ WRITE output_file "----------- ----------- ------ ------ ----------- --------"
$ ENDIF
$!
$ RETURN
$!
$! E-MAIL TO DESIGNATED PERSON.
$!
$ MAIL_PRT:
$!
$ OPEN/WRITE email_file FR$FEX:PLAY.COM
$!
$ WRITE email_file "$ MAIL"
$ WRITE email_file "SHOW FORWARD/USER=" + EMAIL_ID_MAIN
$ WRITE email_file "SEND FR$FEX:PLAY.PRT"
$ WRITE email_file EMAIL_ID_MAIN
$ WRITE email_file "Outstanding Requisitions - " + F$TIME()
$ WRITE email_file "EXIT"
$ WRITE email_file "$ EXIT"
$ CLOSE email_file
$!
$ @FR$FEX:PLAY
$ DELETE/LOG FR$FEX:PLAY.COM;*
$!
$ RETURN
$!
$! COPY E-MAIL TO DESIGNATED PERSON.
$!
$ MAIL_COPY:
$!
$ OPEN/READ copy_file FR$FEX:(file name)_COPY.DAT
$!
$READ_FILE_C:
$!
$ READ/END=END_FILE_C copy_file email_record
$!
$ EMAIL_ID_FST = F$ELEMENT(0,",",email_record)
$ IF EMAIL_ID_MAIN .EQS. EMAIL_ID_FST
$ THEN
$ OPEN/WRITE email_file FR$FEX:PLAY.COM
$ EMAIL_ID_COPY = F$ELEMENT(1,",",email_record)
$!
$ WRITE email_file "$ MAIL"
$ WRITE email_file "SHOW FORWARD/USER=" + EMAIL_ID_COPY
$ WRITE email_file "SEND FR$FEX:PLAY.PRT"
$ WRITE email_file EMAIL_ID_COPY
$ WRITE email_file "Outstanding Requisitions - " + F$TIME()
$ WRITE email_file "EXIT"
$ WRITE email_file "$ EXIT"
$ CLOSE email_file
$!
$ @FR$FEX:PLAY
$ DELETE/LOG FR$FEX:PLAY.COM;*
$!
$ ENDIF
$ GOTO READ_FILE_C
$!
$END_FILE_C:
$!
$ CLOSE copy_file
$!
$ RETURN
$!
$ EXIT
FOCUS program :
JOIN CLEAR *
-*
-* Create list of FRS ids along with aassociated VMS USERNAMEs.
-*
FILEDEF ZBA110 DISK Z$PRT:ZBA110.PRT
TABLE FILE ZBA110
PRINT ZBA110_MAIL BY ZBA110_NUM
ON TABLE HOLD AS MAILTMP
WHERE ZBA110_MAIL NE '';
WHERE ZBA110_ZWT EQ 'N ';
END
-*
-* Retrieve all unapproved requisitionns.
-*
DEFINE FILE POFILE
CHK_PO/A1=EDIT(PO_NUM,'9');
OPERATOR_ID_HOR/A4=EDIT(BATCH_REF,'9999');
END
TABLE FILE POFILE
PRINT PO_NUM PO_DT APRVL_ID TOTAL_AMT OPERATOR_ID_HOR
BY VENDOR_NUM
ON TABLE HOLD AS POTMP1
WHERE CHK_PO EQ 'R';
WHERE APRVL_ACTION_TAKEN NE 'Y';
WHERE DELETE_FLAG_HDR EQ '0';
END
-*
-* Retrieve vendor information for thee requisitions.
-*
JOIN VENDOR_NUM IN POTMP1 TO VENDOR_NUM IN VNFILE AS J1
TABLE FILE POTMP1
PRINT PO_NUM PO_DT VENDOR_NUM VENDOR_NAME TOTAL_AMT OPERATOR_ID_HOR
BY APRVL_ID
ON TABLE HOLD AS POTMP2
END
-*
-* Retrieve VMS USERNAME for the approoval ids.
-* This information will be e-mailed tto this id.
-*
JOIN APRVL_ID IN POTMP2 TO ZBA110_NUM IN MAILTMP AS J2
DEFINE FILE POTMP2
APP_MAIL/A23=ZBA110_MAIL;
END
TABLE FILE POTMP2
PRINT PO_NUM PO_DT VENDOR_NAME VENDOR_NUM TOTAL_AMT APP_MAIL
BY OPERATOR_ID_HOR
ON TABLE HOLD AS POTMP3
END
-*
-* Retrieve VMS USERNAME for the operaator ids.
-* This information will be e-mailed tto this id.
-*
JOIN OPERATOR_ID_HOR IN POTMP3 TO ZBA110_NUM IN MAILTMP AS J3
DEFINE FILE POTMP3
OPR_MAIL/A23=ZBA110_MAIL;
END_REC/A1='*';
END
TABLE FILE POTMP3
PRINT PO_DT VENDOR_NAME VENDOR_NUM TOTAL_AMT OPR_MAIL END_REC
BY APP_MAIL
BY PO_NUM
ON TABLE SAVE AS PLAY
END
JOIN CLEAR *
Master File Description (MFD) for ZBA110 :
FILE=ZBA110,SUFFIX=FIX
SEGNAME=ROOT
FIELDNAME=ZBA110_NUM,,A04,A04,$
FIELDNAME=COMPU_FILL01, ,A36,A36,$
FIELDNAME=ZBA110_MAIL,,A23,A23,$
FIELDNAME=COMPU_FILL02, ,A67,A67,$
FIELDNAME=ZBA110_ZWT, ,A02,A02,$
]]>
This page hosted by 
Get your own Free Homepage
