.TITLE TIME IPL PGM
	.MCALL FSRSZ$,FDAT$A,FDRC$A,FDOP$A,NMBLK$,FINIT$,DIR$
	.MCALL GTIM$S,OPEN$A,PUT$,CLOSE$,EXIT$S,OPEN$W,FDBDF$
        .MCALL $STRUC,CALL,QIOW$S
        $STRUC				;MACRO FOR STRUCTURED MACROS
	;THIS PGM USES THE GTIM MACRO TO WRITE A RECORD
	;TO A FILE FOR ACCOUNTING PURPOSES. IT DISTINGUISHES
	;BETWEEN 1ST IPL AND SECONDARY IPL'S BY OPENING A
	;FILE FOR APPEND, IF AN ERROR OCCURS DURING THE OPEN
	;THEN IT IS TAKEN TO BE THE 1ST IPL OF THE DAY, ELSE
	;THE RECORD IS APPENDED AS A SECONDARY IPL.
	OUTLUN = 1			;DEFINES LUN 1
	FSRSZ$ 1			;ONE FILE WILL BE OPEN
FDBOUT: FDBDF$			;SET UP FDB
	FDAT$A R.FIX,,16.	;RECORD INFO
	FDRC$A ,OUTBUF,16.	;FILE INFO
	FDOP$A OUTLUN,DESCR,OFNAM	;OPEN INFO
OUTBUF: .BLKB 10.		;TIME AND DATE DATA AREA
DESC:	.ASCII /02/		;SECONDARY IPL RECORD TYPE
        .ASCII /0000/		;AREA FOR FUTURE USE
CHGE:	.ASCII /01/ 		;INITIAL IPL RECORD TYPE
MES1:	.ASCII <15> <12> <12> /*** ERROR  IPL12 *OPEN$A* ***/	
	.ASCII <12> <15> <12><7> <7> <7> <7>
	MES1L=.-MES1					;ERR MSG1 LENGTH
	.EVEN
MES2:	.ASCII <15> <12> <12> /*** ERROR IPL12 *OPEN$W* *** /	;ERR MSG2
	.ASCII <12> <15> <12><7> <7> <7> <7>
	MES2L=.-MES2							;ERR MSG2 LENGTH
	.EVEN
MES3:	.ASCII <15> <12> <12> /*** ERROR IPL12 *CLOSE$* ***/ ;ERR MSG3
	.ASCII <12> <15> <12>  <7> <7> <7> <7>
	MES3L=.-MES3							;ERR MSG3 LENGTH
	.EVEN
MES4:	.ASCII <15> <12> <12> /*** IPL12 CREATED TIMSTMP.DAT FILE ***/
	MES4L=.-MES4							;MSG4 LENGTH
	.EVEN
MES5:	.ASCII <15> <12> <12> /*** IPL12  TIMSTMP.DAT IS PRESENT ******/
	.ASCII <15> <12>
OFNAM: 	NMBLK$ TIMSTMP,DAT			;NAME BLK FOR OUTPUT FILE
DATBLK: .BLKB 16.				;WORK AREA
DESCR:	.WORD 0,0				;DEVICE FIELD
	.WORD DIRSZ,DIRNM			;DIRECTORY FIELD
	.WORD 0,0				;NAME FIELD
DIRNM:	.ASCII /[1,5]/				;DIRECTORY VALUE
	DIRSZ=.-DIRNM
	.EVEN
	.PAGE
START:	FINIT$					;INITIAL MACRO
	MOV #DATBLK,R1				;ADDRESS FOR GTIM MACRO
        GTIM$S R1 				;GET THE TIME AND DATE FROM MACHINE
	MOV #5.,R3				;LOOP CNTR
	MOV #OUTBUF,R4				;ADDRESS OF WHERE TO MOVE
        $WHILE <R3,NE> 15			;-LOOP CONTROL
	MOV (R1)+,(R4)+				;-MOVE FROM WORK AREA TO OUTPUT AREA
	DEC R3					;-SUB ONE FROM LOOP CNTR
	$END					;-END MOVE LOOP
        CALL OPNAW				;OPEN THE OUTPUT FILE FOR APPEND IF FILE
						;IS NOT FOUND IT WILL BE OPENED FOR A WRITE
        $IF <,CC>				;-IF CARRY CLEAR
        CALL PRTCLO				;-CLOSE OUTPUT FILE
        $END					;-END CLOSE IF
        EXIT$S					;EXIT THE PROGRAM
;
;THIS RTN OPENS THE OUTPUT FILE AND PERFORMS ERROR CHECKING
;
OPNAW:	OPEN$A #FDBOUT				;SUBRTN FOR OPEN OUTPUT FILE
	$IF <,CS>				;-CHECK FOR ERR
	$IF <F.ERR(R0),NE,#IE.NSF,B>		;--CHECK FOR NO SUCH FILE
	QIOW$S #IO.WLB,#5,#1,,,,<#MES1,#MES1L>	;--DISPLAY ERR MSG1
	SEC					;--SET CARRY BIT
	$ELSE					;--FILE TO BE CREATED
	OPEN$W #FDBOUT				;--OPEN FILE FOR WRITE
	$IF <,CS>				;---ERR CHECK ON OPEN$W
	QIOW$S #IO.WLB,#5,#1,,,,<#MES2,#MES2L>	;---DISPLAY ERR MSG2
	SEC					;---SET CARRY BIT
	$ELSE					;---NO ERR ON OPEN$W
	MOV CHGE,DESC				;---CHANGE RECORD TYPE
	QIOW$S #IO.WLB,#5,#1,,,,<#MES4,#MES4L>  ;---CREATE MSG TO OPERATOR
	$END					;---END ERR ON OPEN$W
	$END					;--END NO SUCH FILE CHECK
	$END					;-END ERR ON OPEN$A
	RETURN					;RETURN TO MAIN
;
;THIS SUBROUTINE PRINTS AND CLOSES THE OUTPUT FILE AND CHECK FOR ERRORS
;
PRTCLO:	PUT$ #FDBOUT				;PRINT AND CLOSE SUBRTN
	CLOSE$ #FDBOUT				;CLOSE OUTPUT FILE
	$IF <,CS>				;-ERR CHECK ON CLOSE$
	QIOW$S #IO.WLB,#5,#1,,,,<#MES3,#MES3L>	;-DISPLAY ERR MSG3
	$END					;-END ERR CHECK FOR CLOSE$
	RETURN					;RETURN TO MAIN
        .END START				;END OF PROGRAM