| 1 | PXRMSTAC ; SLC/PKR - Stack routines for use by PXRM. ;11/24/2004
 | 
|---|
| 2 |  ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;=====================================================
 | 
|---|
| 5 | POP(STACK) ;Pop an element off of the stack.
 | 
|---|
| 6 |  I STACK(0)=0 Q ""
 | 
|---|
| 7 |  N IND,TEMP
 | 
|---|
| 8 |  S TEMP=STACK(1)
 | 
|---|
| 9 |  F IND=2:1:STACK(0) S STACK(IND-1)=STACK(IND)
 | 
|---|
| 10 |  K STACK(STACK(0))
 | 
|---|
| 11 |  S STACK(0)=STACK(0)-1
 | 
|---|
| 12 |  Q TEMP
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 |  ;=====================================================
 | 
|---|
| 15 | POSTFIX(EXPR,OPER,PFSTACK) ;Given an expression, EXPR, in infix notation
 | 
|---|
| 16 |  ;convert it to postfix and return the result in PFSTACK. PFSTACK(0)
 | 
|---|
| 17 |  ;will contain the number of elements in PFSTACK. OPER is a
 | 
|---|
| 18 |  ;string containing allowable operators.
 | 
|---|
| 19 |  N CHAR,IND,LEN,OPERP,PFP,SP,SPACE,STACK,SYM,SYMP,SYMT,TAB,TEMP
 | 
|---|
| 20 |  S SPACE=$C(32)
 | 
|---|
| 21 |  S TAB=$C(9)
 | 
|---|
| 22 |  S TEMP=""
 | 
|---|
| 23 |  S OPERP=OPER_"()"
 | 
|---|
| 24 |  S SYMP=0
 | 
|---|
| 25 |  S LEN=$L(EXPR)
 | 
|---|
| 26 |  ;Break the expression into (, ), operators, and operands.
 | 
|---|
| 27 |  ;Remove spaces and tabs and put the symbols onto the symbol
 | 
|---|
| 28 |  ;stack in left to right order. Symbol number 1 is SYM(1).
 | 
|---|
| 29 |  F IND=1:1:LEN D
 | 
|---|
| 30 |  . S CHAR=$E(EXPR,IND)
 | 
|---|
| 31 |  . I (CHAR=SPACE)!(CHAR=TAB) Q
 | 
|---|
| 32 |  . I OPERP[CHAR D
 | 
|---|
| 33 |  .. I $L(TEMP)>0 D
 | 
|---|
| 34 |  ... S SYMP=SYMP+1
 | 
|---|
| 35 |  ... S SYM(SYMP)=TEMP
 | 
|---|
| 36 |  ... S TEMP=""
 | 
|---|
| 37 |  .. S SYMP=SYMP+1
 | 
|---|
| 38 |  .. S SYM(SYMP)=CHAR
 | 
|---|
| 39 |  . E  S TEMP=TEMP_CHAR
 | 
|---|
| 40 |  . I (IND=LEN)&(TEMP'="") D
 | 
|---|
| 41 |  .. S SYMP=SYMP+1
 | 
|---|
| 42 |  .. S SYM(SYMP)=TEMP
 | 
|---|
| 43 |  ;Process the symbols.
 | 
|---|
| 44 |  S (PFP,SP)=0
 | 
|---|
| 45 |  S LEN=SYMP
 | 
|---|
| 46 |  F SYMP=1:1:LEN D
 | 
|---|
| 47 |  . S SYMT=SYM(SYMP)
 | 
|---|
| 48 |  .;
 | 
|---|
| 49 |  .;Symbol is "("
 | 
|---|
| 50 |  . I SYMT="(" D  Q
 | 
|---|
| 51 |  .. S SP=SP+1
 | 
|---|
| 52 |  .. S STACK(SP)=SYMT
 | 
|---|
| 53 |  .;
 | 
|---|
| 54 |  .;Symbol is an operator
 | 
|---|
| 55 |  . I OPER[SYMT D  Q
 | 
|---|
| 56 |  .. S LEN=SP
 | 
|---|
| 57 |  .. F IND=LEN:-1:1 S TEMP=STACK(IND) Q:TEMP="("  D
 | 
|---|
| 58 |  ...;M has no operator precedence so we don't need to check.
 | 
|---|
| 59 |  ... S PFP=PFP+1
 | 
|---|
| 60 |  ... S PFSTACK(PFP)=TEMP
 | 
|---|
| 61 |  ... K STACK(SP)
 | 
|---|
| 62 |  ... S SP=SP-1
 | 
|---|
| 63 |  .. S SP=SP+1
 | 
|---|
| 64 |  .. S STACK(SP)=SYMT
 | 
|---|
| 65 |  .;
 | 
|---|
| 66 |  .;Symbol is ")"
 | 
|---|
| 67 |  . I SYMT=")" D  Q
 | 
|---|
| 68 |  .. S LEN=SP
 | 
|---|
| 69 |  .. F IND=LEN:-1:1 S TEMP=STACK(IND) Q:TEMP="("  D
 | 
|---|
| 70 |  ... S PFP=PFP+1
 | 
|---|
| 71 |  ... S PFSTACK(PFP)=TEMP
 | 
|---|
| 72 |  ... K STACK(SP)
 | 
|---|
| 73 |  ... S SP=SP-1
 | 
|---|
| 74 |  ..;Pop the "(" at the top of the stack.
 | 
|---|
| 75 |  .. K STACK(SP)
 | 
|---|
| 76 |  .. S SP=SP-1
 | 
|---|
| 77 |  .;
 | 
|---|
| 78 |  .;If we get to here then symbol is an operand.
 | 
|---|
| 79 |  . S PFP=PFP+1
 | 
|---|
| 80 |  . S PFSTACK(PFP)=SYMT
 | 
|---|
| 81 |  ;
 | 
|---|
| 82 |  ;Pop and output anything left on the stack.
 | 
|---|
| 83 |  F IND=SP:-1:1 D
 | 
|---|
| 84 |  . S PFP=PFP+1
 | 
|---|
| 85 |  . S PFSTACK(PFP)=STACK(IND)
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 |  ;Save the number of elements in PFSTACK.
 | 
|---|
| 88 |  S PFSTACK(0)=PFP
 | 
|---|
| 89 |  Q
 | 
|---|
| 90 |  ;
 | 
|---|
| 91 |  ;=====================================================
 | 
|---|
| 92 | PUSH(STACK,ELEM) ;Push an element on the stack.
 | 
|---|
| 93 |  I '$D(STACK) S STACK(1)=ELEM,STACK(0)=1 Q
 | 
|---|
| 94 |  I STACK(0)=0 S STACK(1)=ELEM,STACK(0)=1 Q
 | 
|---|
| 95 |  N IND
 | 
|---|
| 96 |  F IND=STACK(0):-1:1 S STACK(IND+1)=STACK(IND)
 | 
|---|
| 97 |  S STACK(1)=ELEM,STACK(0)=STACK(0)+1
 | 
|---|
| 98 |  Q
 | 
|---|
| 99 |  ;
 | 
|---|