- RGUT ;CAIRO/DKM - General purpose utilities;17-Sep-1998 14:14;DKM
- ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
- ;=================================================================
- ; Replaces delimited arguments in string, returning result
- MSG(%RGTXT,%RGDLM) ;
- N %RGZ1,%RGZ2
- I $$NEWERR^%ZTER N $ET S $ET=""
- S:$G(%RGDLM)="" %RGDLM="%"
- S %RGZ2="",%RGTXT=$TR(%RGTXT,"~","^"),@$$TRAP^RGZOSF("M1^RGUT")
- F Q:%RGTXT="" D
- .S %RGZ2=%RGZ2_$P(%RGTXT,%RGDLM),%RGZ1=$P(%RGTXT,%RGDLM,2),%RGTXT=$P(%RGTXT,%RGDLM,3,999)
- .I %RGZ1="" S:%RGTXT'="" %RGZ2=%RGZ2_%RGDLM
- .E X "S %RGZ2=%RGZ2_("_%RGZ1_")"
- M1 Q %RGZ2
- ; Case-insensitive string comparison
- ; Returns 0: X=Y, 1: X>Y, -1: X<Y
- STRICMP(X,Y) ;
- S X=$$UP^XLFSTR(X),Y=$$UP^XLFSTR(Y)
- Q $S(X=Y:0,X]]Y:1,1:-1)
- ; Output an underline X bytes long
- UND(X) Q $$REPEAT^XLFSTR("-",$G(X,$G(IOM,80)))
- ; Truncate a string if > Y bytes long
- TRUNC(X,Y) ;
- Q $S($L(X)'>Y:X,1:$E(X,1,Y-3)_"...")
- ; Formatting for singular/plural
- SNGPLR(RGNUM,RGSNG,RGPLR) ;
- N RGZ
- S RGZ=RGSNG?.E1L.E,RGPLR=$G(RGPLR,RGSNG_$S(RGZ:"s",1:"S"))
- Q $S('RGNUM:$S(RGZ:"no ",1:"NO ")_RGPLR,RGNUM=1:"1 "_RGSNG,1:RGNUM_" "_RGPLR)
- ; Convert code to external form from set of codes
- SET(RGCODE,RGSET) ;
- N RGZ,RGZ1
- F RGZ=1:1:$L(RGSET,";") D Q:RGZ1'=""
- .S RGZ1=$P(RGSET,";",RGZ),RGZ1=$S($P(RGZ1,":")=RGCODE:$P(RGZ1,":",2),1:"")
- Q RGZ1
- ; Replace each occurrence of RGOLD in RGSTR with RGNEW
- SUBST(RGSTR,RGOLD,RGNEW) ;
- N RGP,RGL1,RGL2
- S RGNEW=$G(RGNEW),RGP=0,RGL1=$L(RGOLD),RGL2=$L(RGNEW)
- F S RGP=$F(RGSTR,RGOLD,RGP) Q:'RGP D
- .S RGSTR=$E(RGSTR,1,RGP-RGL1-1)_RGNEW_$E(RGSTR,RGP,9999)
- .S RGP=RGP-RGL1+RGL2
- Q RGSTR
- ; Trim leading (Y=-1)/trailing (Y=1)/leading & trailing (Y=0) spaces
- TRIM(X,Y) ;
- N RGZ1,RGZ2
- S Y=+$G(Y),RGZ1=1,RGZ2=$L(X)
- I Y'>0 F RGZ1=1:1 Q:$A(X,RGZ1)'=32
- I Y'<0 F RGZ2=RGZ2:-1 Q:$A(X,RGZ2)'=32
- Q $E(X,RGZ1,RGZ2)
- ; Format a number with commas
- FMTNUM(RGNUM) ;
- N RGZ,RGZ1,RGZ2
- S:RGNUM<0 RGNUM=-RGNUM,RGZ2="-"
- F RGZ=$L(RGNUM):-3:1 S RGZ1=$E(RGNUM,RGZ-2,RGZ)_$S($D(RGZ1):","_RGZ1,1:"")
- Q $G(RGZ2)_$G(RGZ1)
- ; Convert X to base Y padded to length L
- BASE(X,Y,L) ;
- Q:(Y<2)!(Y>62) ""
- N RGZ,RGZ1
- S RGZ1="",X=$S(X<0:-X,1:X)
- F S RGZ=X#Y,X=X\Y,RGZ1=$C($S(RGZ<10:RGZ+48,RGZ<36:RGZ+55,1:RGZ+61))_RGZ1 Q:'X
- Q $S('$G(L):RGZ1,1:$$REPEAT^XLFSTR(0,L-$L(RGZ1))_$E(RGZ1,1,L))
- ; Convert a string to its SOUNDEX equivalent
- SOUNDEX(RGVALUE) ;
- N RGCODE,RGSOUND,RGPREV,RGCHAR,RGPOS,RGTRANS
- S RGCODE="01230129022455012623019202"
- S RGSOUND=$C($A(RGVALUE)-(RGVALUE?1L.E*32))
- S RGPREV=$E(RGCODE,$A(RGVALUE)-64)
- F RGPOS=2:1 S RGCHAR=$E(RGVALUE,RGPOS) Q:","[RGCHAR D Q:$L(RGSOUND)=4
- .Q:RGCHAR'?1A
- .S RGTRANS=$E(RGCODE,$A(RGCHAR)-$S(RGCHAR?1U:64,1:96))
- .Q:RGTRANS=RGPREV!(RGTRANS=9)
- .S RGPREV=RGTRANS
- .S:RGTRANS'=0 RGSOUND=RGSOUND_RGTRANS
- Q $E(RGSOUND_"000",1,4)
- ; Display formatted title
- TITLE(RGTTL,RGVER,RGFN) ;
- I '$D(IOM) N IOM,IOF S IOM=80,IOF="#"
- S RGVER=$G(RGVER,"1.0")
- S:RGVER RGVER="Version "_RGVER
- U $G(IO,$I)
- W @IOF,$S(IO=IO(0):$C(27,91,55,109),1:""),*13,$$^RGCVTDT(+$H_","),?(IOM-$L(RGTTL)\2),RGTTL,?(IOM-$L(RGVER)),RGVER,!,$S(IO=IO(0):$C(27,91,109),1:$$UND),!
- W:$D(RGFN) ?(IOM-$L(RGFN)\2),RGFN,!
- Q
- ; Create a unique 8.3 filename
- UFN(Y) N X
- S Y=$E($G(Y),1,3),X=$$BASE($R(100)_$J_$TR($H,","),36,$S($L(Y):8,1:11))_Y
- Q $E(X,1,8)_"."_$E(X,9,11)
- ; Return formatted SSN
- SSN(X) Q $S(X="":X,1:$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,12))
- ; Performs security check on patient access
- DGSEC(Y) N DIC
- S DIC(0)="E"
- D ^DGSEC
- Q $S(Y<1:0,1:Y)
- ; Displays spinning icon to indicate progress
- WORKING(RGST,RGP,RGS) ;
- Q:'$D(IO(0))!$D(ZTQUEUED) 0
- N RGZ
- S RGZ(0)=$I,RGS=$G(RGS,"|/-\"),RGST=+$G(RGST)
- S RGST=$S(RGST<0:0,1:RGST#$L(RGS)+1)
- U IO(0)
- W:'$G(RGP) *8,$S(RGST:$E(RGS,RGST),1:" ")
- R *RGZ:0
- U RGZ(0)
- Q RGZ=94
- ; Ask for Y/N response
- ASK(RGP,RGD,RGZ) ;
- S RGD=$G(RGD,"N")
- S RGZ=$$GETCH(RGP_"? ","YN")
- S:RGZ="" RGZ=$E(RGD)
- W !
- Q $S(RGZ[U:"",1:RGZ="Y")
- ; Pause for user response
- PAUSE(RGP,RGX,RGY) ;
- Q $$GETCH($G(RGP,"Press RETURN or ENTER to continue..."),U,.RGX,.RGY)
- ; Single character read
- GETCH(RGP,RGV,RGX,RGY,RGT,RGD) ;
- N RGZ,RGC
- W:$D(RGX)!$D(RGY) $$XY($G(RGX,$X),$G(RGY,$Y))
- W $G(RGP)
- S RGT=$G(RGT,$G(DTIME,999999999999)),RGD=$G(RGD,U),RGC=""
- S:$D(RGV) RGV=$$UP^XLFSTR(RGV)_U
- F D Q:'$L(RGZ)
- .R RGZ#1:RGT
- .E S RGC=RGD Q
- .W *8
- .Q:'$L(RGZ)
- .S RGZ=$$UP^XLFSTR(RGZ)
- .I $D(RGV) D
- ..I RGV[RGZ S RGC=RGZ
- ..E W *7,*32,*8 S RGC=""
- .E S RGC=RGZ
- W !
- Q RGC
- ; Position cursor
- XY(DX,DY) ;
- D:$G(IOXY)="" HOME^%ZIS
- S DX=$S(+$G(DX)>0:+DX,1:0),DY=$S(+$G(DY)>0:+DY,1:0),$X=0
- X IOXY
- S $X=DX,$Y=DY
- Q ""
- ; Parameterized calls to date routines
- %DT(RGD,RGX) ;
- N %D,%P,%C,%H,%I,%X,%Y,RGZ
- D DT^DILF($G(RGX),RGD,.RGZ)
- W:$D(RGZ(0)) RGZ(0),!
- Q $G(RGZ,-1)
- %DTC(X1,X2) ;
- N X3
- S X2=$$%DTF(X1)+X2,X1=X1\1,X3=X2\1,X2=X2-X3
- S:X2<0 X3=X3-1,X2=X2+1
- Q $$FMADD^XLFDT(X1,X3)+$J($$%DTT(X2),0,6)
- %DTD(X1,X2) ;
- Q $$FMDIFF^XLFDT(X1\1,X2\1)+($$%DTF(X1)-$$%DTF(X2))
- %DTF(X) S X=X#1*100
- Q X\1*3600+(X*100#100\1*60)+(X*10000#100)/86400
- %DTT(X) S X=X*86400
- Q X\3600*100+(X#3600/3600*60)/10000
- ; THE FOLLOWING ENTRY POINTS WILL BE PHASED OUT IN FAVOR OF
- ; THEIR EQUIVALENTS WITHIN KERNEL
- ; Normalize global root
- GBL(RGGBL) ;
- Q $$CREF^DILF(RGGBL)
- ; Convert lower to upper case
- UPCASE(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- ; Convert upper to lower case
- LOCASE(X) Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- ; Return a string of X repeated Y times
- RPT(X,Y) Q $$REPEAT^XLFSTR(X,Y)
- %DTDW(X) Q $$DOW^XLFDT(X)
- %DTDOW(X) ;
- Q $$DOW^XLFDT(X,1)
- %DTNOW() Q $$NOW^XLFDT
- %DTH(X) Q $$FMTH^XLFDT(X)
- %DTYX(X) Q $$HTFM^XLFDT(X)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGUT 5781 printed Jan 18, 2025@03:38:17 Page 2
- RGUT ;CAIRO/DKM - General purpose utilities;17-Sep-1998 14:14;DKM
- +1 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
- +2 ;=================================================================
- +3 ; Replaces delimited arguments in string, returning result
- MSG(%RGTXT,%RGDLM) ;
- +1 NEW %RGZ1,%RGZ2
- +2 IF $$NEWERR^%ZTER
- NEW $ETRAP
- SET $ETRAP=""
- +3 if $GET(%RGDLM)=""
- SET %RGDLM="%"
- +4 SET %RGZ2=""
- SET %RGTXT=$TRANSLATE(%RGTXT,"~","^")
- SET @$$TRAP^RGZOSF("M1^RGUT")
- +5 FOR
- if %RGTXT=""
- QUIT
- Begin DoDot:1
- +6 SET %RGZ2=%RGZ2_$PIECE(%RGTXT,%RGDLM)
- SET %RGZ1=$PIECE(%RGTXT,%RGDLM,2)
- SET %RGTXT=$PIECE(%RGTXT,%RGDLM,3,999)
- +7 IF %RGZ1=""
- if %RGTXT'=""
- SET %RGZ2=%RGZ2_%RGDLM
- +8 IF '$TEST
- XECUTE "S %RGZ2=%RGZ2_("_%RGZ1_")"
- End DoDot:1
- M1 QUIT %RGZ2
- +1 ; Case-insensitive string comparison
- +2 ; Returns 0: X=Y, 1: X>Y, -1: X<Y
- STRICMP(X,Y) ;
- +1 SET X=$$UP^XLFSTR(X)
- SET Y=$$UP^XLFSTR(Y)
- +2 QUIT $SELECT(X=Y:0,X]]Y:1,1:-1)
- +3 ; Output an underline X bytes long
- UND(X) QUIT $$REPEAT^XLFSTR("-",$GET(X,$GET(IOM,80)))
- +1 ; Truncate a string if > Y bytes long
- TRUNC(X,Y) ;
- +1 QUIT $SELECT($LENGTH(X)'>Y:X,1:$EXTRACT(X,1,Y-3)_"...")
- +2 ; Formatting for singular/plural
- SNGPLR(RGNUM,RGSNG,RGPLR) ;
- +1 NEW RGZ
- +2 SET RGZ=RGSNG?.E1L.E
- SET RGPLR=$GET(RGPLR,RGSNG_$SELECT(RGZ:"s",1:"S"))
- +3 QUIT $SELECT('RGNUM:$SELECT(RGZ:"no ",1:"NO ")_RGPLR,RGNUM=1:"1 "_RGSNG,1:RGNUM_" "_RGPLR)
- +4 ; Convert code to external form from set of codes
- SET(RGCODE,RGSET) ;
- +1 NEW RGZ,RGZ1
- +2 FOR RGZ=1:1:$LENGTH(RGSET,";")
- Begin DoDot:1
- +3 SET RGZ1=$PIECE(RGSET,";",RGZ)
- SET RGZ1=$SELECT($PIECE(RGZ1,":")=RGCODE:$PIECE(RGZ1,":",2),1:"")
- End DoDot:1
- if RGZ1'=""
- QUIT
- +4 QUIT RGZ1
- +5 ; Replace each occurrence of RGOLD in RGSTR with RGNEW
- SUBST(RGSTR,RGOLD,RGNEW) ;
- +1 NEW RGP,RGL1,RGL2
- +2 SET RGNEW=$GET(RGNEW)
- SET RGP=0
- SET RGL1=$LENGTH(RGOLD)
- SET RGL2=$LENGTH(RGNEW)
- +3 FOR
- SET RGP=$FIND(RGSTR,RGOLD,RGP)
- if 'RGP
- QUIT
- Begin DoDot:1
- +4 SET RGSTR=$EXTRACT(RGSTR,1,RGP-RGL1-1)_RGNEW_$EXTRACT(RGSTR,RGP,9999)
- +5 SET RGP=RGP-RGL1+RGL2
- End DoDot:1
- +6 QUIT RGSTR
- +7 ; Trim leading (Y=-1)/trailing (Y=1)/leading & trailing (Y=0) spaces
- TRIM(X,Y) ;
- +1 NEW RGZ1,RGZ2
- +2 SET Y=+$GET(Y)
- SET RGZ1=1
- SET RGZ2=$LENGTH(X)
- +3 IF Y'>0
- FOR RGZ1=1:1
- if $ASCII(X,RGZ1)'=32
- QUIT
- +4 IF Y'<0
- FOR RGZ2=RGZ2:-1
- if $ASCII(X,RGZ2)'=32
- QUIT
- +5 QUIT $EXTRACT(X,RGZ1,RGZ2)
- +6 ; Format a number with commas
- FMTNUM(RGNUM) ;
- +1 NEW RGZ,RGZ1,RGZ2
- +2 if RGNUM<0
- SET RGNUM=-RGNUM
- SET RGZ2="-"
- +3 FOR RGZ=$LENGTH(RGNUM):-3:1
- SET RGZ1=$EXTRACT(RGNUM,RGZ-2,RGZ)_$SELECT($DATA(RGZ1):","_RGZ1,1:"")
- +4 QUIT $GET(RGZ2)_$GET(RGZ1)
- +5 ; Convert X to base Y padded to length L
- BASE(X,Y,L) ;
- +1 if (Y<2)!(Y>62)
- QUIT ""
- +2 NEW RGZ,RGZ1
- +3 SET RGZ1=""
- SET X=$SELECT(X<0:-X,1:X)
- +4 FOR
- SET RGZ=X#Y
- SET X=X\Y
- SET RGZ1=$CHAR($SELECT(RGZ<10:RGZ+48,RGZ<36:RGZ+55,1:RGZ+61))_RGZ1
- if 'X
- QUIT
- +5 QUIT $SELECT('$GET(L):RGZ1,1:$$REPEAT^XLFSTR(0,L-$LENGTH(RGZ1))_$EXTRACT(RGZ1,1,L))
- +6 ; Convert a string to its SOUNDEX equivalent
- SOUNDEX(RGVALUE) ;
- +1 NEW RGCODE,RGSOUND,RGPREV,RGCHAR,RGPOS,RGTRANS
- +2 SET RGCODE="01230129022455012623019202"
- +3 SET RGSOUND=$CHAR($ASCII(RGVALUE)-(RGVALUE?1L.E*32))
- +4 SET RGPREV=$EXTRACT(RGCODE,$ASCII(RGVALUE)-64)
- +5 FOR RGPOS=2:1
- SET RGCHAR=$EXTRACT(RGVALUE,RGPOS)
- if ","[RGCHAR
- QUIT
- Begin DoDot:1
- +6 if RGCHAR'?1A
- QUIT
- +7 SET RGTRANS=$EXTRACT(RGCODE,$ASCII(RGCHAR)-$SELECT(RGCHAR?1U:64,1:96))
- +8 if RGTRANS=RGPREV!(RGTRANS=9)
- QUIT
- +9 SET RGPREV=RGTRANS
- +10 if RGTRANS'=0
- SET RGSOUND=RGSOUND_RGTRANS
- End DoDot:1
- if $LENGTH(RGSOUND)=4
- QUIT
- +11 QUIT $EXTRACT(RGSOUND_"000",1,4)
- +12 ; Display formatted title
- TITLE(RGTTL,RGVER,RGFN) ;
- +1 IF '$DATA(IOM)
- NEW IOM,IOF
- SET IOM=80
- SET IOF="#"
- +2 SET RGVER=$GET(RGVER,"1.0")
- +3 if RGVER
- SET RGVER="Version "_RGVER
- +4 USE $GET(IO,$IO)
- +5 WRITE @IOF,$SELECT(IO=IO(0):$CHAR(27,91,55,109),1:""),*13,$$^RGCVTDT(+$HOROLOG_","),?(IOM-$LENGTH(RGTTL)\2),RGTTL,?(IOM-$LENGTH(RGVER)),RGVER,!,$SELECT(IO=IO(0):$CHAR(27,91,109),1:$$UND),!
- +6 if $DATA(RGFN)
- WRITE ?(IOM-$LENGTH(RGFN)\2),RGFN,!
- +7 QUIT
- +8 ; Create a unique 8.3 filename
- UFN(Y) NEW X
- +1 SET Y=$EXTRACT($GET(Y),1,3)
- SET X=$$BASE($RANDOM(100)_$JOB_$TRANSLATE($HOROLOG,","),36,$SELECT($LENGTH(Y):8,1:11))_Y
- +2 QUIT $EXTRACT(X,1,8)_"."_$EXTRACT(X,9,11)
- +3 ; Return formatted SSN
- SSN(X) QUIT $SELECT(X="":X,1:$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,12))
- +1 ; Performs security check on patient access
- DGSEC(Y) NEW DIC
- +1 SET DIC(0)="E"
- +2 DO ^DGSEC
- +3 QUIT $SELECT(Y<1:0,1:Y)
- +4 ; Displays spinning icon to indicate progress
- WORKING(RGST,RGP,RGS) ;
- +1 if '$DATA(IO(0))!$DATA(ZTQUEUED)
- QUIT 0
- +2 NEW RGZ
- +3 SET RGZ(0)=$IO
- SET RGS=$GET(RGS,"|/-\")
- SET RGST=+$GET(RGST)
- +4 SET RGST=$SELECT(RGST<0:0,1:RGST#$LENGTH(RGS)+1)
- +5 USE IO(0)
- +6 if '$GET(RGP)
- WRITE *8,$SELECT(RGST:$EXTRACT(RGS,RGST),1:" ")
- +7 READ *RGZ:0
- +8 USE RGZ(0)
- +9 QUIT RGZ=94
- +10 ; Ask for Y/N response
- ASK(RGP,RGD,RGZ) ;
- +1 SET RGD=$GET(RGD,"N")
- +2 SET RGZ=$$GETCH(RGP_"? ","YN")
- +3 if RGZ=""
- SET RGZ=$EXTRACT(RGD)
- +4 WRITE !
- +5 QUIT $SELECT(RGZ[U:"",1:RGZ="Y")
- +6 ; Pause for user response
- PAUSE(RGP,RGX,RGY) ;
- +1 QUIT $$GETCH($GET(RGP,"Press RETURN or ENTER to continue..."),U,.RGX,.RGY)
- +2 ; Single character read
- GETCH(RGP,RGV,RGX,RGY,RGT,RGD) ;
- +1 NEW RGZ,RGC
- +2 if $DATA(RGX)!$DATA(RGY)
- WRITE $$XY($GET(RGX,$X),$GET(RGY,$Y))
- +3 WRITE $GET(RGP)
- +4 SET RGT=$GET(RGT,$GET(DTIME,999999999999))
- SET RGD=$GET(RGD,U)
- SET RGC=""
- +5 if $DATA(RGV)
- SET RGV=$$UP^XLFSTR(RGV)_U
- +6 FOR
- Begin DoDot:1
- +7 READ RGZ#1:RGT
- +8 IF '$TEST
- SET RGC=RGD
- QUIT
- +9 WRITE *8
- +10 if '$LENGTH(RGZ)
- QUIT
- +11 SET RGZ=$$UP^XLFSTR(RGZ)
- +12 IF $DATA(RGV)
- Begin DoDot:2
- +13 IF RGV[RGZ
- SET RGC=RGZ
- +14 IF '$TEST
- WRITE *7,*32,*8
- SET RGC=""
- End DoDot:2
- +15 IF '$TEST
- SET RGC=RGZ
- End DoDot:1
- if '$LENGTH(RGZ)
- QUIT
- +16 WRITE !
- +17 QUIT RGC
- +18 ; Position cursor
- XY(DX,DY) ;
- +1 if $GET(IOXY)=""
- DO HOME^%ZIS
- +2 SET DX=$SELECT(+$GET(DX)>0:+DX,1:0)
- SET DY=$SELECT(+$GET(DY)>0:+DY,1:0)
- SET $X=0
- +3 XECUTE IOXY
- +4 SET $X=DX
- SET $Y=DY
- +5 QUIT ""
- +6 ; Parameterized calls to date routines
- %DT(RGD,RGX) ;
- +1 NEW %D,%P,%C,%H,%I,%X,%Y,RGZ
- +2 DO DT^DILF($GET(RGX),RGD,.RGZ)
- +3 if $DATA(RGZ(0))
- WRITE RGZ(0),!
- +4 QUIT $GET(RGZ,-1)
- %DTC(X1,X2) ;
- +1 NEW X3
- +2 SET X2=$$%DTF(X1)+X2
- SET X1=X1\1
- SET X3=X2\1
- SET X2=X2-X3
- +3 if X2<0
- SET X3=X3-1
- SET X2=X2+1
- +4 QUIT $$FMADD^XLFDT(X1,X3)+$JUSTIFY($$%DTT(X2),0,6)
- %DTD(X1,X2) ;
- +1 QUIT $$FMDIFF^XLFDT(X1\1,X2\1)+($$%DTF(X1)-$$%DTF(X2))
- %DTF(X) SET X=X#1*100
- +1 QUIT X\1*3600+(X*100#100\1*60)+(X*10000#100)/86400
- %DTT(X) SET X=X*86400
- +1 QUIT X\3600*100+(X#3600/3600*60)/10000
- +2 ; THE FOLLOWING ENTRY POINTS WILL BE PHASED OUT IN FAVOR OF
- +3 ; THEIR EQUIVALENTS WITHIN KERNEL
- +4 ; Normalize global root
- GBL(RGGBL) ;
- +1 QUIT $$CREF^DILF(RGGBL)
- +2 ; Convert lower to upper case
- UPCASE(X) QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +1 ; Convert upper to lower case
- LOCASE(X) QUIT $TRANSLATE(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- +1 ; Return a string of X repeated Y times
- RPT(X,Y) QUIT $$REPEAT^XLFSTR(X,Y)
- %DTDW(X) QUIT $$DOW^XLFDT(X)
- %DTDOW(X) ;
- +1 QUIT $$DOW^XLFDT(X,1)
- %DTNOW() QUIT $$NOW^XLFDT
- %DTH(X) QUIT $$FMTH^XLFDT(X)
- %DTYX(X) QUIT $$HTFM^XLFDT(X)