| 1 | TMGTEST ;TMG/kst/Scratch fns for programming tests ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;09/01/05
|
|---|
| 3 |
|
|---|
| 4 | new array
|
|---|
| 5 | set array="Fruits:"
|
|---|
| 6 | set array(1)="apple"
|
|---|
| 7 | set array(2)="pear"
|
|---|
| 8 | set array(3)="peach"
|
|---|
| 9 | zwr array
|
|---|
| 10 | new i,j,k
|
|---|
| 11 | for i=1:1:2 do
|
|---|
| 12 | .for j=1:1:2 do
|
|---|
| 13 | ..for k=1:1:2 write "*"
|
|---|
| 14 | quit
|
|---|
| 15 |
|
|---|
| 16 | ;"Scratch function for various programming tests
|
|---|
| 17 | A new Name write "this is a test",!
|
|---|
| 18 | read "Enter name:",Name,!
|
|---|
| 19 | write "Here is that name: ",Name,!
|
|---|
| 20 | quit
|
|---|
| 21 |
|
|---|
| 22 | B
|
|---|
| 23 | new name
|
|---|
| 24 | set name="kevin"
|
|---|
| 25 | read "input name",name,!
|
|---|
| 26 | set ^TMG("KILL LATER")=name
|
|---|
| 27 | quit
|
|---|
| 28 |
|
|---|
| 29 | N
|
|---|
| 30 | new n
|
|---|
| 31 | for n=1:1:10 do
|
|---|
| 32 | . write n,!
|
|---|
| 33 | quit
|
|---|
| 34 |
|
|---|
| 35 | Add1(X)
|
|---|
| 36 | quit X+1
|
|---|
| 37 |
|
|---|
| 38 | Fn(Name)
|
|---|
| 39 | write "That input value was: ",Name,!
|
|---|
| 40 | quit
|
|---|
| 41 |
|
|---|
| 42 | PG
|
|---|
| 43 | new i
|
|---|
| 44 | new startTime set startTime=$H
|
|---|
| 45 | write !,"Lets begin...",!
|
|---|
| 46 | for i=0:1:100 do
|
|---|
| 47 | . do ProgressBar^TMGUSRIF(i,"Progress",1,100,60,startTime)
|
|---|
| 48 | . hang (1)
|
|---|
| 49 |
|
|---|
| 50 | write !,"All done!...",!
|
|---|
| 51 | quit
|
|---|
| 52 |
|
|---|
| 53 | PB
|
|---|
| 54 | new pct
|
|---|
| 55 | for do quit:(pct'>-1)
|
|---|
| 56 | . read "enter percent: ",pct,!
|
|---|
| 57 | . if pct'>-1 quit
|
|---|
| 58 | . do ProgressBar^TMGUSRIF(pct,"Progress",0,100,60)
|
|---|
| 59 | . write !
|
|---|
| 60 |
|
|---|
| 61 | quit
|
|---|
| 62 |
|
|---|
| 63 |
|
|---|
| 64 | Esc
|
|---|
| 65 | new key
|
|---|
| 66 | for do quit:(key="x")!(key=27)
|
|---|
| 67 | . read *key
|
|---|
| 68 | . if key=27 write "You escaped!"
|
|---|
| 69 |
|
|---|
| 70 |
|
|---|
| 71 | T2
|
|---|
| 72 | D INIT^XPDID
|
|---|
| 73 | S XPDIDTOT=100
|
|---|
| 74 | D TITLE^XPDID("hello world")
|
|---|
| 75 | D UPDATE^XPDID(50)
|
|---|
| 76 | F I=1:1:100 D
|
|---|
| 77 | . do UPDATE^XPDID(I)
|
|---|
| 78 | . hang (0.2)
|
|---|
| 79 | D EXIT^XPDID()
|
|---|
| 80 |
|
|---|
| 81 | quit
|
|---|
| 82 |
|
|---|
| 83 |
|
|---|
| 84 | MakeFile
|
|---|
| 85 | new handle set handle="TMGHandle"
|
|---|
| 86 | new path read "enter path: ",path,!
|
|---|
| 87 | new fname read "enter filename: ",fname,!
|
|---|
| 88 | write "Will create a binary test file: ",path,fname,!
|
|---|
| 89 | new input
|
|---|
| 90 | read "Continue? (Y/N) Y// ",input,!
|
|---|
| 91 | if "Yy"'[input quit
|
|---|
| 92 |
|
|---|
| 93 | set path=$$DEFDIR^%ZISH($get(path))
|
|---|
| 94 | do OPEN^%ZISH(handle,path,fname,"W")
|
|---|
| 95 | if POP quit
|
|---|
| 96 | use IO
|
|---|
| 97 |
|
|---|
| 98 | new i,j
|
|---|
| 99 | for i=0:1:255 do
|
|---|
| 100 | . for j=0:1:255 do
|
|---|
| 101 | . . write $char(j)
|
|---|
| 102 | . . set $X=0
|
|---|
| 103 |
|
|---|
| 104 | do CLOSE^%ZISH(handle)
|
|---|
| 105 |
|
|---|
| 106 |
|
|---|
| 107 | quit
|
|---|
| 108 |
|
|---|
| 109 | TEST
|
|---|
| 110 | new fname,path,gref
|
|---|
| 111 | set fname="triplegears.jpg"
|
|---|
| 112 | set fname2="triplegears2.jpg"
|
|---|
| 113 | set path="/var/local/OpenVistA_UserData/server-files/"
|
|---|
| 114 | set gref="^TMP(""TMG"",""x"",1)"
|
|---|
| 115 | kill ^TMP("TMG","x")
|
|---|
| 116 |
|
|---|
| 117 | write "Reading in file: ",path,fname,!
|
|---|
| 118 | w $$BFTG^TMGBINF(path,fname,gref,3),! ;"read in
|
|---|
| 119 |
|
|---|
| 120 | write "Now let's browse the original data...",!
|
|---|
| 121 | do BROWSE^TMGBVIEW(gref,3)
|
|---|
| 122 |
|
|---|
| 123 | write "Will now encode the data...",!
|
|---|
| 124 | do ENCODE^TMGRPC1(gref,3)
|
|---|
| 125 |
|
|---|
| 126 | write "Now let's browse the encoded data...",!
|
|---|
| 127 | do BROWSE^TMGBUTIL(gref,3)
|
|---|
| 128 |
|
|---|
| 129 | write "Now let's decode the data again...",!
|
|---|
| 130 | do DECODE^TMGRPC1(gref,3)
|
|---|
| 131 |
|
|---|
| 132 | write "Now let's browse the decoded data...",!
|
|---|
| 133 | do BROWSE^TMGBUTIL(gref,3)
|
|---|
| 134 |
|
|---|
| 135 | write "will now write out file to: ",path,fname2,!
|
|---|
| 136 | w $$GTBF^TMGBINF(gref,3,path,fname2),! ;"write out
|
|---|
| 137 |
|
|---|
| 138 | quit
|
|---|
| 139 |
|
|---|
| 140 | TESTRPC
|
|---|
| 141 | new fname,path
|
|---|
| 142 | set fname="triplegears.jpg"
|
|---|
| 143 | set path="/"
|
|---|
| 144 | new gref
|
|---|
| 145 |
|
|---|
| 146 | do GETFILE^TMGRPC1(.gref,path,fname)
|
|---|
| 147 | if $get(@gref@(0))=0 goto TRPCDone
|
|---|
| 148 | set gref=$name(@gref@(1))
|
|---|
| 149 |
|
|---|
| 150 | write "Now let's browse the original (encoded) data...",!
|
|---|
| 151 | do BROWSE^TMGBVIEW(gref,3)
|
|---|
| 152 |
|
|---|
| 153 | write "Now let's decode the data again...",!
|
|---|
| 154 | do DECODE^TMGRPC1(gref,3)
|
|---|
| 155 |
|
|---|
| 156 | write "Now let's browse the decoded data...",!
|
|---|
| 157 | do BROWSE^TMGBUTIL(gref,3)
|
|---|
| 158 |
|
|---|
| 159 | TRPCDone
|
|---|
| 160 | write "goodbye.",!
|
|---|
| 161 |
|
|---|
| 162 | quit
|
|---|
| 163 |
|
|---|
| 164 | OR(a,b)
|
|---|
| 165 | new result set result=0
|
|---|
| 166 | new mult set mult=1
|
|---|
| 167 | for do quit:(a'>0)&(b'>0)
|
|---|
| 168 | . set result=result+(((a#2)!(b#2))*mult)
|
|---|
| 169 | . set a=a\2,b=b\2,mult=mult*2
|
|---|
| 170 |
|
|---|
| 171 | quit result
|
|---|
| 172 |
|
|---|
| 173 |
|
|---|
| 174 |
|
|---|
| 175 | TERMLIST(GRef)
|
|---|
| 176 |
|
|---|
| 177 | new i
|
|---|
| 178 | kill ^TMP($J,"TMG-DATA")
|
|---|
| 179 | do LIST^DIC(3.2)
|
|---|
| 180 | if '$data(DIERR) do
|
|---|
| 181 | . set i=0
|
|---|
| 182 | . for set i=$order(^TMP("DILIST",$J,2,i)) quit:(i="") do
|
|---|
| 183 | . . set ^TMP($J,"TMG-DATA",i)=$get(^TMP("DILIST",$J,2,i))_"^"_$get(^TMP("DILIST",$J,1,i))
|
|---|
| 184 | kill ^TMP("DILIST",$J)
|
|---|
| 185 | set GRef=$name(^TMP($J,"TMG-DATA"))
|
|---|
| 186 | quit
|
|---|
| 187 |
|
|---|
| 188 | SIMPLE(input)
|
|---|
| 189 | quit "You said:"_input
|
|---|
| 190 |
|
|---|
| 191 |
|
|---|
| 192 | ImageUpload
|
|---|
| 193 |
|
|---|
| 194 | new params
|
|---|
| 195 |
|
|---|
| 196 | set params("NETLOCABS")="ABS^STUFFONLY"
|
|---|
| 197 | set params("magDFN")="5^70685" ;"DFN 70685 = TEST,KILLME DON'T
|
|---|
| 198 | set params("OBJType")="3^1" ;"type 1 is still image
|
|---|
| 199 | set params("FileExt")="EXT^JPG"
|
|---|
| 200 | set params("DateTime")="7^NOW"
|
|---|
| 201 | set params("DUZ")="8^73" ;"73 = my DUZ
|
|---|
| 202 | set params("Desc")="10^A sample upload image."
|
|---|
| 203 |
|
|---|
| 204 | do ADD^MAGGTIA(.results,.params)
|
|---|
| 205 |
|
|---|
| 206 | zwr results(*)
|
|---|
| 207 |
|
|---|
| 208 | quit
|
|---|
| 209 |
|
|---|
| 210 |
|
|---|
| 211 | FIXRX
|
|---|
| 212 | new i,OI
|
|---|
| 213 | set i=""
|
|---|
| 214 | F2
|
|---|
| 215 | for set i=$o(^PSDRUG(i)) do quit:(i="")
|
|---|
| 216 | . s i2=i
|
|---|
| 217 | . s i=$o(^PSDRUG(i))
|
|---|
| 218 | . q:i=""
|
|---|
| 219 | . w i2,": "
|
|---|
| 220 | . s name=$p($g(^PSDRUG(i2,0)),"^",1)
|
|---|
| 221 | . set OI=$p($get(^PSDRUG(i2,2)),"^",1)
|
|---|
| 222 | . write name,"-->",OI
|
|---|
| 223 | . if +OI>0 do
|
|---|
| 224 | . . if $d(^PS(50.7,OI))=0 do
|
|---|
| 225 | . . . w " BAD LINK",!
|
|---|
| 226 | . . . ;"set $P(^PSDRUG(i2,2),"^",1)=""
|
|---|
| 227 | . . else do
|
|---|
| 228 | . . . write " GOOD LINK",!
|
|---|
| 229 | . else write " (no link)",!
|
|---|
| 230 |
|
|---|
| 231 | ELHTEST
|
|---|
| 232 | write "Hello World",!
|
|---|
| 233 | New address1,address2
|
|---|
| 234 | read "Enter street name:",address1,!
|
|---|
| 235 | read "Enter city/state:",address2,!
|
|---|
| 236 | write "The address is:",!,address1,!,address2,!
|
|---|
| 237 | set ^Eddie("line1")=address1
|
|---|
| 238 | set ^Eddie("line2")=address2
|
|---|
| 239 | quit
|
|---|
| 240 |
|
|---|
| 241 | ELHTEST2
|
|---|
| 242 | for loop=1:1:10 do
|
|---|
| 243 | . write "Hello World",!
|
|---|
| 244 |
|
|---|
| 245 | quit
|
|---|
| 246 |
|
|---|
| 247 | ELHTEST3
|
|---|
| 248 | new i
|
|---|
| 249 | set i=1
|
|---|
| 250 | for do if i=3 quit
|
|---|
| 251 | . write i,!
|
|---|
| 252 | . set i=i+1
|
|---|
| 253 |
|
|---|
| 254 |
|
|---|
| 255 | ADDPT()
|
|---|
| 256 | new TMGFDA,TMGIEN,TMGMsg
|
|---|
| 257 |
|
|---|
| 258 | read "Enter first name of test patient: ",FNAME,!
|
|---|
| 259 | if FNAME="^" quit 0
|
|---|
| 260 |
|
|---|
| 261 | ;"Note: the "2" means file 2 (PATIENT file), and "+1" means "add entry"
|
|---|
| 262 | set TMGFDA(2,"+1,",.096)="`"_DUZ ;"field .096 = WHO ENTERED PATIENT (`DUZ=current user)
|
|---|
| 263 | set TMGFDA(2,"+1,",.01)="TEST,"_FNAME ;"field .01 = NAME
|
|---|
| 264 | set TMGFDA(2,"+1,",.02)="FEMALE" ;"field .02 = SEX
|
|---|
| 265 | set TMGFDA(2,"+1,",.03)="1/1/1980" ;"field .03 = DOB
|
|---|
| 266 | ;"set TMGFDA(2,"+1,",.09)="P" ;"field .09 = SSNUM
|
|---|
| 267 | ;"These fields below *USED TO BE* required. I changed the filemans status for these fields to NOT required
|
|---|
| 268 | set TMGFDA(2,"+1,",1901)="NO" ;"field 1901 = VETERAN Y/N --For my purposes, use NO
|
|---|
| 269 | set TMGFDA(2,"+1,",.301)="NO" ;"field .301 = "SERVICE CONNECTED?" -- required field
|
|---|
| 270 | set TMGFDA(2,"+1,",391)="NON-VETERAN (OTHER)" ;"field 391 = "TYPE" - required field
|
|---|
| 271 |
|
|---|
| 272 | do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMsg")
|
|---|
| 273 |
|
|---|
| 274 | if $data(TMGMsg("DIERR")) do
|
|---|
| 275 | . if $get(TMGDEBUG)>-1 do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound)
|
|---|
| 276 | . set result=0
|
|---|
| 277 | . merge ErrArray("DIERR")=TMGMsg("DIERR")
|
|---|
| 278 |
|
|---|
| 279 | set result=+$get(TMGIEN(1)) ;"result is the added patient's IEN
|
|---|
| 280 | if result'>0 goto ANPDone
|
|---|
| 281 |
|
|---|
| 282 | ;"Now, manually add a record in the file 9000001 (^AUPNPAT) with IEN (stored in result)
|
|---|
| 283 | ;"This is done because some PATIENT fields don't point to the PATIENT file, but instead
|
|---|
| 284 | ;" point to the PATIENT/IHS file (9000001), which in turn points to the PATIENT file.
|
|---|
| 285 | set ^AUPNPAT(result,0)=result
|
|---|
| 286 | set ^AUPNPAT("B",result,result)=""
|
|---|
| 287 | if $data(Entry(.09)) do
|
|---|
| 288 | . set ^AUPNPAT(result,41,0)="^9000001.41P^1^1"
|
|---|
| 289 | . set ^AUPNPAT(result,41,1,0)="1^"_Entry(.09)
|
|---|
| 290 |
|
|---|
| 291 | ANPDone
|
|---|
| 292 | quit result
|
|---|
| 293 |
|
|---|
| 294 |
|
|---|
| 295 | X
|
|---|
| 296 | write "Hello " do write "And Then..." do write "Goodbye",!
|
|---|
| 297 | . write "There "
|
|---|
| 298 | quit
|
|---|
| 299 |
|
|---|
| 300 |
|
|---|
| 301 |
|
|---|
| 302 | TestKB
|
|---|
| 303 | new KEY,VK
|
|---|
| 304 | new i
|
|---|
| 305 |
|
|---|
| 306 | for do quit:(VK="<ESC>")
|
|---|
| 307 | . S KEY=$$READ^%ZVEMKRN("",1,1)
|
|---|
| 308 | . S VK=VEE("K")
|
|---|
| 309 | . write "KEY=",KEY," VK=",VK,!
|
|---|
| 310 |
|
|---|
| 311 | quit
|
|---|
| 312 |
|
|---|
| 313 |
|
|---|
| 314 | P
|
|---|
| 315 | set PrintArray(59610)=""
|
|---|
| 316 | goto PR3
|
|---|
| 317 | Print
|
|---|
| 318 | ;"Test printing
|
|---|
| 319 | new PrintArray
|
|---|
| 320 | set DIC=8925
|
|---|
| 321 | set DIC(0)="MAEQ"
|
|---|
| 322 | PR2 do ^DIC write !
|
|---|
| 323 | if +Y>0 do goto PR2
|
|---|
| 324 | . set PrintArray(+Y)=""
|
|---|
| 325 | . write "Now pick another, or ^ when done picking",!
|
|---|
| 326 | PR3
|
|---|
| 327 | if $data(PrintArray) do
|
|---|
| 328 | . do PRINT^TMGTRAN1(.PrintArray)
|
|---|
| 329 |
|
|---|
| 330 | quit
|
|---|
| 331 |
|
|---|
| 332 |
|
|---|
| 333 | iodemo ;; "demonstrate use of $x and wrapping
|
|---|
| 334 | Set file="/tmp/gtm"_$J_".tmp"
|
|---|
| 335 | Open file
|
|---|
| 336 | ;"Open file:(variable:nowrap)
|
|---|
| 337 | Use file
|
|---|
| 338 | Do io
|
|---|
| 339 | write !!,"--------------------",!!
|
|---|
| 340 | Use file:(wrap:width=120:length=70)
|
|---|
| 341 | Use file
|
|---|
| 342 | Do io
|
|---|
| 343 | Close file
|
|---|
| 344 | ZSYstem "cat "_file
|
|---|
| 345 | ZSystem "rm "_file
|
|---|
| 346 | Quit
|
|---|
| 347 | ;
|
|---|
| 348 | io ;; actual IO
|
|---|
| 349 | For i=1:1:70 Do
|
|---|
| 350 | . For j=1:1:6 do
|
|---|
| 351 | . . Write $Justify(i,2),",",$Justify(j,2),":"
|
|---|
| 352 | . . write " [",$Justify($x,3),",",$Justify($y,3),"] "
|
|---|
| 353 | . Write " EOL",!
|
|---|
| 354 | Quit
|
|---|
| 355 |
|
|---|
| 356 | io2demo
|
|---|
| 357 | do ^%ZIS
|
|---|
| 358 | use IO
|
|---|
| 359 | new i
|
|---|
| 360 | for i=1:1:125 do
|
|---|
| 361 | . write i,?5,$Y,!
|
|---|
| 362 | do ^%ZISC
|
|---|
| 363 | quit
|
|---|
| 364 |
|
|---|
| 365 |
|
|---|
| 366 | i3
|
|---|
| 367 | do ^%ZIS
|
|---|
| 368 | use IO
|
|---|
| 369 | new i
|
|---|
| 370 | write $char(27),"E"
|
|---|
| 371 | write "Here is some text characters...",!!!
|
|---|
| 372 | write "========================",!
|
|---|
| 373 |
|
|---|
| 374 | for i=32:1:128 w $char(i)
|
|---|
| 375 | write !,"========================",!
|
|---|
| 376 | do ^%ZISC
|
|---|
| 377 |
|
|---|
| 378 |
|
|---|
| 379 |
|
|---|
| 380 |
|
|---|
| 381 |
|
|---|
| 382 | JSELF1
|
|---|
| 383 | ;test 1 - build a temporary xref of Drug file.
|
|---|
| 384 | set start=$H
|
|---|
| 385 | s drugRef=$$glo^view1(50)_"DrugNo)"
|
|---|
| 386 | s getDrug=$$getvars^view1(50,"NtDrFlEn;PsVaPrNE(""DsgForm"");PsVaPrNE(""Strength"")")
|
|---|
| 387 | s DrugNo=0 f item=1:1 s DrugNo=$o(@drugRef) q:'DrugNo do
|
|---|
| 388 | . s @getDrug
|
|---|
| 389 | . s pArray(+NtDrFlEn,+PsVaPrNE("DsgForm"),+PsVaPrNE("Strength"),DrugNo)=""
|
|---|
| 390 | . s pArray("BY 50",DrugNo,+NtDrFlEn,+PsVaPrNE("DsgForm"))=""
|
|---|
| 391 | set end=$H
|
|---|
| 392 | write start,!,end,!
|
|---|
| 393 | zwr item
|
|---|
| 394 | quit
|
|---|
| 395 |
|
|---|
| 396 | JSELF2
|
|---|
| 397 | ;test 2 - build a temporary xref of Drug file.
|
|---|
| 398 | set start=$H
|
|---|
| 399 | s drugRef="^PSDRUG(DrugNo)"
|
|---|
| 400 | s DrugNo=0 f item=1:1 s DrugNo=$o(@drugRef) q:'DrugNo do
|
|---|
| 401 | . s NtDrFlEn=$$GET1^DIQ(50,DrugNo_",","20","I")
|
|---|
| 402 | . s PsVaPrNE("DsgForm")=$$GET1^DIQ(50,DrugNo_",","22:1","I")
|
|---|
| 403 | . s PsVaPrNE("Strength")=$$GET1^DIQ(50,DrugNo_",","22:2")
|
|---|
| 404 | . s pArray(+NtDrFlEn,+PsVaPrNE("DsgForm"),+PsVaPrNE("Strength"),DrugNo)=""
|
|---|
| 405 | . s pArray("BY 50",DrugNo,+NtDrFlEn,+PsVaPrNE("DsgForm"))=""
|
|---|
| 406 | set end=$H
|
|---|
| 407 | write start,!,end,!
|
|---|
| 408 | zwr item
|
|---|
| 409 | quit
|
|---|
| 410 |
|
|---|
| 411 |
|
|---|
| 412 | Look4(IEN50)
|
|---|
| 413 | ;"Purpose: Look in "B" cross ref for IEN
|
|---|
| 414 |
|
|---|
| 415 | new IEN,name
|
|---|
| 416 |
|
|---|
| 417 | set name=""
|
|---|
| 418 | for set name=$order(^PSDRUG("B",name)) quit:(name="") do
|
|---|
| 419 | . set IEN=""
|
|---|
| 420 | . for set IEN=$order(^PSDRUG("B",name,IEN)) quit:(IEN="") do
|
|---|
| 421 | . . if IEN=IEN50 do
|
|---|
| 422 | . . . write IEN," ",name,!
|
|---|
| 423 | . . . write "--",$piece($get(^PSDRUG(IEN,0)),"^",1),!
|
|---|
| 424 |
|
|---|
| 425 | quit
|
|---|
| 426 |
|
|---|
| 427 |
|
|---|
| 428 | Ensure
|
|---|
| 429 | ;"research
|
|---|
| 430 |
|
|---|
| 431 | new IEN set IEN=159 ;"TEST,PERSON
|
|---|
| 432 | new TMGFDA,TMGIEN,TMGMSG
|
|---|
| 433 | set TMGFDA(200.04,"?+1,"_IEN_",",.01)="BILLY"
|
|---|
| 434 |
|
|---|
| 435 | do UPDATE^DIE("ES","TMGFDA","TMGIDE","TMGMSG")
|
|---|
| 436 | if $$ShowIfError^TMGDBAPI(.TMGMSG) quit
|
|---|
| 437 | do UPDATE^DIE("ES","TMGFDA","TMGIDE","TMGMSG")
|
|---|
| 438 | if $$ShowIfError^TMGDBAPI(.TMGMSG) quit
|
|---|
| 439 |
|
|---|
| 440 | quit
|
|---|
| 441 |
|
|---|
| 442 |
|
|---|
| 443 |
|
|---|
| 444 | READ(timeout)
|
|---|
| 445 | D INITKB^XGF("*") ;"turn on escape processing
|
|---|
| 446 | set timeout=$get(timeout,1)
|
|---|
| 447 | write "Testing keyboard with timeout=",timeout," sec",!
|
|---|
| 448 |
|
|---|
| 449 | R2 set s=$$READ^TMGWSCR(1,3)
|
|---|
| 450 |
|
|---|
| 451 | if s="^" goto RDone
|
|---|
| 452 | if s'="" goto R2
|
|---|
| 453 | if XGRT'="" do goto R2
|
|---|
| 454 | . if XGRT'="CR" write "[",XGRT,"]" quit
|
|---|
| 455 | . new temp set temp=$$READ^TMGWSCR(1,timeout) ;"double clicks must occur within ~1 sec
|
|---|
| 456 | . if (temp="")&(XGRT="CR") do
|
|---|
| 457 | . . write "[","DOUBLECLICK","]"
|
|---|
| 458 | . else do
|
|---|
| 459 | . . write "[CLICK]"
|
|---|
| 460 | . . do UNREAD^TMGWSCR(temp,XGRT)
|
|---|
| 461 |
|
|---|
| 462 | RDone
|
|---|
| 463 | do RESETKB^XGF ;"reset keyboard(escape processing off, terminators off)
|
|---|
| 464 |
|
|---|
| 465 | quit
|
|---|
| 466 |
|
|---|
| 467 | MathGame
|
|---|
| 468 | new n,i,st,et,tt
|
|---|
| 469 | new a,b
|
|---|
| 470 | new NCor,NWrong
|
|---|
| 471 | new NumQs set NumQs=20
|
|---|
| 472 | new abort set abort=0
|
|---|
| 473 | LOOP
|
|---|
| 474 | set st=$piece($H,",",2)
|
|---|
| 475 | set NCor=0,NWrong=0
|
|---|
| 476 | for i=1:1:NumQs do quit:(abort=1)
|
|---|
| 477 | . set a=$random(10),b=$random(10)
|
|---|
| 478 | . write #,!!
|
|---|
| 479 | . write "#",i," What is ",a," x ",b,"? "
|
|---|
| 480 | . read n,!
|
|---|
| 481 | . if n="^" set abort=1 quit
|
|---|
| 482 | . if +n=(a*b) do
|
|---|
| 483 | . . write "CORRECT!",!
|
|---|
| 484 | . . set NCor=NCor+1
|
|---|
| 485 | . else do
|
|---|
| 486 | . . write "WRONG. It is ",a*b,!
|
|---|
| 487 | . . set NWrong=NWrong+1
|
|---|
| 488 | . . read "Press ENTER to continue...",n,!
|
|---|
| 489 | set et=$piece($H,",",2)
|
|---|
| 490 | set tt=et-st
|
|---|
| 491 | write "It took you ",tt," seconds to complete the game (",tt/NumQs," sec each)",!
|
|---|
| 492 | write "You had ",NCor," correct answers and ",NWrong," wrong answers.",!
|
|---|
| 493 | read "Do you want to play again? (y/n)? ",n,!
|
|---|
| 494 | if n="y" goto LOOP
|
|---|
| 495 | quit
|
|---|
| 496 |
|
|---|
| 497 |
|
|---|
| 498 |
|
|---|
| 499 | TGT
|
|---|
| 500 | new DIC
|
|---|
| 501 | set DIC=200,DIC(0)="MAEQ"
|
|---|
| 502 | do ^DIC
|
|---|
| 503 | write !,Y,!
|
|---|
| 504 | quit
|
|---|
| 505 |
|
|---|
| 506 |
|
|---|
| 507 | DNTest
|
|---|
| 508 | new tempArray
|
|---|
| 509 | new FILE set FILE=0
|
|---|
| 510 | for set FILE=$O(^DD(FILE)) quit:'FILE do
|
|---|
| 511 | . new X
|
|---|
| 512 | . new field set field=0
|
|---|
| 513 | . for set field=$order(^DD(FILE,field)) quit:(+field'>0) do
|
|---|
| 514 | . . if '($D(^DD(FILE,field,0))#2) quit
|
|---|
| 515 | . . set X=^DD(FILE,field,0)
|
|---|
| 516 | . . if $P(X,U,5,99)["DINUM" do
|
|---|
| 517 | . . . new P2 set P2=$piece(X,"^",2)
|
|---|
| 518 | . . . if P2'["P" write "!!-->",X,! quit
|
|---|
| 519 | . . . new targetFile
|
|---|
| 520 | . . . set targetFile=+$piece(P2,"P",2)
|
|---|
| 521 | . . . if targetFile=0 write "?? --->",X,!
|
|---|
| 522 | . . . set tempArray(targetFile,FILE)=""
|
|---|
| 523 | . . . set tempArray("B",FILE,targetFile)=""
|
|---|
| 524 |
|
|---|
| 525 | ;"zwr tempArray
|
|---|
| 526 |
|
|---|
| 527 | quit
|
|---|
| 528 |
|
|---|
| 529 | X12
|
|---|
| 530 | new ref
|
|---|
| 531 | new output
|
|---|
| 532 | set ref="ExtraB"
|
|---|
| 533 | for set ref=$query(@ref) quit:(ref="") do
|
|---|
| 534 | . new s1,i
|
|---|
| 535 | . set s1=$qsubscript(ref,1)
|
|---|
| 536 | . new newRef set newRef="output("""_$qs(s1,0)_""")"
|
|---|
| 537 | . if $qlength(s1)>1 do
|
|---|
| 538 | . . for i=1:1:$qlength(s1) do
|
|---|
| 539 | . . . set newRef=$name(@newRef@($qsubscript(s1,i)))
|
|---|
| 540 | . for i=2:1:$qlength(ref) do
|
|---|
| 541 | . . set newRef=$name(@newRef@($qsubscript(ref,i)))
|
|---|
| 542 | . merge @newRef=@ref
|
|---|
| 543 | . ;"write ref," ---- :",newRef,!
|
|---|
| 544 |
|
|---|
| 545 | zwr output
|
|---|
| 546 |
|
|---|
| 547 | quit
|
|---|
| 548 |
|
|---|
| 549 |
|
|---|
| 550 | X13
|
|---|
| 551 | new TMGdbgLine
|
|---|
| 552 | do INITKB^XGF() ;"set up keyboard input escape code processing
|
|---|
| 553 |
|
|---|
| 554 | set TMGdbgLine=$$READ^XGKB(,604800)
|
|---|
| 555 | ;"read TMGdbgLine,!
|
|---|
| 556 | write "[TMGXGRT=",TMGXGRT,"]",!
|
|---|
| 557 | write TMGdbgLine,!
|
|---|
| 558 | quit
|
|---|
| 559 |
|
|---|
| 560 |
|
|---|
| 561 | XFR
|
|---|
| 562 | set DIC=200
|
|---|
| 563 | set DIC(0)="MAEQ"
|
|---|
| 564 | set DIC("A")="Enter FROM person: "
|
|---|
| 565 | do ^DIC write !
|
|---|
| 566 | if +Y'>0 quit
|
|---|
| 567 | new FromIEN set FromIEN=+Y
|
|---|
| 568 |
|
|---|
| 569 | set DIC("A")="Enter TO person: "
|
|---|
| 570 | do ^DIC write !
|
|---|
| 571 | if +Y'>0 quit
|
|---|
| 572 | new ToIEN set ToIEN=+Y
|
|---|
| 573 |
|
|---|
| 574 | new flags
|
|---|
| 575 | read "Enter mode flags (MOARX): ",flags
|
|---|
| 576 |
|
|---|
| 577 | do TRNMRG^DIT(flags,200,200,FromIEN_",",ToIEN_",")
|
|---|
| 578 |
|
|---|
| 579 | quit
|
|---|
| 580 |
|
|---|
| 581 |
|
|---|
| 582 |
|
|---|
| 583 | nums
|
|---|
| 584 | set IO=$P
|
|---|
| 585 | do IOCapON^TMGKERNL
|
|---|
| 586 |
|
|---|
| 587 | new i
|
|---|
| 588 | for i=1:1:1000 do
|
|---|
| 589 | . write "Num #",i,!
|
|---|
| 590 |
|
|---|
| 591 | new saved
|
|---|
| 592 | do IOCapOFF^TMGKERNL("saved")
|
|---|
| 593 | if $data(saved) zwr saved
|
|---|
| 594 | do PressToCont^TMGUSRIF
|
|---|
| 595 |
|
|---|
| 596 | quit
|
|---|
| 597 |
|
|---|
| 598 |
|
|---|
| 599 |
|
|---|
| 600 | MATH(num1,num2)
|
|---|
| 601 | quit (num1+num2)**2
|
|---|
| 602 |
|
|---|
| 603 | G(Fn,v)
|
|---|
| 604 | ;"Purpose: To evaluate Fn pointer
|
|---|
| 605 | ;"Input: Fn -- Must be NAMe of function with format as follow:
|
|---|
| 606 | ;" 'SomeFunctionName("abc",-4,"99",.01,var)'
|
|---|
| 607 | ;" Note: the last variable may be of any name
|
|---|
| 608 | ;" v -- the value to be used in place of last variable in Fn
|
|---|
| 609 | ;"Output: Returns curried form of Fn
|
|---|
| 610 | NEW S SET S=$P($P(Fn,")",1),"(",2)
|
|---|
| 611 | NEW L SET L=$L(S,",")
|
|---|
| 612 | ;"Now substitue in value for variable
|
|---|
| 613 | IF L>1 SET $P(S,",",L)=v
|
|---|
| 614 | ELSE SET S=v
|
|---|
| 615 | NEW LFn set LFn=$P(Fn,"(",1)_"("_S_")"
|
|---|
| 616 | NEW R SET @("R=$$"_LFn)
|
|---|
| 617 | QUIT R
|
|---|
| 618 |
|
|---|
| 619 |
|
|---|
| 620 | CURRY(Fn,v)
|
|---|
| 621 | ;"Purpose: To create a curried form of Fn
|
|---|
| 622 | ;" e.g. 'MyFunct(A,B,C,D,...)' --> 'MyFunct(99,B,C,D,...)'
|
|---|
| 623 | ;"Input: Fn -- Must be NAMe of function with format as follow:
|
|---|
| 624 | ;" 'SomeFunctionName(A,B,C,D,...)'
|
|---|
| 625 | ;" Note: the first variable name may be any name
|
|---|
| 626 | ;" x -- the value to be used in function
|
|---|
| 627 | ;"Output: Returns curried form of Fn
|
|---|
| 628 | NEW S SET S=$P($P(Fn,")",1),"(",2) ;adadfsdasdf
|
|---|
| 629 | ;"Now substitue in value for variable
|
|---|
| 630 | IF $L(S,",")>1 SET $P(S,",",1)=v
|
|---|
| 631 | ELSE SET S=x
|
|---|
| 632 | quit $P(Fn,"(",1)_"("_S_")" ;"return curried form of function
|
|---|
| 633 |
|
|---|
| 634 | GETFN()
|
|---|
| 635 | quit "MATH(X,Y)"
|
|---|
| 636 |
|
|---|
| 637 | FNTEST
|
|---|
| 638 | new Fn set Fn=$$GETFN()
|
|---|
| 639 | new Fn2 set Fn2=$$CURRY(Fn,7) ;"Fn2 set to 'MATH(7,Y)'
|
|---|
| 640 | write $$G(Fn2,123) ;"Will effect MATCH(7,123)
|
|---|
| 641 | quit
|
|---|
| 642 |
|
|---|
| 643 |
|
|---|
| 644 |
|
|---|
| 645 | CLSCHED
|
|---|
| 646 | write !,"--- CLEAR SCHEDULE UTILITY --- CAUTION!!!",!
|
|---|
| 647 | new X,Y,DIC
|
|---|
| 648 | set DIC=44
|
|---|
| 649 | set DIC(0)="MAEQ"
|
|---|
| 650 | do ^DIC write !
|
|---|
| 651 | set Y=+Y
|
|---|
| 652 | if Y'>0 quit
|
|---|
| 653 | new % set %=2
|
|---|
| 654 | write "Clear out ALL AVAILABILITY slots in this location"
|
|---|
| 655 | do YN^DICN write !
|
|---|
| 656 | if %'=1 quit
|
|---|
| 657 | new D set D=0
|
|---|
| 658 | for set D=$order(^SC(Y,"ST",D)) quit:(D'>0) do
|
|---|
| 659 | . kill ^SC(Y,"ST",D)
|
|---|
| 660 | set D=0
|
|---|
| 661 | for set D=$order(^SC(Y,"OST",D)) quit:(D'>0) do
|
|---|
| 662 | . kill ^SC(Y,"OST",D)
|
|---|
| 663 | set D=0
|
|---|
| 664 | for set D=$order(^SC(Y,"T",D)) quit:(D'>0) do
|
|---|
| 665 | . kill ^SC(Y,"T",D)
|
|---|
| 666 | new i
|
|---|
| 667 | for i=0:1:6 do
|
|---|
| 668 | . set D=0
|
|---|
| 669 | . for set D=$order(^SC(Y,"T"_i,D)) quit:(D'>0) do
|
|---|
| 670 | . . kill ^SC(Y,"T"_i,D)
|
|---|
| 671 |
|
|---|
| 672 | write "done"
|
|---|
| 673 | quit
|
|---|
| 674 |
|
|---|
| 675 |
|
|---|
| 676 |
|
|---|
| 677 | SHOWSCH
|
|---|
| 678 | new i set i=0
|
|---|
| 679 | new L1,L2,L3 set (L1,L2,L3)=""
|
|---|
| 680 | for set i=$order(^SC(10,"T1",i)) quit:(i'>0) do
|
|---|
| 681 | . new label set label=$get(^SC(10,"T1",i,1))
|
|---|
| 682 | . set label=$e(label,1,7)
|
|---|
| 683 | . set L1=L1_" "_$$LJ^XLFSTR(label,8)_" "
|
|---|
| 684 | . set L2=L2_"+------->|"
|
|---|
| 685 | . set L3=L3_$$RJ^XLFSTR(i,10)
|
|---|
| 686 | write L1,!,L2,!,L3,!
|
|---|
| 687 | quit
|
|---|
| 688 |
|
|---|
| 689 |
|
|---|
| 690 | TESTADD
|
|---|
| 691 | new %,TMGIEN,DOW
|
|---|
| 692 | set TMGIEN=10
|
|---|
| 693 | set DOW=1
|
|---|
| 694 | for do quit:%'=1
|
|---|
| 695 | . do SHOWSCH
|
|---|
| 696 | . set %=1
|
|---|
| 697 | . write "Add range" do YN^DICN write !
|
|---|
| 698 | . if %'=1 quit
|
|---|
| 699 | . new start,end,str
|
|---|
| 700 | . new %DT set %DT="EAF"
|
|---|
| 701 | . write "Enter starting " do ^%DT
|
|---|
| 702 | . set start=Y
|
|---|
| 703 | . write " Enter ending " do ^%DT
|
|---|
| 704 | . set end=Y
|
|---|
| 705 | . read " Enter string for range: ",str,!
|
|---|
| 706 | . do FILTEMPL^TMGSDAVS(start,end,1,str)
|
|---|
| 707 | . set %=1
|
|---|
| 708 |
|
|---|
| 709 | do CLSCHED
|
|---|
| 710 |
|
|---|
| 711 | quit
|
|---|
| 712 |
|
|---|
| 713 |
|
|---|
| 714 | ADDSCH1
|
|---|
| 715 | do SHOWSCH
|
|---|
| 716 | new %
|
|---|
| 717 | new TMGIEN set TMGIEN=10
|
|---|
| 718 | new PATRN,MODE,MSG,Date1,Date2,Y
|
|---|
| 719 |
|
|---|
| 720 | set %=2
|
|---|
| 721 | write "Clear clinic before starting" do YN^DICN write !
|
|---|
| 722 | if %=-1 quit
|
|---|
| 723 | if %=1 do CLSCHED
|
|---|
| 724 |
|
|---|
| 725 | new %DT set %DT="EAF"
|
|---|
| 726 | L0 kill PATRN
|
|---|
| 727 | write "Enter Starting Date for template:" do ^%DT write !
|
|---|
| 728 | if Y=-1 goto ASDone
|
|---|
| 729 | set Date1=Y
|
|---|
| 730 | write "Enter Range Ending Date ([ENTER] for 1 day only / indefinite pattern):" do ^%DT write !
|
|---|
| 731 | set Date2=Y
|
|---|
| 732 | new % set %=1
|
|---|
| 733 | if Date2<1 do
|
|---|
| 734 | . write "Use pattern indefinitely after starting date" do YN^DICN write !
|
|---|
| 735 | . if %=1 set Date2="I" quit
|
|---|
| 736 | . set Date2=""
|
|---|
| 737 | if %=-1 goto ASDone
|
|---|
| 738 | new TimeRange,ApptsPerSlot
|
|---|
| 739 | new Result
|
|---|
| 740 | L1 read "Enter a time range (e.g. 0830-1145), ^ or [ENTER] if done: ",TimeRange,!
|
|---|
| 741 | if (TimeRange="^")!(TimeRange="") goto L2
|
|---|
| 742 | read "Enter Appts Per Slot: ",ApptsPerSlot,!
|
|---|
| 743 | if ApptsPerSlot="^" goto L2
|
|---|
| 744 | set PATRN(Date1_"^"_Date2,TimeRange)=ApptsPerSlot
|
|---|
| 745 | goto L1
|
|---|
| 746 | L2 set flags=""
|
|---|
| 747 | set Result=$$SETAVAIL^TMGSDAVS(TMGIEN,.PATRN,flags,.MSG)
|
|---|
| 748 | if Result=1 write "Success!",!
|
|---|
| 749 | else do
|
|---|
| 750 | . write "Here is message array:",!
|
|---|
| 751 | . zwr MSG
|
|---|
| 752 |
|
|---|
| 753 | set %=2
|
|---|
| 754 | write "View clinic array now" do YN^DICN write !
|
|---|
| 755 | if %=-1 goto ASDone
|
|---|
| 756 | if %=1 do
|
|---|
| 757 | . write "Here is Clinic array now:",!
|
|---|
| 758 | . zwr ^SC(TMGIEN,*)
|
|---|
| 759 |
|
|---|
| 760 | set %=1
|
|---|
| 761 | write "Add more patterns" do YN^DICN write !
|
|---|
| 762 | if %=1 goto L0
|
|---|
| 763 |
|
|---|
| 764 |
|
|---|
| 765 | ASDone
|
|---|
| 766 | do CLSCHED
|
|---|
| 767 | quit
|
|---|
| 768 |
|
|---|
| 769 | ADDSCH2
|
|---|
| 770 | do SHOWSCH
|
|---|
| 771 | new TMGIEN set TMGIEN=10
|
|---|
| 772 | new Result
|
|---|
| 773 | new PATRN,MODE,MSG,Date1,Date2,Y
|
|---|
| 774 | new %DT set %DT=""
|
|---|
| 775 | new X
|
|---|
| 776 | set X="12/15/2008" do ^%DT set Date1=Y
|
|---|
| 777 | set PATRN(Date1,"0830-1000")=2
|
|---|
| 778 | set X="12/22/2008" do ^%DT set Date2=Y
|
|---|
| 779 | set PATRN(Date2,"0830-1000")=2
|
|---|
| 780 | set flags=""
|
|---|
| 781 | set Result=$$SETAVAIL^TMGSDAVS(TMGIEN,.PATRN,flags,.MSG)
|
|---|
| 782 | if Result=1 write "Success!"
|
|---|
| 783 | else do
|
|---|
| 784 | . write "Here is message array:",!
|
|---|
| 785 | . zwr MSG
|
|---|
| 786 |
|
|---|
| 787 | write "Here is Clinic array now:",!
|
|---|
| 788 | zwr ^SC(TMGIEN,*)
|
|---|
| 789 |
|
|---|
| 790 | do CLSCHED
|
|---|
| 791 | quit
|
|---|
| 792 |
|
|---|
| 793 | ADDSCH3
|
|---|
| 794 | do SHOWSCH
|
|---|
| 795 | new TMGIEN set TMGIEN=10
|
|---|
| 796 | new Result
|
|---|
| 797 | new PATRN,MODE,MSG,Date1,Date2,Y
|
|---|
| 798 | new %DT set %DT=""
|
|---|
| 799 | new X
|
|---|
| 800 | set X="12/15/2008" do ^%DT set Date1=Y
|
|---|
| 801 | set PATRN(Date1_"^I","0830-1000")=2
|
|---|
| 802 | set flags=""
|
|---|
| 803 | set Result=$$SETAVAIL^TMGSDAVS(TMGIEN,.PATRN,flags,.MSG)
|
|---|
| 804 | if Result=1 write "Success!"
|
|---|
| 805 | else do
|
|---|
| 806 | . write "Here is message array:",!
|
|---|
| 807 | . zwr MSG
|
|---|
| 808 |
|
|---|
| 809 | write "Here is Clinic array now:",!
|
|---|
| 810 | zwr ^SC(TMGIEN,*)
|
|---|
| 811 |
|
|---|
| 812 | do CLSCHED
|
|---|
| 813 | quit
|
|---|
| 814 |
|
|---|
| 815 |
|
|---|
| 816 |
|
|---|
| 817 | xx1(var)
|
|---|
| 818 | write var,!
|
|---|
| 819 | quit
|
|---|
| 820 |
|
|---|
| 821 | xx2
|
|---|
| 822 | set s="hello"
|
|---|
| 823 | do xx1(s)
|
|---|
| 824 | set s=$char(9)_"hello"
|
|---|
| 825 | do xx1(s)
|
|---|
| 826 | new fn set fn="do xx1("""_s_""")"
|
|---|
| 827 | write fn,!
|
|---|
| 828 | xecute fn
|
|---|
| 829 | quit
|
|---|
| 830 |
|
|---|
| 831 | INT
|
|---|
| 832 | write "Starting an endless cycle. ESC to abort",!
|
|---|
| 833 | new abort set abort=0
|
|---|
| 834 | INT2 if $$UserAborted^TMGUSRIF("from INT^TMGTEST") goto INT3
|
|---|
| 835 | hang 0.1
|
|---|
| 836 | if $get(TMGBRK)="??" do
|
|---|
| 837 | . zshow "*"
|
|---|
| 838 | . set TMGBRK=""
|
|---|
| 839 | if $get(TMGBRK)'="" quit
|
|---|
| 840 | goto INT2
|
|---|
| 841 | INT3 write "Goodbye!",!
|
|---|
| 842 | quit
|
|---|
| 843 |
|
|---|
| 844 |
|
|---|
| 845 | SEND(DocID)
|
|---|
| 846 | new lst,info
|
|---|
| 847 | ;
|
|---|
| 848 | set TMGDEBUG=1
|
|---|
| 849 | new pwd
|
|---|
| 850 | set pwd=" U(?Ec%U{,"
|
|---|
| 851 | ;"set pwd="" 3U
|
|---|
| 852 | set info(1)=DocID_";1^1^1^E"
|
|---|
| 853 | do SEND^ORWDX(.list,70685,73,6,pwd,.info)
|
|---|
| 854 | quit
|
|---|
| 855 |
|
|---|
| 856 |
|
|---|
| 857 | fields
|
|---|
| 858 | S FILE=2,FIELD=0
|
|---|
| 859 | F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD do
|
|---|
| 860 | . S NODE=$G(^(FIELD,0))
|
|---|
| 861 | . I NODE="" quit
|
|---|
| 862 | . S NAME=$P(NODE,U)
|
|---|
| 863 | . set REQUIRED=$P(NODE,U,2)["R"
|
|---|
| 864 | . set ID=''$D(^DD(FILE,0,"ID",FIELD))
|
|---|
| 865 | . if REQUIRED set FIELD("1 REQUIRED",FIELD)=NAME
|
|---|
| 866 | . if ID set FIELD("2 IDENTIFIER",FIELD)=NAME
|
|---|
| 867 | . if REQUIRED&ID set FIELD("3 REQUIRED & IDENTIFIER",FIELD)=NAME
|
|---|
| 868 | . ;I REQUIRED!ID S FIELD(FIELD)=NAME_U_REQUIRED_U_ID
|
|---|
| 869 | zwr FIELD
|
|---|
| 870 | quit
|
|---|
