Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ASULALGO

ASULALGO.m

Go to the documentation of this file. 
  1. ASULALGO ; IHS/ITSC/LMH -ALGOLRYTHM ALPHA TO NUMERIC ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine is used to translate an alphanumeric character to a
  1.  ;2 digit numeric code.  The algolrythm is used to convert codes to
  1.  ;internal record numbers.  Entry points are also available to reverse
  1.  ;the translation.
  1. TR(Z) ;EP ;TRANSLATE ALPHA
  1.  I Z?1N S Y=0_Z Q
  1.  I Z?1A G @Z
  1.  S Y=-1 Q  ;AEF/2970723
  1. A S Y=10 Q
  1. B S Y=11 Q
  1. C S Y=12 Q
  1. D S Y=13 Q
  1. E S Y=14 Q
  1. F S Y=15 Q
  1. G S Y=16 Q
  1. H S Y=17 Q
  1. I S Y=18 Q
  1. J S Y=19 Q
  1. K S Y=20 Q
  1. L S Y=21 Q
  1. M S Y=22 Q
  1. N S Y=23 Q
  1. O S Y=24 Q
  1. P S Y=25 Q
  1. Q S Y=26 Q
  1. R S Y=27 Q
  1. S S Y=28 Q
  1. T S Y=29 Q
  1. U S Y=30 Q
  1. V S Y=31 Q
  1. W S Y=32 Q
  1. X S Y=33 Q
  1. Y S Y=34 Q
  1. Z S Y=35 Q
  1.  Q
  1. USR(X) ;EP ;ACCEPT USER CODE IN X
  1.  N Z
  1.  S Z=$E(X,3) D TR(Z)
  1.  I Y<0 Q
  1.  S X=$E(X,1,2)_Y
  1.  Q
  1. IEN(X) ;EP ;ACCEPT IEN IN X
  1.  N Z
  1.  S Z=$E(X,5,6) D UT^ASULALGO(.Z)  ;AEF/2970721
  1.  I Z<0 Q
  1.  S X=$E(X,3,4)_Z
  1.  Q
  1. UT(Z) ;EP ;
  1.  I $E(Z,2)=0 S Z=$E(Z) Q
  1.  I Z?2N,+Z>9,+Z<36 G @Z  ;AEF/2970722
  1.  S Z=-1 Q  ;AEF/2970722
  1. 10 S Z="A" Q
  1. 11 S Z="B" Q
  1. 12 S Z="C" Q
  1. 13 S Z="D" Q
  1. 14 S Z="E" Q
  1. 15 S Z="F" Q
  1. 16 S Z="G" Q
  1. 17 S Z="H" Q
  1. 18 S Z="I" Q
  1. 19 S Z="J" Q
  1. 20 S Z="K" Q
  1. 21 S Z="L" Q
  1. 22 S Z="M" Q
  1. 23 S Z="N" Q
  1. 24 S Z="O" Q
  1. 25 S Z="P" Q
  1. 26 S Z="Q" Q
  1. 27 S Z="R" Q
  1. 28 S Z="S" Q
  1. 29 S Z="T" Q
  1. 30 S Z="U" Q
  1. 31 S Z="V" Q
  1. 32 S Z="W" Q
  1. 33 S Z="X" Q
  1. 34 S Z="Y" Q
  1. 35 S Z="Z" Q