ABSPOS97.m

ABSPOS97 ; IHS/FCS/DRS - MSM Win NT 4.40 busted! ; 

 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001

 ;

 ; This routine demonstrates the problem:

 W !,"TESTING $$ AND ERRORS",!

 W "Testing on ",$ZV,!

 K X

 W "Now we call $$SUBROU",!

 S X=$$SUBROU(1)

 W "Back from call to $$SUBROU with $D(X)=",$D(X)

 I $D(X) W ", X=",X,!

 Q

SUBROU(ARG)        ;

 W !,"Now in SUBROU with ARG=",ARG,!

 ; This $$NEWTRAP doesn't seem to help

 ;I $$NEWTRAP N $ESTACK S $ECODE="",$ETRAP="Q:$Q 0 Q"

 W "$Q=",$Q,!

 N X S X="TRAP^"_$T(+0)

 S @^%ZOSF("TRAP")

 ;S $ZT="TRAP^"_$T(+0)

 W "And $ZT=",$ZT,!

 W "^%ZOSF(""TRAP"")=",^%ZOSF("TRAP"),!

 W "And now we make an error happen:",!

 X $T(+1)

 W "SHOULD NOT REACH THIS LINE!!!!",!

 Q 1

TRAP() W "At the error trap",!

 W "$Q=",$Q,!

 Q:$Q 2 Q

NEWTRAP()          ; do you need the new error trapping?

 N X S X=$ZV

 N Y S Y="MSM for Windows NT, Version "

 I X'[Y Q 0

 S X=$P(X,Y,2)

 S X=$P(X,".",1,2)

 Q X'<4.4 ; v4.4 and up needs it

ABSPOS97  ; IHS/FCS/DRS - MSM Win NT 4.40 busted! ; 

 +1       ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001

 +2       ;

 +3       ; This routine demonstrates the problem:

 +4        WRITE !,"TESTING $$ AND ERRORS",!

 +5        WRITE "Testing on ",$ZV,!

 +6        KILL X

 +7        WRITE "Now we call $$SUBROU",!

 +8        SET X=$$SUBROU(1)

 +9        WRITE "Back from call to $$SUBROU with $D(X)=",$DATA(X)

 +10       IF $DATA(X)

               WRITE ", X=",X,!

 +11       QUIT 

SUBROU(ARG) ;

 +1        WRITE !,"Now in SUBROU with ARG=",ARG,!

 +2       ; This $$NEWTRAP doesn't seem to help

 +3       ;I $$NEWTRAP N $ESTACK S $ECODE="",$ETRAP="Q:$Q 0 Q"

 +4        WRITE "$Q=",$QUIT,!

 +5        NEW X

           SET X="TRAP^"_$TEXT(+0)

 +6        SET @^%ZOSF("TRAP")

 +7       ;S $ZT="TRAP^"_$T(+0)

 +8        WRITE "And $ZT=",$ZT,!

 +9        WRITE "^%ZOSF(""TRAP"")=",^%ZOSF("TRAP"),!

 +10       WRITE "And now we make an error happen:",!

 +11       XECUTE $TEXT(+1)

 +12       WRITE "SHOULD NOT REACH THIS LINE!!!!",!

 +13       QUIT 1

TRAP()     WRITE "At the error trap",!

 +1        WRITE "$Q=",$QUIT,!

 +2        IF $QUIT

               QUIT 2

           QUIT 

NEWTRAP() ; do you need the new error trapping?

 +1        NEW X

           SET X=$ZV

 +2        NEW Y

           SET Y="MSM for Windows NT, Version "

 +3        IF X'[Y

               QUIT 0

 +4        SET X=$PIECE(X,Y,2)

 +5        SET X=$PIECE(X,".",1,2)

 +6       ; v4.4 and up needs it

           QUIT X'<4.4