FTN4
      SUBROUTINE OFLPO, 92903-16580 REV.1913  790126
C 
C 
C     NAME:   OFLPO     OFLPOGE MODULE # 1
C     SOURCE: &OFLPO    92903-18580 
C     BINARY: %OFLPO    92903-16570    THIS IS  %OFLPO
C 
C     PGMR:    FRANCOIS GAULLIER
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C     **************************************************************
C 
C 
C     THIS PROGRAM IS A PART OF THE:
C 
C                      DATA CAPTURE SOFTWARE
C                        ( D A T A C A P )
C 
C     IT USES FEATURES OF THE TERMINAL MONITOR SOFTWARE (TMS).
C 
C     THIS MODULE: OFLPO  IS A  T.U.S. OF THE  TMP
C                   (TRANSACTION MONITOR PROGRAM) 
C 
C 
C                  OFLPO = OFF LINE PRINT OUT MODULE. 
C 
C 
C 
C     TMPER  'INTERNAL ERROR' REPORTED BY  OFLPO: 
C     =========================================== 
C 
C             FORMAT:   INTERNAL ERROR    7XX**  NNNN 
C 
C 
C     703   'TSMG' RETURN A BAD STATUS (NNN IS THE STATUS)
C 
C 
C 
      INTEGER FORMN,SQUAL,JNDEX,FMGST,STATLN,STATE
     .       ,STATPT,OBULN,OBUF,OUTDEV,INPDEV,OUTLEN,OUTBUF 
     .       ,TSMG(3),IEQUIV(3),TEMPA(64),MESA(13),PRTBUF(13) 
C 
      LOGICAL ISBIT 
C 
      COMMON ICOM00(5)
C 
      COMMON LU(19),IOMODL(3),IXXXX0(15),OUTDEV,INPDEV,IXXXX1(5)
     .      ,OUTLEN,OUTBUF(40)
C 
      COMMON NUQ,NMQ,STATPT,INDEXM,OBULN,LUQ,LMQ,OBUF(250)
C 
      COMMON FORMN,SQUAL,JNDEX,FMGST,STATLN,STATE(80) 
     .      ,INPLEN,INPBUF(100) 
     .      ,MAXPO,I1,I2,I3,INDEX 
C 
      COMMON ICOMEN 
C 
      EQUIVALENCE (ITMTP,IEQUIV(1)),(ITMLN,IEQUIV(2)),(IBUPT,IEQUIV(3)) 
D     EQUIVALENCE (LUOXXX,ICOM00) 
C 
      DATA TSMG/2HTS,2HMG,2H  / 
      DATA MESA/20015B,10*2H==,2*6440B/ 
      DATA PRTBUF/2*20015B,2H**,2H**,2H* ,2HT.,2H  ,2H  ,2H  ,2H *
     .,2H**,2H**,6440B/ 
C 
      ITML(M0)=IAND(INPBUF(M0),7760B)/20B 
      ITMT(M1)=IAND(INPBUF(M1),17B) 
      IPT(M2)=IAND(INPBUF(M2+1),7777B)
C 
C 
      CALL TMDFN(ICOM00,LU,NUQ,FORMN,ICOMEN)
C 
C-----INIT VARIABLES
C 
      INDEX=1 
      SQUAL=4 
C 
C-----SET UP VARIABLE FOR I/O MODULE, AND PRINT THE FIRST "============"
C 
      OUTDEV=2
      INPLEN=0
50    CALL MOVEW(MESA,OUTBUF,12)
      OUTLEN=22 
      CALL TMSUB(IOMODL)
C 
C-----GET OFF LINE PRINT-OUT STATE VECTOR 
C 
      JNDEX=0 
      I1=3
      I2=2
C 
100   JNDEX=JNDEX+1 
      CALL TMSUB(TSMG)
      IF(FMGST.NE.0)  CALL TMPER(0,99,FORMN,LU,703,FMGST) 
      K=I2-I1+1 
      CALL MOVEW(INPBUF(I1),INPBUF,K) 
      I1=K+1
      I2=2
C-----IF FIRST TIME, SAVE THE NUMBER OF PRINT-OUT 
      IF(JNDEX .NE. 1)  GOTO 200
      MAXPO=STATE(2)
      I2=4
