This program was created to support a script (NetData) web page. The direct call block of the script accepts an HTML table from this program. The program is bound to NetData API's to allow the code to format the table, assign values to the columns, and append rows.

    ‚‚/TITLE VND105RP: Vendor Delivery Performance
     H DEBUG(*YES)
    ‚‚****************************************************************
    ‚‚* PROGRAM NAME - VND105RP                                      *
    ‚‚*                                                              *
    ‚‚* FUNCTION     - Calculate delivery performance totals         *
    ‚‚*                                                              *
    ‚‚* PROGRAMMER   - Steve Croy        11/30/00                    *
    ‚‚****************************************************************
    ‚‚****************************************************************
    ‚‚*                   MODIFICATION LOG                           *
    ‚‚*                                                              *
    ‚‚*   DATE    PROGRAMMER      DESCRIPTION                        *
    ‚‚*                                                              *
    ‚‚****************************************************************
    ‚‚****************************************************************
    ‚‚*               PROGRAM INTERFACE SECTION                      *
    ‚‚*                                                              *
    ‚‚*  CALLED BY PROGRAMS:                                         *
    ‚‚*  CALLS PROGRAMS....:                                         *
     ‚*  Bind to svc pgm...: QTCP/QTMHLE                             *
    ‚‚*                                                              *
    ‚‚****************************************************************
    ‚‚****************************************************************
    ‚‚*               ** INDICATOR USAGE ***                         *
    ‚‚*          ** ON **                     ** OFF **              *
    ‚‚*                                                              *
    ‚‚*    ** ERROR INDICATORS **                                    *
    ‚‚****************************************************************
    ‚‚*-------------------------------------------------------------------
    ‚‚* File Specs.
    ‚‚*-------------------------------------------------------------------
     FRECLGHL6  IF   E           K DISK                                         ‚ shipment header
     FPORBCDL4  IF   E           K DISK                                         ‚ vendor master
     FRECQCBPF  IF   E           K DISK                                         ‚ shipment detail
     FPORHEDPF  IF   E           K DISK                                         ‚po header file
     FPORLINPF  IF   E           K DISK                                         ‚ po line items
    ‚‚*-------------------------------------------------------------------
    ‚‚* Retrieve Number of Rows in Table...
    ‚‚*-------------------------------------------------------------------
     D dtw_Rows        PR            10I 0 EXTPROC('dtw_table_Rows')
     D  table                          *
    ‚‚*-------------------------------------------------------------------
    ‚‚* Retrieve Number of Cols in Table...
    ‚‚*-------------------------------------------------------------------
     D dtw_Cols        PR            10I 0 EXTPROC('dtw_table_Cols')
     D  table                          *
    ‚‚*-------------------------------------------------------------------
    ‚‚* Set Value for Row/Col...
    ‚‚*-------------------------------------------------------------------
     D dtw_SetV        PR            10I 0 EXTPROC('dtw_table_SetV')
     D  table                          *
     D  value                          *   VALUE OPTIONS(*STRING)
     D  row                          10I 0 VALUE
     D  col                          10I 0 VALUE
    ‚‚*-------------------------------------------------------------------
    ‚‚* Set Columns for Table...
    ‚‚*-------------------------------------------------------------------
     D dtw_SetCols     PR            10I 0 EXTPROC('dtw_table_SetCols')
     D  table                          *
     D  col                          10I 0 VALUE
    ‚‚*-------------------------------------------------------------------
    ‚‚* Set Columns Names
    ‚‚*-------------------------------------------------------------------
     D dtw_SetN        PR            10I 0 EXTPROC('dtw_table_SetN')
     D  table                          *
     D  value                          *   VALUE OPTIONS(*STRING)
     D  col                          10I 0 VALUE
    ‚‚*-------------------------------------------------------------------
    ‚‚* Append Row to Table...
    ‚‚*-------------------------------------------------------------------
     D dtwAppRow       PR            10I 0 EXTPROC('dtw_table_AppendRow')
     D  table                          *
     D  row                          10I 0 VALUE
    ‚‚*-----------------------------------------------------------------
    ‚‚* Data Structures.
    ‚‚*-----------------------------------------------------------------
     D PGMDS         ESDS                  EXTNAME(MISSTSDA)
     D DBFDS         E DS                  EXTNAME(MISDBFDA)
    ‚‚*-----------------------------------------------------------------
    ‚‚* Constants.
    ‚‚*-----------------------------------------------------------------
     D  #NO            C                   'N'
     D  #YES           C                   'Y'
    ‚‚*-----------------------------------------------------------------
    ‚‚* Work Fields.
    ‚‚*-----------------------------------------------------------------
     D ndTable         S               *
     D ndValue         S               *
     D ndRC            S             10I 0
     D ndRow           S             10I 0
     D ndCol           S             10I 0
     D ROWS            S             10I 0
     D COLS            S             10I 0
    ‚‚*
     D p$FromDate      S              8  0
     D p$ToDate        S              8  0
     D p$Vendor        S              7  0
     D p$ErrId         S              7
     D p$ErrFlag       S              1
    ‚ *
     D w$FromDate      S              8  0
     D w$ToDate        S              8  0
     D W$GRACE         S              8  0
     D W$LATE          S              1
     D w$Vendor        S              7  0
     D W$RECQTY        S              7  0
     D W$TOTREC        S              7  0
     D W$QTYORD        S              7  0
     D W$TOTORD        S              7  0
     D w$QtyShip       S              7  0
     D w$QtyASN        S              7  0
     D W$ONTIME        S              7  0
     D w$tQtyShip      S              7  0
     D w$tQtyASN       S              7  0
     D W$TOT_TIME      S              7  0
     D w$tShpCnt       S              7  0
     D w$Qty           S              7
     D W$ONPCT         S              4  3
     D w$Per           S              5
     D W$PCTOUT        S              4  1
     D w$Value         S             15
    ‚‚*
     D $$date          S               D
    ‚‚*------------------------------------------------------------------
    ‚‚* Main line calc section
    ‚‚*------------------------------------------------------------------
     C     *ENTRY        PLIST
     C                   PARM                    p$FromDate
     C                   PARM                    p$ToDate
     C                   PARM                    p$Vendor
     C                   PARM                    p$ErrFlag
     C                   PARM                    p$ErrId
     C                   PARM                    ndTable
    ‚‚*
     C     LGHKEY        KLIST
     C                   KFLD                    w$Vendor
     C                   KFLD                    w$FromDate
    ‚‚*
     C     VNDKEY        KLIST
     C                   KFLD                    w$Vendor
    ‚‚*
     C     PORKEY        KLIST
     C                   KFLD                    QCPONO
     C                   KFLD                    QCPOSQ
    ‚‚*
     C     QCBKEY        KLIST
     C                   KFLD                    LHSHKY
    ‚‚*
    ‚‚* Move date parameters to work fields
    ‚‚*
     C                   MOVE      p$FromDate    w$FromDate
     C                   MOVE      p$ToDate      w$ToDate
     C                   MOVE      p$Vendor      w$Vendor
    ‚‚* Validate Vendor...
     C     VNDKEY        Chain     porbcdl4
    šC                   IF        not %found(porbcdl4)
    šC                   EVAL      p$ErrId = ' '
    šC                   EXSR      @Exit
    šC                   ENDIF
    ‚‚* Convert From Date...
     C     *usa          TEST(D)                 w$FromDate             40
    šC                   IF        *in40 = *off
    šC     *usa          MOVE      w$fromDate    $$date
    šC     *iso          MOVE      $$date        w$FromDate
    šC                   ELSE
    šC                   EVAL      p$ErrId = ' '
    šC                   EXSR      @Exit
    šC                   ENDIF
    ‚‚* Convert To Date...
     C     *usa          TEST(D)                 w$ToDate               40
    šC                   IF        *in40 = *off
    šC     *usa          MOVE      w$toDate      $$date
    šC     *iso          MOVE      $$date        w$toDate
    šC                   ELSE
    šC                   EVAL      p$ErrId = ' '
    šC                   EXSR      @Exit
    šC                   ENDIF
    ‚‚*--------------------------------------------------------------------
    ‚‚* Build table: set columns and assign column names
    ‚‚*--------------------------------------------------------------------
     C                   EVAL      ndRC = dtw_SetCols(ndTable:9)
     C                   EVAL      ndRC = dtw_SetN(ndTable:'SHPID':1)           Ship ID
     C                   EVAL      ndRC = dtw_SetN(ndTable:'RECDAT':2)          Receive date
     C                   EVAL      ndRC = dtw_SetN(ndTable:'ORDQTY':3)          Order quantity
     C                   EVAL      ndRC = dtw_SetN(ndTable:'SHPQTY':4)          Shipped qty
     C                   EVAL      ndRC = dtw_SetN(ndTable:'ASNQTY':5)          ASN quantity
     C                   EVAL      ndRC = dtw_SetN(ndTable:'TOTQTY':6)          Total quantity
     C                   EVAL      ndRC = dtw_SetN(ndTable:'ONTIME':7)          On-time percent
     C                   EVAL      ndRC = dtw_SetN(ndTable:'SHKY':8)
     C                   EVAL      ndRC = dtw_SetN(ndTable:'RECID':9)           Record ID
     C                   EVAL      ndRow = *Zeros
    ‚‚*
    ‚‚* Retrieve Shipments for Specified date range
    ‚‚*
     C                   Z-ADD     *ZERO         w$tQtyShip
     C                   Z-ADD     *ZERO         w$tQtyASN
     C                   Z-ADD     *ZERO         W$TOT_TIME
     C                   Z-ADD     *ZERO         w$tShpCnt
     C                   EVAL      W$TOTORD = 0
     C                   EVAL      W$TOTREC = 0
    ‚‚*
     C     LGHKEY        SETLL     RECLGHL6
     C                   READ      RECLGHL6
    šC                   DOW       not %eof(RECLGHL6)
    šC                             and lhdate >= w$FromDate
    šC                             and lhdate <= w$ToDate
    ‚‚*
    šC                   ADD       1             w$tShpCnt                      shipment count
    šC                   EVAL      ndRC = dtwAppRow(ndTable:1)                  append row to
    šC                   ADD       1             ndRow                          table
    ‚‚*
    ‚‚* Retrieve shipped quantity
    ‚‚*
    šC                   EVAL      W$QTYORD = 0
    šC                   EVAL      W$RECQTY = 0
    šC                   EVAL      w$QtyShip = 0
    šC                   EVAL      w$QtyASN = 0
    šC                   EVAL      W$ONTIME = 0
    šC                   EVAL      W$ONPCT = 0
    ‚ *
    šC     QCBKEY        SETLL     RECQCBPF
    šC     QCBKEY        READE     RECQCBPF
    C                   DOW       not %eof(RECQCBPF)
    C                   IF        QCSTS <> 'DEL'                               ignore deleted
    ‚‚*
    C                   ADD       QCRQTY        W$RECQTY                       received qty
    C                   ADD       QCRQTY        W$TOTREC                       total recipts
    ‚‚*
    ‚‚* If line closed, count as shipped
    ‚‚*
    ˜C                   IF        QCSTS = 'CLO'
    ˜C                   ADD       QCRQTY        w$QtyShip
    ˜C                   ADD       QCRQTY        w$tQtyShip
    ˜C                   ELSE
    ˜C                   ADD       QCRQTY        w$QtyASN                       ASN quantity
    ˜C                   ADD       QCRQTY        w$tQtyASN                      total ASN qty
    ˜C                   ENDIF
    ‚‚*
    ‚‚* Get first promise date from PO
    ‚‚*
    C                   EVAL      W$GRACE = 99999999
    C     QCPONO        CHAIN     PORHEDPF
    ˜C                   IF        %FOUND(PORHEDPF)
    ˜C     *ISO          TEST(D)                 PHPMDTF                40
    ˆC                   IF        *IN40 = *OFF
    ˆC     *ISO          MOVE      PHPMDTF       $$DATE                         calculate grace
    ˆC                   ADDDUR    7:*DAYS       $$DATE                         period
    ˆC     *ISO          MOVE      $$DATE        W$GRACE
    ˆC                   ENDIF
    ˜C                   ENDIF
    ‚‚*
    ‚‚* Determine if the item was delivered on-time
    ‚‚*
    C     PORKEY        CHAIN     PORLINPF
    ˜C                   IF        %FOUND(PORLINPF)
    ˜C                   ADD       PIQCUR        W$QTYORD                       Current order qty
    ˜C                   ADD       PIQCUR        W$TOTORD                       total on order
    ˆC                   IF        LHDATE > W$GRACE                             if the receipt
    ˆC                   EVAL      W$LATE = #YES                                is not past the
    ˆC                   ELSE                                                   grace date flag
    ˆC                   ADD       QCRQTY        W$ONTIME                       the items as
    ˆC                   ADD       QCRQTY        W$TOT_TIME                     on time
    ˆC                   EVAL      W$LATE = #NO
    ˆC                   ENDIF
    ˜C                   ENDIF
    ‚‚*
    C                   ENDIF
    C     QCBKEY        READE     RECQCBPF
    C                   ENDDO
    ‚‚* Calculate on-time percentage
    C                   IF        W$QTYORD > 0
    C     W$ONTIME      DIV(H)    W$QTYORD      W$ONPCT
    C     W$ONPCT       MULT      100           W$PCTOUT
    C                   ENDIF
    ‚‚*--------------------------------------------------------------------
    ‚‚* Assign Values to Columns for this row...
    ‚‚*--------------------------------------------------------------------
    ‚‚*
    šC                   EVAL      w$Value = %Editc(LHSHID:'Z')                 ship id
    šC                   EVAL      ndRC = +
    šC                             dtw_SetV(ndTable:w$Value:ndRow:1)
    ‚‚*
    šC     *iso          TEST(D)                 LHDATE                 40      receive date
    C                   IF        *IN40 = *off
    C     *iso          MOVE      LHDATE        $$date
    C     *usa          MOVE      $$date        LHDATE
    C                   ELSE
    C                   MOVE      *all'9'       LHDATE
    C                   ENDIF
    šC
    šC                   EVAL      w$Value = %Editw(LHDATE:'  /  /    ')
    šC                   EVAL      ndRC = +
    šC                             dtw_SetV(ndTable:W$Value:ndRow:2)
    ‚‚*
    šC                   EVAL      w$Qty = %Editc(W$QTYORD:'Z')
    šC                   EVAL      ndRC = +                                     current qty
    šC                             dtw_SetV(ndTable:W$Qty:ndRow:3)              ordered
    ‚‚*
    šC                   EVAL      w$Qty = %Editc(w$QtyShip:'Z')
    šC                   EVAL      ndRC = +                                     shipped quantity
    šC                             dtw_SetV(ndTable:w$Qty:ndRow:4)
    ‚‚*
    šC                   EVAL      w$Qty = %Editc(w$QtyASN:'Z')
    šC                   EVAL      ndRC = +                                     ASN quantity
    šC                             dtw_SetV(ndTable:w$Qty:ndRow:5)
    ‚‚*
    šC                   EVAL      w$Qty = %Editc(W$RECQTY :'Z')
    šC                   EVAL      ndRC = +                                     received quantity
    šC                             dtw_SetV(ndTable:w$Qty:ndRow:6)
    ‚‚*
    šC                   EVAL      w$Per = %Editw(W$PCTOUT:'   . ')
    šC                   EVAL      ndRC = +                                     On-time delivery
    šC                             dtw_SetV(ndTable:w$Per:ndRow:7)              percentage
    ‚‚*
    šC                   MOVE(P)   LHSHKY        w$Value
    šC                   EVAL      ndRC = +
    šC                             dtw_SetV(ndTable:w$Value:ndRow:8)            ship key
    ‚‚* Record I.D...
    šC                   EVAL      w$Value = 'D'
    šC                   EVAL      ndRC = +
    šC                             dtw_SetV(ndTable:w$Value:ndRow:9)
    ‚‚*
    šC                   READ      ReclghL6
    šC                   ENDDO
    ‚‚*-------------------------------------------------------------------
    ‚‚* Append Last Row With Totals...
    ‚‚*-------------------------------------------------------------------
     C                   EVAL      ndRC = dtwAppRow(ndTable:1)
     C                   ADD       1             ndRow
    ‚‚*
     C                   EVAL      w$Value = %trim(%Editc(w$tShpCnt:'Z')) +
     C                                       ' Shipments'
     C                   EVAL      ndRC = +
     C                             dtw_SetV(ndTable:w$Value:ndRow:1)
    ‚‚*
     C                   EVAL      w$Value = ('Totals..:')
     C                   EVAL      ndRC = +
     C                             dtw_SetV(ndTable:W$Value:ndRow:2)            "totals" literal
    ‚‚*
     C                   EVAL      w$Qty = %Editc(W$TOTORD:'Z')
     C                   EVAL      ndRC = +                                     Total quantity
     C                             dtw_SetV(ndTable:W$Qty:ndRow:3)              ordered
    ‚‚*
     C                   EVAL      w$Qty = %Editc(w$tQtyShip:'Z')
     C                   EVAL      ndRC = +                                     total shipped
     C                             dtw_SetV(ndTable:w$Qty:ndRow:4)              quantity
    ‚‚*
     C                   EVAL      w$Qty = %Editc(w$tQtyASN:'Z')                total ASN
     C                   EVAL      ndRC = +                                     quantity
     C                             dtw_SetV(ndTable:w$Qty:ndRow:5)
    ‚‚*
     C                   EVAL      w$Qty = %Editc(W$TOTREC:'Z')
     C                   EVAL      ndRC = +                                     total ordered
     C                             dtw_SetV(ndTable:w$Qty:ndRow:6)              items count
    ‚‚*
     C                   MOVE      *Blanks       w$Per
    šC                   IF        W$TOTORD  > 0
    šC     W$TOT_TIME    DIV(H)    W$TOTORD      W$ONPCT
    šC     W$ONPCT       MULT      100           W$PCTOUT
    šC                   ENDIF
     C                   EVAL      w$Per = %Editw(W$PCTOUT:'   . ')
     C                   EVAL      ndRC = +                                     average on-time
     C                             dtw_SetV(ndTable:w$Per:ndRow:7)              percentage
    ‚‚* Record I.D...
     C                   EVAL      w$Value = 'T'
     C                   EVAL      ndRC = +
     C                             dtw_SetV(ndTable:w$Value:ndRow:9)
    ‚‚*
     C                   EXSR      @Exit
    ‚‚*===================================================================
    ‚‚* Exit Program
    ‚‚*===================================================================
     CSR   @EXIT         BEGSR
     C                   MOVE      *ON           *INLR
     C                   RETURN
     CSR                 ENDSR