| [613] | 1 | RGUT ;CAIRO/DKM - General purpose utilities;17-Sep-1998 14:14;DKM
|
|---|
| 2 | ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
|
|---|
| 3 | ;=================================================================
|
|---|
| 4 | ; Replaces delimited arguments in string, returning result
|
|---|
| 5 | MSG(%RGTXT,%RGDLM) ;
|
|---|
| 6 | N %RGZ1,%RGZ2
|
|---|
| 7 | I $$NEWERR^%ZTER N $ET S $ET=""
|
|---|
| 8 | S:$G(%RGDLM)="" %RGDLM="%"
|
|---|
| 9 | S %RGZ2="",%RGTXT=$TR(%RGTXT,"~","^"),@$$TRAP^RGZOSF("M1^RGUT")
|
|---|
| 10 | F Q:%RGTXT="" D
|
|---|
| 11 | .S %RGZ2=%RGZ2_$P(%RGTXT,%RGDLM),%RGZ1=$P(%RGTXT,%RGDLM,2),%RGTXT=$P(%RGTXT,%RGDLM,3,999)
|
|---|
| 12 | .I %RGZ1="" S:%RGTXT'="" %RGZ2=%RGZ2_%RGDLM
|
|---|
| 13 | .E X "S %RGZ2=%RGZ2_("_%RGZ1_")"
|
|---|
| 14 | M1 Q %RGZ2
|
|---|
| 15 | ; Case-insensitive string comparison
|
|---|
| 16 | ; Returns 0: X=Y, 1: X>Y, -1: X<Y
|
|---|
| 17 | STRICMP(X,Y) ;
|
|---|
| 18 | S X=$$UP^XLFSTR(X),Y=$$UP^XLFSTR(Y)
|
|---|
| 19 | Q $S(X=Y:0,X]]Y:1,1:-1)
|
|---|
| 20 | ; Output an underline X bytes long
|
|---|
| 21 | UND(X) Q $$REPEAT^XLFSTR("-",$G(X,$G(IOM,80)))
|
|---|
| 22 | ; Truncate a string if > Y bytes long
|
|---|
| 23 | TRUNC(X,Y) ;
|
|---|
| 24 | Q $S($L(X)'>Y:X,1:$E(X,1,Y-3)_"...")
|
|---|
| 25 | ; Formatting for singular/plural
|
|---|
| 26 | SNGPLR(RGNUM,RGSNG,RGPLR) ;
|
|---|
| 27 | N RGZ
|
|---|
| 28 | S RGZ=RGSNG?.E1L.E,RGPLR=$G(RGPLR,RGSNG_$S(RGZ:"s",1:"S"))
|
|---|
| 29 | Q $S('RGNUM:$S(RGZ:"no ",1:"NO ")_RGPLR,RGNUM=1:"1 "_RGSNG,1:RGNUM_" "_RGPLR)
|
|---|
| 30 | ; Convert code to external form from set of codes
|
|---|
| 31 | SET(RGCODE,RGSET) ;
|
|---|
| 32 | N RGZ,RGZ1
|
|---|
| 33 | F RGZ=1:1:$L(RGSET,";") D Q:RGZ1'=""
|
|---|
| 34 | .S RGZ1=$P(RGSET,";",RGZ),RGZ1=$S($P(RGZ1,":")=RGCODE:$P(RGZ1,":",2),1:"")
|
|---|
| 35 | Q RGZ1
|
|---|
| 36 | ; Replace each occurrence of RGOLD in RGSTR with RGNEW
|
|---|
| 37 | SUBST(RGSTR,RGOLD,RGNEW) ;
|
|---|
| 38 | N RGP,RGL1,RGL2
|
|---|
| 39 | S RGNEW=$G(RGNEW),RGP=0,RGL1=$L(RGOLD),RGL2=$L(RGNEW)
|
|---|
| 40 | F S RGP=$F(RGSTR,RGOLD,RGP) Q:'RGP D
|
|---|
| 41 | .S RGSTR=$E(RGSTR,1,RGP-RGL1-1)_RGNEW_$E(RGSTR,RGP,9999)
|
|---|
| 42 | .S RGP=RGP-RGL1+RGL2
|
|---|
| 43 | Q RGSTR
|
|---|
| 44 | ; Trim leading (Y=-1)/trailing (Y=1)/leading & trailing (Y=0) spaces
|
|---|
| 45 | TRIM(X,Y) ;
|
|---|
| 46 | N RGZ1,RGZ2
|
|---|
| 47 | S Y=+$G(Y),RGZ1=1,RGZ2=$L(X)
|
|---|
| 48 | I Y'>0 F RGZ1=1:1 Q:$A(X,RGZ1)'=32
|
|---|
| 49 | I Y'<0 F RGZ2=RGZ2:-1 Q:$A(X,RGZ2)'=32
|
|---|
| 50 | Q $E(X,RGZ1,RGZ2)
|
|---|
| 51 | ; Format a number with commas
|
|---|
| 52 | FMTNUM(RGNUM) ;
|
|---|
| 53 | N RGZ,RGZ1,RGZ2
|
|---|
| 54 | S:RGNUM<0 RGNUM=-RGNUM,RGZ2="-"
|
|---|
| 55 | F RGZ=$L(RGNUM):-3:1 S RGZ1=$E(RGNUM,RGZ-2,RGZ)_$S($D(RGZ1):","_RGZ1,1:"")
|
|---|
| 56 | Q $G(RGZ2)_$G(RGZ1)
|
|---|
| 57 | ; Convert X to base Y padded to length L
|
|---|
| 58 | BASE(X,Y,L) ;
|
|---|
| 59 | Q:(Y<2)!(Y>62) ""
|
|---|
| 60 | N RGZ,RGZ1
|
|---|
| 61 | S RGZ1="",X=$S(X<0:-X,1:X)
|
|---|
| 62 | 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
|
|---|
| 63 | Q $S('$G(L):RGZ1,1:$$REPEAT^XLFSTR(0,L-$L(RGZ1))_$E(RGZ1,1,L))
|
|---|
| 64 | ; Convert a string to its SOUNDEX equivalent
|
|---|
| 65 | SOUNDEX(RGVALUE) ;
|
|---|
| 66 | N RGCODE,RGSOUND,RGPREV,RGCHAR,RGPOS,RGTRANS
|
|---|
| 67 | S RGCODE="01230129022455012623019202"
|
|---|
| 68 | S RGSOUND=$C($A(RGVALUE)-(RGVALUE?1L.E*32))
|
|---|
| 69 | S RGPREV=$E(RGCODE,$A(RGVALUE)-64)
|
|---|
| 70 | F RGPOS=2:1 S RGCHAR=$E(RGVALUE,RGPOS) Q:","[RGCHAR D Q:$L(RGSOUND)=4
|
|---|
| 71 | .Q:RGCHAR'?1A
|
|---|
| 72 | .S RGTRANS=$E(RGCODE,$A(RGCHAR)-$S(RGCHAR?1U:64,1:96))
|
|---|
| 73 | .Q:RGTRANS=RGPREV!(RGTRANS=9)
|
|---|
| 74 | .S RGPREV=RGTRANS
|
|---|
| 75 | .S:RGTRANS'=0 RGSOUND=RGSOUND_RGTRANS
|
|---|
| 76 | Q $E(RGSOUND_"000",1,4)
|
|---|
| 77 | ; Display formatted title
|
|---|
| 78 | TITLE(RGTTL,RGVER,RGFN) ;
|
|---|
| 79 | I '$D(IOM) N IOM,IOF S IOM=80,IOF="#"
|
|---|
| 80 | S RGVER=$G(RGVER,"1.0")
|
|---|
| 81 | S:RGVER RGVER="Version "_RGVER
|
|---|
| 82 | U $G(IO,$I)
|
|---|
| 83 | 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),!
|
|---|
| 84 | W:$D(RGFN) ?(IOM-$L(RGFN)\2),RGFN,!
|
|---|
| 85 | Q
|
|---|
| 86 | ; Create a unique 8.3 filename
|
|---|
| 87 | UFN(Y) N X
|
|---|
| 88 | S Y=$E($G(Y),1,3),X=$$BASE($R(100)_$J_$TR($H,","),36,$S($L(Y):8,1:11))_Y
|
|---|
| 89 | Q $E(X,1,8)_"."_$E(X,9,11)
|
|---|
| 90 | ; Return formatted SSN
|
|---|
| 91 | SSN(X) Q $S(X="":X,1:$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,12))
|
|---|
| 92 | ; Performs security check on patient access
|
|---|
| 93 | DGSEC(Y) N DIC
|
|---|
| 94 | S DIC(0)="E"
|
|---|
| 95 | D ^DGSEC
|
|---|
| 96 | Q $S(Y<1:0,1:Y)
|
|---|
| 97 | ; Displays spinning icon to indicate progress
|
|---|
| 98 | WORKING(RGST,RGP,RGS) ;
|
|---|
| 99 | Q:'$D(IO(0))!$D(ZTQUEUED) 0
|
|---|
| 100 | N RGZ
|
|---|
| 101 | S RGZ(0)=$I,RGS=$G(RGS,"|/-\"),RGST=+$G(RGST)
|
|---|
| 102 | S RGST=$S(RGST<0:0,1:RGST#$L(RGS)+1)
|
|---|
| 103 | U IO(0)
|
|---|
| 104 | W:'$G(RGP) *8,$S(RGST:$E(RGS,RGST),1:" ")
|
|---|
| 105 | R *RGZ:0
|
|---|
| 106 | U RGZ(0)
|
|---|
| 107 | Q RGZ=94
|
|---|
| 108 | ; Ask for Y/N response
|
|---|
| 109 | ASK(RGP,RGD,RGZ) ;
|
|---|
| 110 | S RGD=$G(RGD,"N")
|
|---|
| 111 | S RGZ=$$GETCH(RGP_"? ","YN")
|
|---|
| 112 | S:RGZ="" RGZ=$E(RGD)
|
|---|
| 113 | W !
|
|---|
| 114 | Q $S(RGZ[U:"",1:RGZ="Y")
|
|---|
| 115 | ; Pause for user response
|
|---|
| 116 | PAUSE(RGP,RGX,RGY) ;
|
|---|
| 117 | Q $$GETCH($G(RGP,"Press RETURN or ENTER to continue..."),U,.RGX,.RGY)
|
|---|
| 118 | ; Single character read
|
|---|
| 119 | GETCH(RGP,RGV,RGX,RGY,RGT,RGD) ;
|
|---|
| 120 | N RGZ,RGC
|
|---|
| 121 | W:$D(RGX)!$D(RGY) $$XY($G(RGX,$X),$G(RGY,$Y))
|
|---|
| 122 | W $G(RGP)
|
|---|
| 123 | S RGT=$G(RGT,$G(DTIME,999999999999)),RGD=$G(RGD,U),RGC=""
|
|---|
| 124 | S:$D(RGV) RGV=$$UP^XLFSTR(RGV)_U
|
|---|
| 125 | F D Q:'$L(RGZ)
|
|---|
| 126 | .R RGZ#1:RGT
|
|---|
| 127 | .E S RGC=RGD Q
|
|---|
| 128 | .W *8
|
|---|
| 129 | .Q:'$L(RGZ)
|
|---|
| 130 | .S RGZ=$$UP^XLFSTR(RGZ)
|
|---|
| 131 | .I $D(RGV) D
|
|---|
| 132 | ..I RGV[RGZ S RGC=RGZ
|
|---|
| 133 | ..E W *7,*32,*8 S RGC=""
|
|---|
| 134 | .E S RGC=RGZ
|
|---|
| 135 | W !
|
|---|
| 136 | Q RGC
|
|---|
| 137 | ; Position cursor
|
|---|
| 138 | XY(DX,DY) ;
|
|---|
| 139 | D:$G(IOXY)="" HOME^%ZIS
|
|---|
| 140 | S DX=$S(+$G(DX)>0:+DX,1:0),DY=$S(+$G(DY)>0:+DY,1:0),$X=0
|
|---|
| 141 | X IOXY
|
|---|
| 142 | S $X=DX,$Y=DY
|
|---|
| 143 | Q ""
|
|---|
| 144 | ; Parameterized calls to date routines
|
|---|
| 145 | %DT(RGD,RGX) ;
|
|---|
| 146 | N %D,%P,%C,%H,%I,%X,%Y,RGZ
|
|---|
| 147 | D DT^DILF($G(RGX),RGD,.RGZ)
|
|---|
| 148 | W:$D(RGZ(0)) RGZ(0),!
|
|---|
| 149 | Q $G(RGZ,-1)
|
|---|
| 150 | %DTC(X1,X2) ;
|
|---|
| 151 | N X3
|
|---|
| 152 | S X2=$$%DTF(X1)+X2,X1=X1\1,X3=X2\1,X2=X2-X3
|
|---|
| 153 | S:X2<0 X3=X3-1,X2=X2+1
|
|---|
| 154 | Q $$FMADD^XLFDT(X1,X3)+$J($$%DTT(X2),0,6)
|
|---|
| 155 | %DTD(X1,X2) ;
|
|---|
| 156 | Q $$FMDIFF^XLFDT(X1\1,X2\1)+($$%DTF(X1)-$$%DTF(X2))
|
|---|
| 157 | %DTF(X) S X=X#1*100
|
|---|
| 158 | Q X\1*3600+(X*100#100\1*60)+(X*10000#100)/86400
|
|---|
| 159 | %DTT(X) S X=X*86400
|
|---|
| 160 | Q X\3600*100+(X#3600/3600*60)/10000
|
|---|
| 161 | ; THE FOLLOWING ENTRY POINTS WILL BE PHASED OUT IN FAVOR OF
|
|---|
| 162 | ; THEIR EQUIVALENTS WITHIN KERNEL
|
|---|
| 163 | ; Normalize global root
|
|---|
| 164 | GBL(RGGBL) ;
|
|---|
| 165 | Q $$CREF^DILF(RGGBL)
|
|---|
| 166 | ; Convert lower to upper case
|
|---|
| 167 | UPCASE(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 168 | ; Convert upper to lower case
|
|---|
| 169 | LOCASE(X) Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
|
|---|
| 170 | ; Return a string of X repeated Y times
|
|---|
| 171 | RPT(X,Y) Q $$REPEAT^XLFSTR(X,Y)
|
|---|
| 172 | %DTDW(X) Q $$DOW^XLFDT(X)
|
|---|
| 173 | %DTDOW(X) ;
|
|---|
| 174 | Q $$DOW^XLFDT(X,1)
|
|---|
| 175 | %DTNOW() Q $$NOW^XLFDT
|
|---|
| 176 | %DTH(X) Q $$FMTH^XLFDT(X)
|
|---|
| 177 | %DTYX(X) Q $$HTFM^XLFDT(X)
|
|---|