C 
C-----PRINT HEADER
C 
      CALL MOVEW(PRTBUF,OUTBUF,13)
      CALL CNUMD(FORMN,OUTBUF(7)) 
      CALL BLANC(OUTBUF(14),20) 
      OUTBUF(18)=IASC(LU) 
      OUTBUF(20)=20015B 
      OUTBUF(30)=6440B
      OUTLEN=60 
C-----IF DATE & TIME ARE SELECTED IN THE TS, PRINT THEM 
      I=IAND(IALF2(STATE(3)),377B)
      IF(I.NE.0)  CALL MOVEW(OBUF(I),OUTBUF(22),3)
      I=IAND(STATE(3),377B) 
      IF(I.EQ.0)  GOTO 180
      OUTBUF(27)=OBUF(I)
      OUTBUF(28)=2H:
      CALL MOVCA(OBUF(I+1),1,OUTBUF(28),2,2)
180   CALL TMSUB(IOMODL)
C 
C-----PROCESS THE STATE VECTOR, SAVE IT INTO 'INPBUF' 
C 
200   CALL MOVEW(STATE(I2),INPBUF(I1),STATLN) 
      I2=STATLN+I1-I2 
      I1=1
C#####################################################################
D     WRITE(LUOXXX,8766)MAXPO,STATLN,I2,(INPBUF(I),I=I1,I2) 
D8766 FORMAT(" /OFLPO: ",I6" PRINTS, STATLN="I3", I2="I3, 
D    .", STATE VECTOR:",12(/,10@7)) 
C#####################################################################
C 
C-----PRINT 3 LINES AT A TIME 
C 
250   OUTLEN=1
      CALL BLANC(OUTBUF,40) 
      I3=1
275   K=I2-I1+1 
      IF( ISBIT(INPBUF(I1),15) )  GOTO 300
C-----ECHO OF A VALUE ON THE PRINTER
      IF(K .LT. 2)  GOTO 500
      ITMTP=ITMT(I1)
      ITMLN=ITML(I1)
      IBUPT=IPT(I1) 
      IF(IBUPT .GT. LUQ)  IBUPT=IBUPT+(INDEX-1)*LMQ 
      CALL BLANC(TEMPA,20)
      CALL CNVTO(ITMTP,OBUF(IBUPT),TEMPA,L) 
      CALL JUSTF(TEMPA,1,20,0)
      L=20
      CALL MOVCA(TEMPA,1,OUTBUF,OUTLEN,L) 
      I1=I1+2 
      GOTO 350
C-----PRINT THE TITLE 
300   L=ITML(I1)
      IF(K .LT. 1+(L+1)/2)  GOTO 500
      CALL MOVCA(INPBUF(I1+1),1,OUTBUF,OUTLEN,L)
      I1=I1+1+(L+1)/2 
C-----STORE A CR, AND CHECK IF LAST PRINT 
350   OUTLEN=OUTLEN+L 
      CALL PUTCA(OUTBUF,6400B,OUTLEN) 
      OUTLEN=OUTLEN+1 
      MAXPO=MAXPO-1 
      IF(MAXPO .LE. 0)  GOTO 500
      I3=I3+1 
      IF(I3 .LE. 3)  GOTO 275 
C 
C-----EXECUTE THE PRINT 
C 
500   OUTLEN=OUTLEN-1 
      IF(OUTLEN .NE. 0)  CALL TMSUB(IOMODL) 
      IF(MAXPO .LE. 0)  GOTO 800
      IF(I3 .GT. 3)  GOTO 250 
      GOTO 100
C 
C-----IF MORE THAN ONE LINE OF M-QUESTION, RESTART THE PRINT-OUT
C 
800   IF(INDEX .GE. INDEXM) GOTO 810
      INDEX=INDEX+1 
      GOTO 50 
C 
C-----THE PRINTOUT IS FINISHED
C 
810   CALL MOVEW(MESA,OUTBUF,13)
      OUTLEN=26 
      CALL TMSUB(IOMODL)
      RETURN
      END 
      END$
                                                                                                                                                                                                                    