ZTFENTM.m

%ZTFE ;SLT; 10 Dec 97 12:26; MSM/Windows NT version of %ZTFE - error handler utility

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;CHCS TLS_4603; GEN 1; 21-MAY-1999

 ;COPYRIGHT 1997 SAIC

 ;All implementation-specific code must be flagged with ';***'.

 ;This version is for VAX DSM.

 N %,N,R,L,T

 W !,"Available functions in library ^"_$T(+0)

 S N=0 F %=2:1 S R=$T(+%) Q:R=""  D

 .S L=$P(R," "),T=$E(R,$F(R," "),999)

 .I L]"",$E(T)=";" W !!,$P(L,"("),?10,"(",$P(L,"(",2,99) S N=1

 .I N,$E(T)=";" W !?5,T Q

 .S N=0

 Q

 ;the end

ETYPE(IPS) ;check certain error conditions

 ;input:

 ;  IPS --> (req,pbv) input parameter string

 ;    valid codes:

 ;      C: INRPT - system interupt

 ;      A: PGMOV - memory allocation error

 ;      N: NOSYS - non-existent system through DDP

 ;      D: DSTDB - network link failure during DDP data transfer

 ;      O: NOPEN - attempt to use an unopened device

 ;      V: NODEV - open undefined device

 ;output:

 ;  1: error found

 ;  0: error not found

 I IPS["C",$ZE["INRPT" Q 1

 I IPS["A",$ZE["PGMOV" Q 1

 I IPS["N",$ZE["NOSYS" Q 1

 I IPS["D",$ZE["DSTDB" Q 1

 I IPS["O",$ZE["NOPEN" Q 1

 I IPS["V",$ZE["NODEV" Q 1

 Q 0

 ;

%ZTFE     ;SLT; 10 Dec 97 12:26; MSM/Windows NT version of %ZTFE - error handler utility

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;CHCS TLS_4603; GEN 1; 21-MAY-1999

 +3       ;COPYRIGHT 1997 SAIC

 +4       ;All implementation-specific code must be flagged with ';***'.

 +5       ;This version is for VAX DSM.

 +6        NEW %,N,R,L,T

 +7        WRITE !,"Available functions in library ^"_$TEXT(+0)

 +8        SET N=0

           FOR %=2:1

               SET R=$TEXT(+%)

               IF R=""

                   QUIT 

               Begin DoDot:1

 +9                SET L=$PIECE(R," ")

                   SET T=$EXTRACT(R,$FIND(R," "),999)

 +10               IF L]""

                       IF $EXTRACT(T)=";"

                           WRITE !!,$PIECE(L,"("),?10,"(",$PIECE(L,"(",2,99)

                           SET N=1

 +11               IF N

                       IF $EXTRACT(T)=";"

                           WRITE !?5,T

                           QUIT 

 +12               SET N=0

               End DoDot:1

 +13       QUIT 

 +14      ;the end

ETYPE(IPS) ;check certain error conditions

 +1       ;input:

 +2       ;  IPS --> (req,pbv) input parameter string

 +3       ;    valid codes:

 +4       ;      C: INRPT - system interupt

 +5       ;      A: PGMOV - memory allocation error

 +6       ;      N: NOSYS - non-existent system through DDP

 +7       ;      D: DSTDB - network link failure during DDP data transfer

 +8       ;      O: NOPEN - attempt to use an unopened device

 +9       ;      V: NODEV - open undefined device

 +10      ;output:

 +11      ;  1: error found

 +12      ;  0: error not found

 +13       IF IPS["C"

               IF $ZE["INRPT"

                   QUIT 1

 +14       IF IPS["A"

               IF $ZE["PGMOV"

                   QUIT 1

 +15       IF IPS["N"

               IF $ZE["NOSYS"

                   QUIT 1

 +16       IF IPS["D"

               IF $ZE["DSTDB"

                   QUIT 1

 +17       IF IPS["O"

               IF $ZE["NOPEN"

                   QUIT 1

 +18       IF IPS["V"

               IF $ZE["NODEV"

                   QUIT 1

 +19       QUIT 0

 +20      ;