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

LRAFUNC.m

Go to the documentation of this file. 
  1. LRAFUNC ;SLC/MRH/FHS - FUNCTION CALLS A5AFUNC
  1.  ;;5.2;LAB SERVICE;**286**;Sep 27, 1994
  1.  ;
  1.  N I,X
  1.  W !!,"Routine: "_$T(+0),! F I=8:1 S X=$T(LRAFUNC+I) Q:'$L(X)  I X[";;" W !,X
  1.  W !!
  1.  Q
  1.  ;;
  1. UPCASE(X) ;; $$UPCASE(X)
  1.  ;; Call by value
  1.  ;; X in lowercase
  1.  ;; Returns uppercase
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ;;
  1. LOWCASE(X) ;; $$LOWCASE(X)
  1.  ;; Call by value
  1.  ;; X in uppercase 
  1.  ;; Returns lowercase
  1.  Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
  1.  ;;
  1. STRIP(X,Y) ;; Strips all instances of character 'Y' in string 'X'
  1.  ;; Call by value
  1.  ;; X contains string on which to perform the strip operation
  1.  ;; Y contains character(s) to strip
  1.  Q $TR($G(X),$G(Y),"")
  1.  ;;
  1. REPLACE(STR,X,Y) ;; Performs a character in 'Y' for character
  1.  ;; in 'X' replace within string 'STR'.
  1.  ;; Call by value
  1.  ;; STR is the string on which to perform the replace operation
  1.  ;; X is the characters to replace
  1.  ;; Y is the translated characters
  1.  ;; ** NOTE ** X AND Y MUST BE IN THE EXACT SAME ORDER ****
  1.  ;; X="ABC" Y="XYZ" all occurances of A will be replaced with X
  1.  ;; B with Y and C with Z
  1.  ;; X="AKZ" Y="Z" every occurance of A will be replaced with Z
  1.  ;; and K and Z will be replaced by "" (NULL)
  1.  Q $TR($G(STR),$G(X),$G(Y))
  1.  ;;
  1. REPEAT(X,Y) ;;
  1.  ;; Call by value
  1.  ;; X is the character that you wish repeated
  1.  ;; Y is the number of repetitions
  1.  ;;** NOTE ** $L(X)*Y must not be greater than 254
  1.  ;; eg. S X=$$REPEAT("-",10)  returns "----------"
  1.  N LRPER
  1.  I $L($G(X))*$G(Y)>254 Q ""
  1.  S LRPER="",$P(LRPER,$G(X),+$G(Y)+1)=""
  1.  Q LRPER
  1.  ;;
  1. INVERT(X) ;;
  1.  ;; Call by value
  1.  ;; Returns String in X in inverted order ABC => CBA
  1.  N I,Y
  1.  I $L($G(X))>254 Q ""
  1.  S Y=""
  1.  F I=$L(X):-1:0 S Y=Y_$E(X,I)
  1.  Q Y
  1.  ;;
  1. GLBR(LRR) ;;
  1.  ;; Call by value
  1.  ;; Returns the global root with extended systax if the global
  1.  ;;  is translated. Useful when using $Q on MSM systems
  1.  N LRC,LRF,LRG,LRI,LRR1,LRR2,LRZ
  1.  S LRR1=$P(LRR,"(")_"(" I $E(LRR1)="^" S LRR2=$P($Q(@(LRR1_""""")")),"(")_"(" S:$P(LRR2,"(")]"" LRR1=LRR2
  1.  S LRR2=$P($E(LRR,1,($L(LRR)-($E(LRR,$L(LRR))=")"))),"(",2,99)
  1.  S LRC=$L(LRR2,","),LRF=1 F LRI=1:1:LRC S LRG=$P(LRR2,",",LRF,LRI) Q:LRG=""  D
  1.  . I ($L(LRG,"(")=$L(LRG,")")&($L(LRG,"""")#2))!(($L(LRG,"""")#2)&($E(LRG)="""")&($E(LRG,$L(LRG))="""")) S LRG=$$S(LRG),$P(LRR2,",",LRF,LRI)=LRG,LRF=LRF+$L(LRG,","),LRI=LRF-1
  1.  Q LRR1_LRR2
  1. S(LRZ) ;
  1.  I $G(LRZ)']"" Q ""
  1.  I $E(LRZ)'="""",$L(LRZ,"E")=2,+$P(LRZ,"E")=$P(LRZ,"E"),+$P(LRZ,"E",2)=$P(LRZ,"E",2) Q +LRZ
  1.  I +LRZ=LRZ Q LRZ
  1.  I LRZ="""""" Q ""
  1.  I $E(LRZ)'?1A,"LR$+@"'[$E(LRZ) Q LRZ
  1.  I "+$"[$E(LRZ) X "S LRZ="_LRZ Q $$Q(LRZ)
  1.  I $D(@LRZ) Q $$Q(@LRZ)
  1.  Q LRZ
  1. Q(LRZ) ;
  1.  S LRZ(LRZ)="",LRZ=$Q(LRZ("")) Q $E(LRZ,4,$L(LRZ)-1)
  1.  ;;
  1.  ;;
  1.  Q
  1. LRPNM(X) ;;Call by value
  1.  ;; change value to upper case string
  1.  ;; removes spaces after comma
  1.  ;; removes double spaces and spaces at the end of the string
  1.  ;; generally used to format patient names
  1.  N Y,I
  1.  S X=$$UPCASE(X)
  1.  ; -- no space after comma and no double spaces
  1.  F Y=", ","  " F  Q:'$F(X,Y)  S X=$E(X,1,($F(X,Y)-2))_$E(X,$F(X,Y),$L(X))
  1.  ; -- no space at the end
  1.  F  Q:$E(X,$L(X))'=" "  S X=$E(X,1,$L(X)-1)
  1.  Q X