Uni-Basic Program :

SUBROUTINE S.BUS.PHONE( OUTPUT.DATA, PER_ID )

OPEN '', 'PERSON' TO PER.FL ELSE STOP 'CANNOT OPEN PERSON'
OPEN '', 'ADDRESS' TO ADDR.FL ELSE STOP 'CANNOT OPEN ADDRESS'

OUTPUT.DATA = ''

READ PER.REC FROM PER.FL,PER_ID  THEN
  MAX.ADDR.IN = DCOUNT(PER.REC<17>,@VM)
  FOR I = 1 TO MAX.ADDR.IN 
    IF PER.REC<136,I> = 'H' THEN
      READ ADDR.REC FROM ADDR.FL,PER.REC<17,I> THEN
        MAX.PHONES.IN = DCOUNT(ADDR.REC<26>,@VM)
        FOR J = 1 TO MAX.PHONES.IN
          IF ADDR.REC<26,J> = 'BUS' THEN
            OUTPUT.DATA = ADDR.REC<18,J>
          END
        NEXT J
        BEGIN CASE
          CASE LEN(OUTPUT.DATA) = 8
            OUTPUT.DATA = OUTPUT.DATA[1,3]:'-':OUTPUT.DATA[5,4]
          CASE LEN(OUTPUT.DATA) = 7
            OUTPUT.DATA = OUTPUT.DATA[1,3]:'-':OUTPUT.DATA[4,4]
          CASE LEN(OUTPUT.DATA) = 12
            OUTPUT.DATA = OUTPUT.DATA[1,3]:'-':OUTPUT.DATA[5,3]:'-':OUTPUT.DATA[9,4]
          CASE 1
            OUTPUT.DATA = OUTPUT.DATA[1,3]:'-':OUTPUT.DATA[4,3]:'-':OUTPUT.DATA[7,4]
        END CASE
      END
    END
  NEXT I
  IF OUTPUT.DATA[1,1]  = '-' THEN OUTPUT.DATA = ''
END
END

I-Desc :

001: I
002: BUS.PHONE; SUBR("S-BUS-PHONE",@ID); IF @1 THEN @1 ELSE @2
003:
004: Business Phone
005: 15L
006: S
007:
008: S.BUS.PHONE
009: PERSON

This page hosted by Get your own Free Homepage