source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSU9.m@ 699

Last change on this file since 699 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1BPSOSU9 ;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 ;----------------------------------------------------------------------
7WCENTER(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
14WHEADER(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)
24WCOLUMNS(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 ;----------------------------------------------------------------------
41WDATA(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
59LJBF(X,L) ;EP
60 Q $E(X_$J("",L-$L(X)),1,L)
61 ;----------------------------------------------------------------------
62 ;Right justifies and blank fills
63RJBF(X,L) ;EP
64 Q $E($J("",L-$L(X))_X,1,L)
65 ;----------------------------------------------------------------------
66 ;CENTER justifies and blank fills
67CJBF(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
71UCASE(X) ;EP
72 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
73 ;----------------------------------------------------------------------
74 ;Convert upper case characters to lower case characters
75LCASE(X) ;
76 Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
77 ;----------------------------------------------------------------------
78 ;Delete leading and trailing blanks
79CLIP(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
Note: See TracBrowser for help on using the repository browser.