AZAXSTAK.m

AZAXSTAK ;IHS/PHXAO/AEF - PRINT $STACK

 ;;V1.0;ANNE'S SPECIAL ROUTINES;;SEP 9, 2004

 ;

EN ;EP -- MAIN ENTRY POINT

 ;

 N I,J,X

 ;

 I '$D(IOM) S IOM=80

 ;

 W !,"$STACK="_$STACK

 W !

 F J=1:1:IOM W "-"

 ;

 F I=0:1:$STACK(-1) D

 . S X=$$PAD(I,"L",3,0)

 . W !,"$STACK("_X_")="_$STACK(I)

 . W !,"$STACK("_X_","_"""ECODE"""_")="_$STACK(I,"ECODE")

 . W !,"$STACK("_X_","_"""MCODE"""_")="_$STACK(I,"MCODE")

 . W !,"$STACK("_X_","_"""PLACE"""_")="_$STACK(I,"PLACE")

 . W !

 . F J=1:1:IOM W "-"

 Q

PAD(X,S,L,C)          ;EP

 ;----- PAD MACHINE - PAD CHARACTER STRING

 ;

 ;      X = DATA STRING

 ;      S = L=PADLEFT, R=PADRIGHT

 ;      L = LENGTH

 ;      C = PAD CHARACTER

 ;

 I $L(X)>L S X=$E(X,1,L) Q X

 S X=$TR(X," ","~")

 I S="R" D

 . S X=X_$J("",L-$L(X))

 I S="L" D

 . S X=$J("",L-$L(X))_X

 I C]"" S X=$TR(X," ",C)

 S X=$TR(X,"~"," ")

 Q X

AZAXSTAK  ;IHS/PHXAO/AEF - PRINT $STACK

 +1       ;;V1.0;ANNE'S SPECIAL ROUTINES;;SEP 9, 2004

 +2       ;

EN        ;EP -- MAIN ENTRY POINT

 +1       ;

 +2        NEW I,J,X

 +3       ;

 +4        IF '$DATA(IOM)

               SET IOM=80

 +5       ;

 +6        WRITE !,"$STACK="_$STACK

 +7        WRITE !

 +8        FOR J=1:1:IOM

               WRITE "-"

 +9       ;

 +10       FOR I=0:1:$STACK(-1)

               Begin DoDot:1

 +11               SET X=$$PAD(I,"L",3,0)

 +12               WRITE !,"$STACK("_X_")="_$STACK(I)

 +13               WRITE !,"$STACK("_X_","_"""ECODE"""_")="_$STACK(I,"ECODE")

 +14               WRITE !,"$STACK("_X_","_"""MCODE"""_")="_$STACK(I,"MCODE")

 +15               WRITE !,"$STACK("_X_","_"""PLACE"""_")="_$STACK(I,"PLACE")

 +16               WRITE !

 +17               FOR J=1:1:IOM

                       WRITE "-"

               End DoDot:1

 +18       QUIT 

PAD(X,S,L,C) ;EP

 +1       ;----- PAD MACHINE - PAD CHARACTER STRING

 +2       ;

 +3       ;      X = DATA STRING

 +4       ;      S = L=PADLEFT, R=PADRIGHT

 +5       ;      L = LENGTH

 +6       ;      C = PAD CHARACTER

 +7       ;

 +8        IF $LENGTH(X)>L

               SET X=$EXTRACT(X,1,L)

               QUIT X

 +9        SET X=$TRANSLATE(X," ","~")

 +10       IF S="R"

               Begin DoDot:1

 +11               SET X=X_$JUSTIFY("",L-$LENGTH(X))

               End DoDot:1

 +12       IF S="L"

               Begin DoDot:1

 +13               SET X=$JUSTIFY("",L-$LENGTH(X))_X

               End DoDot:1

 +14       IF C]""

               SET X=$TRANSLATE(X," ",C)

 +15       SET X=$TRANSLATE(X,"~"," ")

 +16       QUIT X