| 1 | BPSOSU9 ;BHAM ISC/FCS/DRS/FLS - copied for ECME ;06/01/2004
 | 
|---|
| 2 |  ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
 | 
|---|
| 3 |  ;----------------------------------------------------------------------
 | 
|---|
| 4 |  ;----------------------------------------------------------------------
 | 
|---|
| 5 |  ;Standard W and String Formatting Functions
 | 
|---|
| 6 |  ;----------------------------------------------------------------------
 | 
|---|
| 7 | WCENTER(TEXT,IOM,UL) ;EP
 | 
|---|
| 8 |  S:$G(IOM)="" IOM=80
 | 
|---|
| 9 |  W ?IOM-$L(TEXT)/2,TEXT,!
 | 
|---|
| 10 |  I $G(UL) W ?IOM-$L(TEXT)/2,$TR($J("",$L(TEXT))," ","-"),!
 | 
|---|
| 11 |  Q
 | 
|---|
| 12 |  ;----------------------------------------------------------------------
 | 
|---|
| 13 |  ;W Standard Underlined HEADER
 | 
|---|
| 14 | WHEADER(TEXT,IOF,IOM) ;EP
 | 
|---|
| 15 |  Q:$G(TEXT)=""
 | 
|---|
| 16 |  S:$G(IOF)="" IOF="#"
 | 
|---|
| 17 |  S:$G(IOM)="" IOM=80
 | 
|---|
| 18 |  W @IOF,!
 | 
|---|
| 19 |  D WCENTER(TEXT,IOM)
 | 
|---|
| 20 |  D WCENTER($TR($J("",$L(TEXT))," ","-"),IOM)
 | 
|---|
| 21 |  Q
 | 
|---|
| 22 |  ;----------------------------------------------------------------------
 | 
|---|
| 23 |  ;W Column HEADERs (with option to underline)
 | 
|---|
| 24 | WCOLUMNS(INDENT,COLDEFS,CNAMES,ULINE) ;EP
 | 
|---|
| 25 |  N CHEAD1,CHEAD2,INDEX,CDEF
 | 
|---|
| 26 |  Q:$G(CNAMES)=""
 | 
|---|
| 27 |  S:$G(INDENT)="" INDENT=0
 | 
|---|
| 28 |  S:$G(COLDEFS)="" COLDEFS=2
 | 
|---|
| 29 |  S:$G(ULINE)="" ULINE=1
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 |  S COLDEFS=$J("",COLDEFS)
 | 
|---|
| 32 |  S (CHEAD1,CHEAD2)=""
 | 
|---|
| 33 |  F INDEX=1:1:$L(CNAMES,",") D
 | 
|---|
| 34 |  .S CDEF=$P(CNAMES,",",INDEX)
 | 
|---|
| 35 |  .S CHEAD1=CHEAD1_$S(INDEX=1:"",1:COLDEFS)_$$LJBF($P(CDEF,":",1),$P(CDEF,":",2))
 | 
|---|
| 36 |  .S:ULINE CHEAD2=CHEAD2_$S(INDEX=1:"",1:COLDEFS)_$TR($J("",$P(CDEF,":",2))," ","-")
 | 
|---|
| 37 |  W ?INDENT,CHEAD1,!
 | 
|---|
| 38 |  W:ULINE ?INDENT,CHEAD2,!
 | 
|---|
| 39 |  Q
 | 
|---|
| 40 |  ;----------------------------------------------------------------------
 | 
|---|
| 41 | WDATA(INDENT,COLDEFS,VNAMES) ;EP
 | 
|---|
| 42 |  N INDEX,DEF,DLINE,VAR,LEN
 | 
|---|
| 43 |  Q:$G(VNAMES)=""
 | 
|---|
| 44 |  S:$G(INDENT)="" INDENT=0
 | 
|---|
| 45 |  S:$G(COLDEFS)="" COLDEFS=2
 | 
|---|
| 46 |  ;
 | 
|---|
| 47 |  S COLDEFS=$J("",COLDEFS)
 | 
|---|
| 48 |  S DLINE=""
 | 
|---|
| 49 |  F INDEX=1:1:$L(VNAMES,",") D
 | 
|---|
| 50 |  .S DEF=$P(VNAMES,",",INDEX)
 | 
|---|
| 51 |  .S VAR=$P(DEF,":",1)
 | 
|---|
| 52 |  .S LEN=$P(DEF,":",2)
 | 
|---|
| 53 |  .S DLINE=DLINE_$S(INDEX=1:"",1:COLDEFS)_$$LJBF($S(VAR="":"",1:$G(@VAR)),LEN)
 | 
|---|
| 54 |  W ?INDENT,DLINE,!
 | 
|---|
| 55 |  Q
 | 
|---|
| 56 |  ;
 | 
|---|
| 57 |  ;----------------------------------------------------------------------
 | 
|---|
| 58 |  ;Left justifies and blank fills
 | 
|---|
| 59 | LJBF(X,L) ;EP
 | 
|---|
| 60 |  Q $E(X_$J("",L-$L(X)),1,L)
 | 
|---|
| 61 |  ;----------------------------------------------------------------------
 | 
|---|
| 62 |  ;Right justifies and blank fills
 | 
|---|
| 63 | RJBF(X,L) ;EP
 | 
|---|
| 64 |  Q $E($J("",L-$L(X))_X,1,L)
 | 
|---|
| 65 |  ;----------------------------------------------------------------------
 | 
|---|
| 66 |  ;CENTER justifies and blank fills
 | 
|---|
| 67 | CJBF(X,L) ;
 | 
|---|
| 68 |  Q $$LJBF($E($J("",(L-$L(X))\2)_X,1,L),L)
 | 
|---|
| 69 |  ;----------------------------------------------------------------------
 | 
|---|
| 70 |  ;Convert lower case characters to upper case characters
 | 
|---|
| 71 | UCASE(X) ;EP
 | 
|---|
| 72 |  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 | 
|---|
| 73 |  ;----------------------------------------------------------------------
 | 
|---|
| 74 |  ;Convert upper case characters to lower case characters
 | 
|---|
| 75 | LCASE(X) ;
 | 
|---|
| 76 |  Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
 | 
|---|
| 77 |  ;----------------------------------------------------------------------
 | 
|---|
| 78 |  ;Delete leading and trailing blanks
 | 
|---|
| 79 | CLIP(X) ;EP
 | 
|---|
| 80 |  F  D  Q:$E(X,1)'=" "
 | 
|---|
| 81 |  .S:$E(X,1)=" " X=$E(X,2,$L(X))
 | 
|---|
| 82 |  F  D  Q:$E(X,$L(X))'=" "
 | 
|---|
| 83 |  .S:$E(X,$L(X))=" " X=$E(X,1,$L(X)-1)
 | 
|---|
| 84 |  Q X
 | 
|---|