| 1 | USRLS ; SLC/JER - String functions for ASU ;09/22/1998
|
|---|
| 2 | ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,9**;Jun 20, 1997
|
|---|
| 3 | ;======================================================================
|
|---|
| 4 | CENTER(X) ; Center X
|
|---|
| 5 | N SP
|
|---|
| 6 | S $P(SP," ",((IOM-$L(X))\2))=""
|
|---|
| 7 | Q $G(SP)_X
|
|---|
| 8 | ;======================================================================
|
|---|
| 9 | DATE(X,FMT) ; Call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
|
|---|
| 10 | N AMTH,MM,CC,DD,YY,GMRDI,GMRDTMP
|
|---|
| 11 | I +X'>0 S $P(GMRDTMP," ",$L($G(FMT))+1)="",FMT=GMRDTMP G QDATE
|
|---|
| 12 | I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/YY"
|
|---|
| 13 | S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X)
|
|---|
| 14 | S:FMT["AMTH" AMTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
|
|---|
| 15 | F GMRDI="AMTH","MM","DD","CC","YY" S:FMT[GMRDI FMT=$P(FMT,GMRDI)_@GMRDI_$P(FMT,GMRDI,2)
|
|---|
| 16 | I FMT["HR" S FMT=$$TIME(X,FMT)
|
|---|
| 17 | QDATE Q FMT
|
|---|
| 18 | ;======================================================================
|
|---|
| 19 | MIXED(X) ; Return Mixed Case X
|
|---|
| 20 | N USRI,WORD,TMP
|
|---|
| 21 | S TMP="" F USRI=1:1:$L(X," ") S WORD=$$UP^XLFSTR($E($P(X," ",USRI)))_$$LOW^XLFSTR($E($P(X," ",USRI),2,$L($P(X," ",USRI)))),TMP=$S(TMP="":WORD,1:TMP_" "_WORD)
|
|---|
| 22 | Q TMP
|
|---|
| 23 | ;======================================================================
|
|---|
| 24 | SIGNAME(GMDA) ; Get/Return Signature Block Printed Name
|
|---|
| 25 | N MSG,NAME,SBPN
|
|---|
| 26 | S NAME=$P(^VA(200,+GMDA,0),U,1)
|
|---|
| 27 | S SBPN=$P($G(^VA(200,+GMDA,20)),U,2)
|
|---|
| 28 | I SBPN="" D
|
|---|
| 29 | . S NAME=NAME_" (?SBPN)"
|
|---|
| 30 | Q NAME
|
|---|
| 31 | ;======================================================================
|
|---|
| 32 | TIME(X,FMT) ; Recieves X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
|
|---|
| 33 | N HR,MIN,SEC,TIUI
|
|---|
| 34 | I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="HR:MIN"
|
|---|
| 35 | S X=$P(X,".",2),HR=$E(X,1,2)_$E("00",0,2-$L($E(X,1,2))),MIN=$E(X,3,4)_$E("00",0,2-$L($E(X,3,4))),SEC=$E(X,5,6)_$E("00",0,2-$L($E(X,5,6)))
|
|---|
| 36 | F TIUI="HR","MIN","SEC" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2)
|
|---|
| 37 | Q FMT
|
|---|
| 38 | ;======================================================================
|
|---|
| 39 | UPPER(X) ; Convert lower case X to UPPER CASE
|
|---|
| 40 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 41 | ;======================================================================
|
|---|
| 42 | WRAP(TEXT,LENGTH) ; Breaks text string into substrings of length LENGTH
|
|---|
| 43 | N USRI,USRJ,LINE,USRX,USRX1,USRX2,USRY
|
|---|
| 44 | I $G(TEXT)']"" Q ""
|
|---|
| 45 | F USRI=1:1 D Q:USRI=$L(TEXT," ")
|
|---|
| 46 | . S USRX=$P(TEXT," ",USRI)
|
|---|
| 47 | . I $L(USRX)>LENGTH D
|
|---|
| 48 | . . S USRX1=$E(USRX,1,LENGTH),USRX2=$E(USRX,LENGTH+1,$L(USRX))
|
|---|
| 49 | . . S $P(TEXT," ",USRI)=USRX1_" "_USRX2
|
|---|
| 50 | S LINE=1,USRX(1)=$P(TEXT," ")
|
|---|
| 51 | F USRI=2:1 D Q:USRI'<$L(TEXT," ")
|
|---|
| 52 | . S:$L($G(USRX(LINE))_" "_$P(TEXT," ",USRI))>LENGTH LINE=LINE+1,USRY=1
|
|---|
| 53 | . S USRX(LINE)=$G(USRX(LINE))_$S(+$G(USRY):"",1:" ")_$P(TEXT," ",USRI),USRY=0
|
|---|
| 54 | S USRJ=0,TEXT="" F USRI=1:1 S USRJ=$O(USRX(USRJ)) Q:+USRJ'>0 S TEXT=TEXT_$S(USRI=1:"",1:"|")_USRX(USRJ)
|
|---|
| 55 | Q TEXT
|
|---|
