- USRLS ; SLC/JER - String functions for ASU ;09/22/1998
- ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,9**;Jun 20, 1997
- ;======================================================================
- CENTER(X) ; Center X
- N SP
- S $P(SP," ",((IOM-$L(X))\2))=""
- Q $G(SP)_X
- ;======================================================================
- DATE(X,FMT) ; Call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
- N AMTH,MM,CC,DD,YY,GMRDI,GMRDTMP
- I +X'>0 S $P(GMRDTMP," ",$L($G(FMT))+1)="",FMT=GMRDTMP G QDATE
- I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/YY"
- S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X)
- S:FMT["AMTH" AMTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
- F GMRDI="AMTH","MM","DD","CC","YY" S:FMT[GMRDI FMT=$P(FMT,GMRDI)_@GMRDI_$P(FMT,GMRDI,2)
- I FMT["HR" S FMT=$$TIME(X,FMT)
- QDATE Q FMT
- ;======================================================================
- MIXED(X) ; Return Mixed Case X
- N USRI,WORD,TMP
- 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)
- Q TMP
- ;======================================================================
- SIGNAME(GMDA) ; Get/Return Signature Block Printed Name
- N MSG,NAME,SBPN
- S NAME=$P(^VA(200,+GMDA,0),U,1)
- S SBPN=$P($G(^VA(200,+GMDA,20)),U,2)
- I SBPN="" D
- . S NAME=NAME_" (?SBPN)"
- Q NAME
- ;======================================================================
- TIME(X,FMT) ; Recieves X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
- N HR,MIN,SEC,TIUI
- I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="HR:MIN"
- 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)))
- F TIUI="HR","MIN","SEC" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2)
- Q FMT
- ;======================================================================
- UPPER(X) ; Convert lower case X to UPPER CASE
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- ;======================================================================
- WRAP(TEXT,LENGTH) ; Breaks text string into substrings of length LENGTH
- N USRI,USRJ,LINE,USRX,USRX1,USRX2,USRY
- I $G(TEXT)']"" Q ""
- F USRI=1:1 D Q:USRI=$L(TEXT," ")
- . S USRX=$P(TEXT," ",USRI)
- . I $L(USRX)>LENGTH D
- . . S USRX1=$E(USRX,1,LENGTH),USRX2=$E(USRX,LENGTH+1,$L(USRX))
- . . S $P(TEXT," ",USRI)=USRX1_" "_USRX2
- S LINE=1,USRX(1)=$P(TEXT," ")
- F USRI=2:1 D Q:USRI'<$L(TEXT," ")
- . S:$L($G(USRX(LINE))_" "_$P(TEXT," ",USRI))>LENGTH LINE=LINE+1,USRY=1
- . S USRX(LINE)=$G(USRX(LINE))_$S(+$G(USRY):"",1:" ")_$P(TEXT," ",USRI),USRY=0
- 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)
- Q TEXT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HUSRLS 2784 printed Jan 18, 2025@02:40:05 Page 2
- USRLS ; SLC/JER - String functions for ASU ;09/22/1998
- +1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,9**;Jun 20, 1997
- +2 ;======================================================================
- CENTER(X) ; Center X
- +1 NEW SP
- +2 SET $PIECE(SP," ",((IOM-$LENGTH(X))\2))=""
- +3 QUIT $GET(SP)_X
- +4 ;======================================================================
- DATE(X,FMT) ; Call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
- +1 NEW AMTH,MM,CC,DD,YY,GMRDI,GMRDTMP
- +2 IF +X'>0
- SET $PIECE(GMRDTMP," ",$LENGTH($GET(FMT))+1)=""
- SET FMT=GMRDTMP
- GOTO QDATE
- +3 IF $SELECT('$DATA(FMT):1,'$LENGTH(FMT):1,1:0)
- SET FMT="MM/DD/YY"
- +4 SET MM=$EXTRACT(X,4,5)
- SET DD=$EXTRACT(X,6,7)
- SET YY=$EXTRACT(X,2,3)
- SET CC=17+$EXTRACT(X)
- +5 if FMT["AMTH"
- SET AMTH=$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
- +6 FOR GMRDI="AMTH","MM","DD","CC","YY"
- if FMT[GMRDI
- SET FMT=$PIECE(FMT,GMRDI)_@GMRDI_$PIECE(FMT,GMRDI,2)
- +7 IF FMT["HR"
- SET FMT=$$TIME(X,FMT)
- QDATE QUIT FMT
- +1 ;======================================================================
- MIXED(X) ; Return Mixed Case X
- +1 NEW USRI,WORD,TMP
- +2 SET TMP=""
- FOR USRI=1:1:$LENGTH(X," ")
- SET WORD=$$UP^XLFSTR($EXTRACT($PIECE(X," ",USRI)))_$$LOW^XLFSTR($EXTRACT($PIECE(X," ",USRI),2,$LENGTH($PIECE(X," ",USRI))))
- SET TMP=$SELECT(TMP="":WORD,1:TMP_" "_WORD)
- +3 QUIT TMP
- +4 ;======================================================================
- SIGNAME(GMDA) ; Get/Return Signature Block Printed Name
- +1 NEW MSG,NAME,SBPN
- +2 SET NAME=$PIECE(^VA(200,+GMDA,0),U,1)
- +3 SET SBPN=$PIECE($GET(^VA(200,+GMDA,20)),U,2)
- +4 IF SBPN=""
- Begin DoDot:1
- +5 SET NAME=NAME_" (?SBPN)"
- End DoDot:1
- +6 QUIT NAME
- +7 ;======================================================================
- TIME(X,FMT) ; Recieves X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
- +1 NEW HR,MIN,SEC,TIUI
- +2 IF $SELECT('$DATA(FMT):1,'$LENGTH(FMT):1,1:0)
- SET FMT="HR:MIN"
- +3 SET X=$PIECE(X,".",2)
- SET HR=$EXTRACT(X,1,2)_$EXTRACT("00",0,2-$LENGTH($EXTRACT(X,1,2)))
- SET MIN=$EXTRACT(X,3,4)_$EXTRACT("00",0,2-$LENGTH($EXTRACT(X,3,4)))
- SET SEC=$EXTRACT(X,5,6)_$EXTRACT("00",0,2-$LENGTH($EXTRACT(X,5,6)))
- +4 FOR TIUI="HR","MIN","SEC"
- if FMT[TIUI
- SET FMT=$PIECE(FMT,TIUI)_@TIUI_$PIECE(FMT,TIUI,2)
- +5 QUIT FMT
- +6 ;======================================================================
- UPPER(X) ; Convert lower case X to UPPER CASE
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +2 ;======================================================================
- WRAP(TEXT,LENGTH) ; Breaks text string into substrings of length LENGTH
- +1 NEW USRI,USRJ,LINE,USRX,USRX1,USRX2,USRY
- +2 IF $GET(TEXT)']""
- QUIT ""
- +3 FOR USRI=1:1
- Begin DoDot:1
- +4 SET USRX=$PIECE(TEXT," ",USRI)
- +5 IF $LENGTH(USRX)>LENGTH
- Begin DoDot:2
- +6 SET USRX1=$EXTRACT(USRX,1,LENGTH)
- SET USRX2=$EXTRACT(USRX,LENGTH+1,$LENGTH(USRX))
- +7 SET $PIECE(TEXT," ",USRI)=USRX1_" "_USRX2
- End DoDot:2
- End DoDot:1
- if USRI=$LENGTH(TEXT," ")
- QUIT
- +8 SET LINE=1
- SET USRX(1)=$PIECE(TEXT," ")
- +9 FOR USRI=2:1
- Begin DoDot:1
- +10 if $LENGTH($GET(USRX(LINE))_" "_$PIECE(TEXT," ",USRI))>LENGTH
- SET LINE=LINE+1
- SET USRY=1
- +11 SET USRX(LINE)=$GET(USRX(LINE))_$SELECT(+$GET(USRY):"",1:" ")_$PIECE(TEXT," ",USRI)
- SET USRY=0
- End DoDot:1
- if USRI'<$LENGTH(TEXT," ")
- QUIT
- +12 SET USRJ=0
- SET TEXT=""
- FOR USRI=1:1
- SET USRJ=$ORDER(USRX(USRJ))
- if +USRJ'>0
- QUIT
- SET TEXT=TEXT_$SELECT(USRI=1:"",1:"|")_USRX(USRJ)
- +13 QUIT TEXT