├── .dockerignore ├── .editorconfig ├── .gitattributes ├── .gitignore ├── .vscode └── settings.json ├── Dockerfile ├── Installer.cls ├── LICENSE ├── README.md ├── docker-compose.yml ├── irissession.sh ├── module.xml └── src └── ObjectScript ├── DataEntry1.cls ├── DataEntry2.cls ├── DataEntry3.cls ├── DataEntry4.cls ├── Examples.cls ├── Lookup1.cls ├── Lookup2.cls ├── Lookup3.cls ├── Person.cls └── RightTriangle.cls /.dockerignore: -------------------------------------------------------------------------------- 1 | **/.DS_Store -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | root = true 2 | 3 | [*] 4 | indent_style = space 5 | indent_size = 2 6 | charset = utf-8 7 | trim_trailing_whitespace = false 8 | insert_final_newline = false -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | *.sh text eol=lf 2 | *.cls text eol=lf 3 | *.mac text eol=lf 4 | *.int text eol=lf 5 | Dockerfil* text eol=lf -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "files.associations": { 3 | 4 | "Dockerfile*": "dockerfile", 5 | }, 6 | "objectscript.conn" :{ 7 | "ns": "SAMPLES", 8 | "active": true, 9 | "docker-compose": { 10 | "service": "iris", 11 | "internalPort": 52773 12 | } 13 | }, 14 | "objectscript.conn.active": true, 15 | 16 | 17 | 18 | } -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | ARG IMAGE=intersystems/iris:2019.1.0S.111.0 2 | ARG IMAGE=store/intersystems/irishealth:2019.3.0.308.0-community 3 | ARG IMAGE=store/intersystems/iris-community:2019.3.0.309.0 4 | ARG IMAGE=store/intersystems/iris-community:2019.4.0.379.0 5 | ARG IMAGE=intersystemsdc/iris-community 6 | FROM $IMAGE 7 | 8 | USER root 9 | 10 | WORKDIR /opt/irisapp 11 | RUN chown ${ISC_PACKAGE_MGRUSER}:${ISC_PACKAGE_IRISGROUP} /opt/irisapp 12 | 13 | USER irisowner 14 | 15 | COPY Installer.cls . 16 | COPY src src 17 | COPY irissession.sh / 18 | SHELL ["/irissession.sh"] 19 | 20 | RUN \ 21 | do $SYSTEM.OBJ.Load("Installer.cls", "ck") \ 22 | set sc = ##class(App.Installer).setup() 23 | 24 | # bringing the standard shell back 25 | SHELL ["/bin/bash", "-c"] 26 | CMD [ "-l", "/usr/irissys/mgr/messages.log" ] 27 | -------------------------------------------------------------------------------- /Installer.cls: -------------------------------------------------------------------------------- 1 | Class App.Installer 2 | { 3 | 4 | XData setup 5 | { 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 21 | 22 | 23 | 24 | } 25 | 26 | ClassMethod setup(ByRef pVars, pLogLevel As %Integer = 3, pInstaller As %Installer.Installer, pLogger As %Installer.AbstractLogger) As %Status [ CodeMode = objectgenerator, Internal ] 27 | { 28 | #; Let XGL document generate code for this method. 29 | Quit ##class(%Installer.Manifest).%Generate(%compiledclass, %code, "setup") 30 | } 31 | 32 | } 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 InterSystems Corporation 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | This is the README file for SAMPLES-ObjectScript. The end of the file has setup instructions. 3 | 4 | Use or operation of this code is subject to acceptance of the license available in the code repository for this code. 5 | 6 | SAMPLES-ObjectScript is meant for use with the InterSystems IRIS Data Platform. This code sample is intended to be used with the [ObjectScript Tutorial](http://docs.intersystems.com/irislatest/csp/docbook/DocBook.UI.Page.cls?KEY=TOS_Preface). 7 | 8 | The `ObjectScript` folder contains 10 files: 9 | 10 | * `RightTriangle.cls` is a simple example of a class definition with a few methods. 11 | * `Examples.cls` contains all the examples of methods shown throughout the tutorial. 12 | * Four `DataEntry#.cls` files (1-4) that contain the completed solutions to exercises 1-4. 13 | * Three `Lookup#.cls` files (5-7) that contain the completed solutions to exercises 5-7. 14 | * `Person.cls` is a simple example of a persistent class. 15 | 16 | ## Setup instructions 17 | To set up the sample: 18 | 19 | 1. Clone or [download](http://docs.intersystems.com/irislatest/csp/docbook/DocBook.UI.Page.cls?KEY=asamples) the repository. 20 | 2. If you have not yet created a namespace in InterSystems IRIS, follow the [detailed instructions](http://docs.intersystems.com/irislatest/csp/docbook/DocBook.UI.Page.cls?KEY=GSA_config_namespace_create) to do so. 21 | 3. Using VS Code - ObjectScript, create a workspace that's connected to your instance of InterSystems IRIS. The main workspace folder can have any name, and it should contain an "src" subfolder. 22 | 4. Copy the ObjectScript folder (and its contents) from the sample repository into the src folder. Now you can open any of the class files in VS Code. 23 | 5. Right-click each of the files and choose "Import and Compile". 24 | 25 | ## Setup instructions for IRIS in Docker container 26 | 27 | Make sure you have docker and git installed. 28 | 1. Clone the repository. 29 | 2. Run in a repository folder: 30 | ``` 31 | # docker-compose build 32 | # docker-compose up -d 33 | ``` 34 | This will run IRIS in docker container with port for Control Panel on 52791 35 | and will import all the code into SAMPLES namespace. 36 | 3. Open the terminal to IRIS with: 37 | ``` 38 | # docker-compose exec iris iris session iris 39 | USER>zn "SAMPLES" 40 | SAMPLES>w ##class(ObjectScript.Examples).DoubleByVal(2) 41 | 4 42 | ``` 43 | Work with tutorial 44 | 45 | 4. Integration with VSCode-ObjectScript 46 | Open the folder of the project in VSCode with installed ObjectScript plugin. 47 | VSCode will compile ObjectScript classes in IRIS container because of prepared .vscode/settings.json 48 | -------------------------------------------------------------------------------- /docker-compose.yml: -------------------------------------------------------------------------------- 1 | version: '3.6' 2 | services: 3 | iris: 4 | build: 5 | context: . 6 | dockerfile: Dockerfile 7 | restart: always 8 | command: --ISCAgent false 9 | ports: 10 | # - 51771 11 | - 1972:1972 12 | - 52773:52773 13 | - 53773 14 | volumes: 15 | # - ~/iris.key:/usr/irissys/mgr/iris.key 16 | - ./:/irisdev/app 17 | -------------------------------------------------------------------------------- /irissession.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | iris start $ISC_PACKAGE_INSTANCENAME quietly 4 | 5 | cat << EOF | iris session $ISC_PACKAGE_INSTANCENAME -U %SYS 6 | do ##class(%SYSTEM.Process).CurrentDirectory("$PWD") 7 | $@ 8 | if '\$Get(sc) do ##class(%SYSTEM.Process).Terminate(, 1) 9 | zn "%SYS" 10 | do ##class(SYS.Container).QuiesceForBundling() 11 | Do ##class(Security.Users).UnExpireUserPasswords("*") 12 | halt 13 | EOF 14 | 15 | exit=$? 16 | 17 | iris stop $ISC_PACKAGE_INSTANCENAME quietly 18 | 19 | exit $exit -------------------------------------------------------------------------------- /module.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | samples-objectscript 6 | 1.0.0 7 | module 8 | src 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /src/ObjectScript/DataEntry1.cls: -------------------------------------------------------------------------------- 1 | Class ObjectScript.DataEntry1 2 | { 3 | 4 | ClassMethod Main() 5 | { 6 | read !, "Name: " , name 7 | if name = "" { quit } // user entered nothing 8 | read !, "Phone: ", phone 9 | read !, "DOB: ", dob 10 | 11 | // display the data 12 | write !!!, "Name:", ?20, name 13 | write !, "Phone:", ?20, phone 14 | write !, "DOB:", ?20, dob 15 | } 16 | 17 | } 18 | -------------------------------------------------------------------------------- /src/ObjectScript/DataEntry2.cls: -------------------------------------------------------------------------------- 1 | Class ObjectScript.DataEntry2 2 | { 3 | 4 | /// Main loop section 5 | ClassMethod Main() 6 | { 7 | while ..Prompt() { 8 | do ..Display() 9 | } 10 | } 11 | 12 | /// prompt 13 | ClassMethod Prompt() As %Boolean [ PublicList = (name, phone, dob) ] 14 | { 15 | read !, "Name: ", name 16 | return:(name = "") 0 // user entered nothing so return FALSE and exit method 17 | read !, "Phone: ", phone 18 | read !, "DOB: ", dob 19 | return 1 // return true 20 | } 21 | 22 | /// display the data 23 | ClassMethod Display() [ PublicList = (name, phone, dob) ] 24 | { 25 | write !!, "========================================" 26 | write !, "Name:", ?20, name 27 | write !, "Phone:", ?20, phone 28 | write !, "DOB:", ?20, dob 29 | write !, "========================================", ! 30 | } 31 | 32 | } 33 | -------------------------------------------------------------------------------- /src/ObjectScript/DataEntry3.cls: -------------------------------------------------------------------------------- 1 | Class ObjectScript.DataEntry3 2 | { 3 | 4 | /// Main loop section 5 | ClassMethod Main() 6 | { 7 | while ..Prompt(.answers) { 8 | do ..Display(answers) 9 | } 10 | } 11 | 12 | /// prompt 13 | ClassMethod Prompt(ByRef answers As %String) As %Boolean 14 | { 15 | do { 16 | read !, "Name: ", name 17 | return:(name = "") 0 // user entered nothing so return FALSE, exit loop AND method 18 | } while '..ValidName(name) 19 | 20 | do { 21 | read !, "Phone (617): ", phone 22 | } while '..ValidPhone(.phone) 23 | 24 | do { 25 | read !, "DOB: ", dob 26 | } while '..ValidDOB(dob, .intdob) 27 | set answers = $listbuild(name, phone, intdob) 28 | return 1 // return true 29 | } 30 | 31 | /// use pattern match to validate a name in "Last,First" format. 32 | /// write error message if invalid 33 | ClassMethod ValidName(name As %String) As %Boolean 34 | { 35 | if (name?1U.L1","1U.L) { 36 | return 1 37 | } 38 | else { 39 | write !,"Last,First" 40 | return 0 41 | } 42 | } 43 | 44 | /// use RegEx ($match) to validate a phone in "###-####" or "###-###-####" format. 45 | /// returns the converted phone by reference 46 | /// write error message if invalid 47 | ClassMethod ValidPhone(ByRef phone As %String) As %Boolean 48 | { 49 | if $match(phone, "(\d{3}-)?\d{3}-\d{4}") { 50 | set:($match(phone, "\d{3}-\d{4}")) phone = "617-" _ phone // add default area code 51 | return 1 52 | } 53 | else { 54 | write !, "###-###-#### or ###-####" 55 | return 0 56 | } 57 | } 58 | 59 | /// validate a date of birth using $zdateh and $horolog 60 | /// returns the internal form of the date of birth by reference 61 | /// write error message if invalid 62 | ClassMethod ValidDOB(date As %String, Output convdate As %Date) As %Boolean 63 | { 64 | set convdate = $zdateh(date, 5,,,,,,, -1) 65 | if (convdate = -1) { 66 | write !,"Must be a valid past date" 67 | return 0 // invalid date 68 | } 69 | elseif (convdate > $piece($horolog, ",", 1)) { 70 | write !,"Must be a valid past date" 71 | return 0 // invalid because it's in the future 72 | } 73 | else { 74 | return 1 // valid date 75 | } 76 | } 77 | 78 | /// display the data 79 | ClassMethod Display(answers As %String) 80 | { 81 | set $listbuild(name, phone, intdob) = answers 82 | /* the line above is equivalent to 83 | set name = $list(answers, 1), 84 | phone = $list(answers, 2), 85 | intdob = $list(answers, 3) */ 86 | write !!, "========================================" 87 | write !, "Name:", ?20, name 88 | write !, "Phone:", ?20, phone 89 | write !, "DOB:", ?20, $zdate(intdob, 2) 90 | write !, "========================================", ! 91 | } 92 | 93 | } 94 | -------------------------------------------------------------------------------- /src/ObjectScript/DataEntry4.cls: -------------------------------------------------------------------------------- 1 | Class ObjectScript.DataEntry4 2 | { 3 | 4 | /// Main loop section 5 | ClassMethod Main() 6 | { 7 | while ..Prompt(.answers) { 8 | do ..Display(answers) 9 | do ..Store(answers) 10 | } 11 | } 12 | 13 | /// prompt 14 | ClassMethod Prompt(ByRef answers As %String) As %Boolean 15 | { 16 | do { 17 | read !, "Name: ", name 18 | return:(name = "") 0 // user entered nothing so return FALSE, exit loop AND method 19 | } While '..ValidName(name) 20 | 21 | do { 22 | read !, "Phone (617): ", phone 23 | } While '..ValidPhone(.phone) 24 | 25 | do { 26 | read !, "DOB: ", dob 27 | } While '..ValidDOB(dob, .intdob) 28 | 29 | set answers = $listbuild(name, phone, intdob) 30 | return 1 // return true 31 | } 32 | 33 | /// use pattern match to validate a name in "Last,First" format. 34 | /// write error message if invalid 35 | ClassMethod ValidName(name As %String) As %Boolean 36 | { 37 | if (name?1U.L1","1U.L) { 38 | return 1 39 | } 40 | else { 41 | write !,"Last,First" 42 | return 0 43 | } 44 | } 45 | 46 | /// use RegEx ($match) to validate a phone in "###-####" or "###-###-####" format. 47 | /// returns the converted phone by reference 48 | /// write error message if invalid 49 | ClassMethod ValidPhone(ByRef phone As %String) As %Boolean 50 | { 51 | if $match(phone, "(\d{3}-)?\d{3}-\d{4}") { 52 | set:($match(phone, "\d{3}-\d{4}")) phone = "617-" _ phone // add default area code 53 | // is phone already taken? 54 | if $data(^PersonI("Phone", phone)) { 55 | write !, "Phone number already in use" 56 | return 0 57 | } 58 | return 1 59 | } 60 | else { 61 | write !, "###-###-#### or ###-####" 62 | return 0 63 | } 64 | } 65 | 66 | /// validate a date of birth using $zdateh and $horolog 67 | /// returns the internal form of the date of birth by reference 68 | /// write error message if invalid 69 | ClassMethod ValidDOB(date As %String, Output convdate As %Date) As %Boolean 70 | { 71 | set convdate = $zdateh(date, 5,,,,,,, -1) 72 | if (convdate = -1) { 73 | write !,"Must be a valid past date" 74 | return 0 // invalid date 75 | } 76 | elseif (convdate > $piece($horolog, ",", 1)) { 77 | write !,"Must be a valid past date" 78 | return 0 // invalid because it's in the future 79 | } 80 | else { 81 | return 1 // valid date 82 | } 83 | } 84 | 85 | /// display the data 86 | ClassMethod Display(answers As %String) 87 | { 88 | set $listbuild(name, phone, intdob) = answers 89 | /* the line above is equivalent to 90 | set name = $list(answers, 1), 91 | phone = $list(answers, 2), 92 | intdob = $list(answers, 3) */ 93 | write !!, "========================================" 94 | write !, "Name:", ?20, name 95 | write !, "Phone:", ?20, phone 96 | write !, "DOB:", ?20, $zdate(intdob, 2) 97 | write !, "========================================", ! 98 | } 99 | 100 | /// store the data 101 | ClassMethod Store(answers As %String) 102 | { 103 | read !, "Store? (y/n): ", yn // ask if user wants to store 104 | // only go on if user says yes 105 | if ((yn '= "y") && (yn '= "Y")) { 106 | write "...not stored." 107 | quit 108 | } 109 | 110 | set id = $increment(^PersonD) // use $increment to generate a new ID 111 | // change all globals inside a transaction 112 | tstart 113 | set ^PersonD(id) = answers // store the answers 114 | 115 | set $listbuild(name, phone, intdob) = answers 116 | // split name into last and first for storage in index 117 | set last = $piece(name, ",", 1), first = $piece(name, ",", 2) 118 | 119 | /* the next three statements store data in subscripts. 120 | because of the automatic sorting of subscripts, 121 | this has the effect of building 3 indices: name, phone, and DOB */ 122 | set ^PersonI("Name", last, first, id) = "" // index last and first name 123 | set ^PersonI("Phone", phone) = id // index the UNIQUE phone 124 | set ^PersonI("DOB", intdob, id) = "" // index the internal DOB 125 | 126 | /* these statements turn the id into a "chunk #" and a "position #" 127 | and set a bit into the bitmap index */ 128 | set chunk = (id\64000) + 1, position = (id#64000) + 1 129 | set $bit(^PersonI("Bitmap-ID", chunk), position) = 1 130 | tcommit 131 | write "...stored" 132 | } 133 | 134 | /// load some test records 135 | ClassMethod Load() 136 | { 137 | kill ^PersonD, ^PersonI 138 | do ##class(ObjectScript.Person).%KillExtent() 139 | set answers = $listbuild("Jones,Cleon","111-111-1111",37105) 140 | do ..Store(answers) 141 | set person = ##class(ObjectScript.Person).%New() 142 | set person.Name = $list(answers, 1), person.Phone = $list(answers, 2), person.DOB = $list(answers, 3) 143 | write person.%Save(),! 144 | set answers = $listbuild("Agee,Tommie","617-333-3333",37110) 145 | do ..Store(answers) 146 | set person = ##class(ObjectScript.Person).%New() 147 | set person.Name = $list(answers, 1), person.Phone = $list(answers, 2), person.DOB = $list(answers, 3) 148 | write person.%Save(),! 149 | set answers = $listbuild("Swoboda,Ron","222-222-2222",37779) 150 | do ..Store(answers) 151 | set person = ##class(ObjectScript.Person).%New() 152 | set person.Name = $list(answers, 1), person.Phone = $list(answers, 2), person.DOB = $list(answers, 3) 153 | write person.%Save(),! 154 | set answers = $listbuild("Jones,Bobby","333-444-5555",47157) 155 | do ..Store(answers) 156 | set person = ##class(ObjectScript.Person).%New() 157 | set person.Name = $list(answers, 1), person.Phone = $list(answers, 2), person.DOB = $list(answers, 3) 158 | write person.%Save(),! 159 | } 160 | 161 | } 162 | -------------------------------------------------------------------------------- /src/ObjectScript/Examples.cls: -------------------------------------------------------------------------------- 1 | /// examples for ObjectScript Tutorial 2 | Class ObjectScript.Examples 3 | { 4 | 5 | /// demo of public and private methods, along with a public variable 6 | ClassMethod PrivatePublic() 7 | { 8 | do ..Private() // call a private method 9 | do ..Public(9) // call a public method 10 | } 11 | 12 | /// a private method with public variable a 13 | ClassMethod Private() [ Private, PublicList = a ] 14 | { 15 | write !, "setting a" set a = 1 16 | write !, "setting b" set b = 2 17 | write !, "setting c" set c = 3 18 | write !, "setting d" set d = 4 19 | } 20 | 21 | /// a public method with an argument and a return value 22 | ClassMethod Public(num As %Numeric) As %String 23 | { 24 | write !, "my favorite number is ", num 25 | return "This is my return value!!!" 26 | } 27 | 28 | /// demo of passing arguments by value and reference 29 | ClassMethod PassingArguments(num As %Numeric) 30 | { 31 | // pass by value read !, "Enter a number: ", num 32 | set dblnum = ..DoubleByVal(num) 33 | write !, "By Value: ", num, " doubled is: ", dblnum 34 | 35 | // num passed IN and OUT by reference 36 | write !, "By Reference 1: ", num 37 | do ..DoubleByRef1(.num) 38 | write " doubled is: ", num 39 | 40 | // num passed IN by value, result passed OUT by reference 41 | do ..DoubleByRef2(num, .result) 42 | write !, "By Reference 2: ", num, " doubled again is: ", result 43 | } 44 | 45 | ClassMethod DoubleByVal(anynumber As %Numeric) As %Numeric 46 | { 47 | return anynumber * 2 48 | } 49 | 50 | ClassMethod DoubleByRef1(ByRef anynumber As %Numeric) 51 | { 52 | set anynumber = anynumber * 2 53 | } 54 | 55 | ClassMethod DoubleByRef2(anynumber As %Numeric, Output retnumber As %Numeric) 56 | { 57 | set retnumber = anynumber * 2 58 | } 59 | 60 | /// demo of error 61 | ClassMethod BadMethod() 62 | { 63 | set a = 1 64 | set b = 2 65 | write c 66 | } 67 | 68 | /// root for my favorite team 69 | ClassMethod Root() 70 | { 71 | read "Team: ", t 72 | if (t = "") { quit } // stop execution if no team is specified 73 | if (t = "METS") { 74 | write !, "Go METS!" } 75 | else { 76 | write !, "Boo ", t, "!" } 77 | } 78 | 79 | /// demos of many Ifs 80 | ClassMethod If() 81 | { 82 | set x = 5, y = 0, z = -5 83 | if (x = 5) { write !, "x is equal to 5" } else { write !, "false" } 84 | if (x = 10) { write !, "x is equal to 10" } else { write !, "false" } 85 | if (x < y) { write !, "x is less than y" } else { write !, "false" } 86 | if (x > y) { write !, "x is greater than y" } else { write !, "false" } 87 | write ! 88 | if (##class(%SYSTEM.Util).NumberOfCPUs() > 2) { write !, "there are more than 2 CPUs" } else { write !, "false" } 89 | if (x > $zsqr(64)) { write !, "x is greater than square root of 64" } else { write !, "false" } 90 | write ! 91 | if (x && y) { write !, "both x and y are true (non-zero)" } else { write !, "false" } 92 | if (x && z) { write !, "both x and z are true (non-zero)" } else { write !, "false" } 93 | if (x && y && z) { write !, "x, y, and z are all true (non-zero)" } else { write !, "false" } 94 | if (x || y || z) { write !, "at least one of x, y, or z is true (non-zero)" } else { write !, "false" } 95 | write ! 96 | if ((x > y) || (y < z)) { write !, "either x is greater than y OR y is less than z" } else { write !, "false" } 97 | if (x > y || y < z) { write !, "without proper parentheses, this expression is false" } else { write !, "false" } 98 | if ((x > y) && (z < y)) { write !, "x is greater than y AND z is less than y" } else { write !, "false" } 99 | if (x > y && z < y) { write !, "without proper parentheses, this expression is also false" } else { write !, "false" } 100 | write ! 101 | if 'x { write !, "x is not true (zero)" } else { write !, "false" } 102 | if 'y { write !, "y is not true (zero)" } else { write !, "false" } 103 | if (x '< y) { write !, "x is not less than y" } else { write !, "false" } 104 | if '(x < y) { write !, "x is not less than y" } else { write !, "false" } 105 | } 106 | 107 | ClassMethod Celebrate() 108 | { 109 | write !, "Yippee! I won!" 110 | } 111 | 112 | ClassMethod Complain() 113 | { 114 | write !, "Oh well, I lost." 115 | } 116 | 117 | /// demos of the For construct 118 | ClassMethod For() 119 | { 120 | for i = 1:1:8 { 121 | write !, "I ", i, " the sandbox." 122 | } 123 | write !! 124 | for b = "John", "Paul", "George", "Ringo" { 125 | write !, "Was ", b, " the leader? " 126 | read yn 127 | } 128 | write !! 129 | for i = 1:1 { 130 | read !, "Capital of MA? ", a 131 | if (a = "BOSTON") { 132 | write "...did it in ", i, " tries" 133 | quit 134 | } 135 | } 136 | write !! 137 | for i = 1:1 { 138 | read !, "Capital of TX? ", a 139 | continue:(a '= "AUSTIN") 140 | write "...did it in ", i, " tries" 141 | quit 142 | } 143 | write !! 144 | for { 145 | read !, "Know what? ", wh 146 | quit:(wh = "NO!") 147 | write " That's what!" 148 | } 149 | } 150 | 151 | /// generate Fibonacci sequences 152 | ClassMethod Fibonacci() 153 | { 154 | read !, "Generate Fibonacci sequence up to where? ", upto 155 | 156 | set t1 = 1, t2 = 1, fib = 1 157 | write ! 158 | do { 159 | write fib, " " 160 | set fib = t1 + t2, t1 = t2, t2 = fib 161 | } 162 | while (fib '> upto) 163 | 164 | set t1 = 1, t2 = 1, fib = 1 165 | write ! 166 | while (fib '> upto) { 167 | write fib, " " 168 | set fib = t1 + t2, t1 = t2, t2 = fib 169 | } 170 | } 171 | 172 | /// examples of system and custom exceptions 173 | ClassMethod Exceptions(x As %Numeric) 174 | { 175 | // error throws a system exception 176 | try { 177 | write "Hello!", !, xyz 178 | } 179 | catch err { 180 | write !, "Error name: ", ?20, err.Name, 181 | !, "Error code: ", ?20, err.Code, 182 | !, "Error location: ", ?20, err.Location, 183 | !, "Additional data: ", ?20, err.Data, ! 184 | } 185 | 186 | // error throws a system exception 187 | try { 188 | write 1/0 189 | } 190 | catch err { 191 | write !, "Error name: ", ?20, err.Name, 192 | !, "Error code: ", ?20, err.Code, 193 | !, "Error location: ", ?20, err.Location, 194 | !, "Additional data: ", ?20, err.Data, ! 195 | } 196 | 197 | // create a simple custom exception object and throw it 198 | set ex = ##class(%Exception.General).%New() 199 | set ex.Name = "Demo Exception", 200 | ex.Code = 100000, 201 | ex.Data = "Tutorial Example" 202 | try { 203 | write !, "Hello!", ! 204 | if (x >= 5) throw ex // throw the exception 205 | } 206 | catch err { 207 | write !, "Error name: ", ?20, err.Name, 208 | !, "Error code: ", ?20, err.Code, 209 | !, "Error location: ", ?20, err.Location, 210 | !, "Additional data: ", ?20, err.Data, ! 211 | if (x = 5) return // terminate method 212 | } 213 | write !, "Finished!" 214 | } 215 | 216 | /// examples of JSON 217 | ClassMethod JSON() 218 | { 219 | // create a JSON object 220 | set jo1 = { "PartNum":"678LM", "Price":"7.99", "Quantity":"100" } 221 | // create a JSON array, and add it to the object 222 | set ar1 = ["Small","Large"], jo1.Sizes = ar1 223 | // change a size in the 0-based JSON array 224 | set ar1."0" = "Tiny" 225 | // turn the JSON into a string and display it 226 | set string1 = jo1.%ToJSON() 227 | write !, "First JSON object: ", !, string1 228 | 229 | // create a text string in JSON format 230 | set string2 = "{""PartNum"":""345JK"", ""Price"":5.99, ""Sizes"":[""Small"", ""Medium"", ""Large""], ""Quantity"":50}" 231 | // create an object from the string 232 | set jo2 = ##class(%DynamicObject).%FromJSON(string2) 233 | // display the properties of the object 234 | write !!, "Second JSON Object:" 235 | write !, "Part Number: ", jo2.PartNum, " Price: ", jo2.Price, " Quantity: ", jo2.Quantity 236 | write !, "Sizes" 237 | // loop through the array using an iterator 238 | set ar2 = jo2.Sizes 239 | set iter = ar2.%GetIterator() 240 | while iter.%GetNext(.key , .value ) { 241 | write !, ?5, "Key: ", key, ", Size: ", value 242 | } 243 | 244 | // change some of the properties 245 | set jo2.Price = "8.99", jo2.Quantity = 75 246 | // push a new size onto the end of the array 247 | do ar2.%Push("Extra Large") 248 | // turn the JSON into a string and display it 249 | write !!, "Changed Second JSON Object:" 250 | set newstring = jo2.%ToJSON() 251 | write !, newstring 252 | } 253 | 254 | /// loop through last names of the ^PersonI global, 2 different ways 255 | ClassMethod SimpleLoop() 256 | { 257 | write !, "Using argumentless For" 258 | set ln = "" // initialize to the empty string to make $order return the first last name 259 | for { // start looping 260 | set ln = $order(^PersonI("Name", ln)) // use the current last name to get the next 261 | quit:(ln = "") // stop looping when ln becomes empty again 262 | write !, ?5, ln 263 | } 264 | 265 | write !!, "Using While" 266 | set ln = $order(^PersonI("Name", "")) // get the first last name 267 | while (ln '= "") { // only loop if there is at least one last name 268 | write !, ?5, ln 269 | set ln = $order(^PersonI("Name", ln)) // use the current last name to get the next 270 | } 271 | } 272 | 273 | /// Loop through the name index and display the records 274 | ClassMethod NameLoop() 275 | { 276 | // loop through last names 277 | set ln = "" 278 | for { 279 | set ln = $order(^PersonI("Name", ln)) 280 | quit:(ln = "") 281 | // for each last name, loop through first names 282 | set fn = "" 283 | for { 284 | set fn = $order(^PersonI("Name", ln, fn)) 285 | quit:(fn = "") 286 | // for each last name and first name, loop through id numbers 287 | set id = "" 288 | for { 289 | set id = $order(^PersonI("Name", ln, fn, id)) 290 | quit:(id = "") 291 | // once you have an id number, get the data and display it 292 | set rec = ^PersonD(id) 293 | write !, $list(rec, 1), 294 | ?15, $list(rec, 2), 295 | ?30, $zdate($list(rec, 3), 2) 296 | } 297 | } 298 | } 299 | } 300 | 301 | /// loop through last names that FOLLOW a substring (including the substring) 302 | ClassMethod FocusedLoopStart() 303 | { 304 | read "Search for: ",substring 305 | // find the last name just BEFORE the substring and then start looping 306 | set ln = $order(^PersonI("Name", substring), -1) 307 | for { 308 | set ln = $order(^PersonI("Name", ln)) 309 | quit:(ln = "") 310 | write !, ln 311 | } 312 | } 313 | 314 | /// loop through last names that MATCH substring 315 | ClassMethod FocusedLoopStartEnd() 316 | { 317 | read "Search for: ",substring 318 | // find the last name just BEFORE the substring and then start looping 319 | set ln = $order(^PersonI("Name", substring), -1) 320 | for { 321 | set ln = $order(^PersonI("Name", ln)) 322 | // quit if no match or at end 323 | quit:($extract(ln, 1, $length(substring)) '= substring) 324 | write !, ln 325 | } 326 | } 327 | 328 | /// examples of conversion methods 329 | ClassMethod Conversions() 330 | { 331 | write !, "abcde becomes: ", $translate("abcde", "ad", "yz") // translate a->y, and d->z 332 | write !, "abcde becomes: ", $translate("abcde", "ad", "zz") // translate a->z, and d->z 333 | write !, "abcde becomes: ", $translate("abcde", "ad", "z") // translate a->z, and d->nothing 334 | write !, "abcdebcbc becomes: ", $translate("abcdebcbc", "abc", "yz") // translate a->y, b->z, and c->nothing 335 | write !, "abcdebcbc becomes: ", $replace("abcdebcbc", "abc", "yz") // replace abc->yz 336 | 337 | read !, "String to translate: ", x 338 | set lower = "abcdefghijklmnopqrstuvwxyz" 339 | set upper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 340 | write !, "Using $translate: ", $translate(x, lower, upper) 341 | write !, "Using $zconvert: ", $zconvert(x, "U") 342 | write !, "Using $zconvert for capitalizing words: ", $zconvert(x, "W") 343 | write !, "Using $zstrip to remove whitespace: ", $zstrip(x, "*W") 344 | } 345 | 346 | } 347 | -------------------------------------------------------------------------------- /src/ObjectScript/Lookup1.cls: -------------------------------------------------------------------------------- 1 | Class ObjectScript.Lookup1 2 | { 3 | 4 | /// main loop section, dispatch to different methods based on user input 5 | ClassMethod Main() 6 | { 7 | while ..GetInput(.type, .search) { 8 | if (type = "help") { do ..Help() } 9 | elseif (type = "dob") { do ..DOB(search) } 10 | } 11 | } 12 | 13 | /// prompt user for a lookup string, return search type and search string 14 | ClassMethod GetInput(Output type As %String, Output search As %String) As %Boolean 15 | { 16 | read !, "Lookup: ", lookup 17 | return:(lookup = "") 0 // user entered nothing so return FALSE 18 | if (lookup = "?") { 19 | set type = "help", search = "" 20 | } 21 | elseif (##class(ObjectScript.DataEntry4).ValidDOB(lookup, .convdate)) { 22 | set type = "dob", search = convdate 23 | } 24 | else { 25 | set (type, search) = "" 26 | } 27 | return 1 28 | } 29 | 30 | /// display lookup options 31 | ClassMethod Help() 32 | { 33 | write !, "You can enter:", 34 | !?10, "* date of birth", ! 35 | } 36 | 37 | /// exact date of birth lookup 38 | ClassMethod DOB(intdob As %Date) 39 | { 40 | // is the date of birth in the index? 41 | if '$data(^PersonI("DOB", intdob) ) { 42 | write "...no matches" 43 | quit 44 | } 45 | 46 | write "...finding birthday matches" 47 | // loop through IDs, and number them 48 | set id = "" 49 | for count = 1:1 { 50 | set id = $order(^PersonI("DOB", intdob, id)) 51 | quit:(id = "") 52 | write !, count, ") " 53 | do ..DisplayLine(id) 54 | } 55 | write ! 56 | } 57 | 58 | /// given an ID, retrieve data and write it on a line 59 | ClassMethod DisplayLine(id As %Integer) 60 | { 61 | set $listbuild(name, phone, intdob) = ^PersonD(id) 62 | /* the line above is equivalent to 63 | set answers = ^PersonD(id), 64 | name = $list(answers, 1), 65 | phone = $list(answers, 2), 66 | intdob = $list(answers, 3) */ 67 | write name, ?20, phone, ?35, $zdate(intdob, 2) 68 | } 69 | 70 | } 71 | -------------------------------------------------------------------------------- /src/ObjectScript/Lookup2.cls: -------------------------------------------------------------------------------- 1 | Class ObjectScript.Lookup2 2 | { 3 | 4 | /// main loop section, dispatch to different methods based on user input 5 | ClassMethod Main() 6 | { 7 | do ..CurrentCount() 8 | while ..GetInput(.type, .search) { 9 | if (type = "help") { do ..Help() set id = "" } 10 | elseif (type = "phone") { do ..Phone(search, .id) } 11 | elseif (type = "name") { do ..Name(search, .id) } 12 | elseif (type = "dob") { do ..DOB(search, .id) } 13 | if ((type '= "") && (id '= "")) { do ..TakeAction(id) } 14 | } 15 | } 16 | 17 | /// prompt user for a lookup string, return search type and search string 18 | ClassMethod GetInput(Output type As %String, Output search As %String) As %Boolean 19 | { 20 | read !, "Lookup: ", lookup 21 | return:(lookup = "") 0 // user entered nothing so return FALSE 22 | if (lookup = "?") { 23 | set type = "help", search = "" 24 | } 25 | // the RegEx accepts ###- or ###-###-#### only 26 | elseif $match(lookup, "\d{3}-(\d{3}-\d{4})?") { 27 | set type = "phone", search = lookup 28 | } 29 | /* the $zconvert converts the last name and first name entered to Last,First format 30 | the pattern match accepts Lastname only, or Lastname,Firstname */ 31 | elseif ($zconvert(lookup, "W")?1U.L.1(1","1U.L)) { 32 | set type = "name", search = $zconvert(lookup, "W") 33 | } 34 | elseif (##class(ObjectScript.DataEntry4).ValidDOB(lookup, .convdate)) { 35 | set type = "dob", search = convdate 36 | } 37 | else { 38 | // this is a hack for invalid input 39 | // ValidDOB() writes an error message, and the text below gets added to that 40 | write ", name, or phone" 41 | set (type, search) = "" 42 | } 43 | return 1 44 | } 45 | 46 | /// display lookup options 47 | ClassMethod Help() 48 | { 49 | write !, "You can enter:", 50 | !?10, "* date of birth", 51 | !?10, "* full phone number or area code only ""617-""", 52 | !?10, "* full name: Smith,John", 53 | !?10, "* last name: Smith", 54 | !?10, "* partial name: Sm,J or Smith,J or Sm,John", ! 55 | } 56 | 57 | /// exact date of birth lookup 58 | ClassMethod DOB(intdob As %Date, Output id As %Integer) 59 | { 60 | set id = "" 61 | // is the date of birth in the index? 62 | if '$data(^PersonI("DOB", intdob) ) { 63 | write "...no matches" 64 | quit 65 | } 66 | 67 | write "...finding birthday matches" 68 | // loop through IDs, and number them 69 | set id = "" 70 | for count = 1:1 { 71 | set id = $order(^PersonI("DOB", intdob, id)) 72 | quit:(id = "") 73 | set matches(count) = id // keep track of matches 74 | write !, count, ") " 75 | do ..DisplayLine(id) 76 | } 77 | do ..Select(.matches, .id) 78 | } 79 | 80 | /// lookup phone or area code 81 | ClassMethod Phone(phone As %String, Output id As %Integer) 82 | { 83 | set id = "" 84 | set count = 0 85 | // handle exact match first 86 | set id = $get(^PersonI("Phone", phone)) 87 | if (id '= "") { 88 | set count = 1 89 | set matches(1) = id // keep track of exact match 90 | write !, "1) " 91 | do ..DisplayLine(id) 92 | quit 93 | } 94 | // handle area code matches next 95 | elseif (phone?3n1"-") { 96 | // use 3-argument $order to get first matching phone number and its ID number 97 | set ph = $order(^PersonI("Phone", phone), 1, id) 98 | // loop through matching phones, and number them 99 | while ($extract(ph, 1, $length(phone)) = phone) { 100 | write:(count = 0) "...finding area code matches" 101 | set count = count + 1 102 | set matches(count) = id // keep track of matches 103 | write !, count, ") " 104 | do ..DisplayLine(id) 105 | // use 3-arg $order to get the next phone number and its ID number 106 | set ph = $order(^PersonI("Phone", ph), 1, id) 107 | } 108 | } 109 | if (count = 0) { write "...no matches" } 110 | else { do ..Select(.matches, .id) } 111 | } 112 | 113 | /// lookup names in these forms: Smith; Smith,John; Smith,J; Sm,John; Sm,J 114 | ClassMethod Name(name As %String, Output id As %Integer) 115 | { 116 | set id = "" 117 | set count = 0 118 | set last = $piece(name, ",", 1), first = $piece(name, ",", 2) 119 | // last may be an exact match, so find preceding last name 120 | set ln = $order(^PersonI("Name", last), -1) 121 | // loop through last names 122 | for { 123 | set ln = $order(^PersonI("Name", ln)) 124 | // quit as soon as last name doesn't match original 125 | quit:($extract(ln, 1, $length(last)) '= last) 126 | // first may be "". Otherwise, it may be an exact match, so find preceding first name 127 | if (first = "") { set fn = "" } 128 | else { set fn = $order(^PersonI("Name", ln, first), -1) } 129 | // loop through first names 130 | for { 131 | set fn = $order(^PersonI("Name", ln, fn)) 132 | // quit as soon as first name doesn't match original, or is "" 133 | quit:(($extract(fn, 1, $length(first)) '= first) || (fn = "")) 134 | set id = "" 135 | // loop through all IDs 136 | for { 137 | set id = $order(^PersonI("Name", ln, fn, id)) 138 | quit:(id = "") 139 | write:(count = 0) "...finding name matches" 140 | set count = count + 1 141 | set matches(count) = id // keep track of matches 142 | write !, count, ") " 143 | do ..DisplayLine(id) 144 | } 145 | } 146 | } 147 | if (count = 0) { write "...no matches" } 148 | else { do ..Select(.matches, .id) } 149 | } 150 | 151 | /// given an ID, retrieve data and write it on a line 152 | ClassMethod DisplayLine(id As %Integer) 153 | { 154 | set $listbuild(name, phone, intdob) = ^PersonD(id) 155 | /* the line above is equivalent to 156 | set answers = ^PersonD(id), 157 | name = $list(answers, 1), 158 | phone = $list(answers, 2), 159 | intdob = $list(answers, 3) */ 160 | write name, ?20, phone, ?35, $zdate(intdob, 2) 161 | } 162 | 163 | /// count the "1" bits from the chunks of the Bitmap-ID index 164 | ClassMethod CurrentCount() 165 | { 166 | set records = 0, chunk = "" 167 | for { 168 | // use the 3-argument $order to get the next chunk and the bits stored there 169 | set chunk = $order(^PersonI("Bitmap-ID", chunk), 1, bits) 170 | quit:(chunk = "") 171 | // add the "1" bits to the count 172 | set records = records + $bitcount(bits, 1) 173 | } 174 | write !, "There are ", records, " records in the database." 175 | } 176 | 177 | /// user makes a choice from the matches array, return the corresponding ID or "" 178 | ClassMethod Select(ByRef matches As %Integer, Output id As %Integer) 179 | { 180 | set id = "" 181 | for { 182 | read !!, "Choose by number: ", choice 183 | quit:(choice = "") 184 | set id = $get(matches(choice)) 185 | quit:(id '= "") // stop looping if user makes a valid choice 186 | write "...Invalid choice" 187 | } 188 | } 189 | 190 | /// display chosen record 191 | ClassMethod TakeAction(id As %Integer) 192 | { 193 | set rec = ^PersonD(id) 194 | do ##class(ObjectScript.DataEntry4).Display(rec) 195 | } 196 | 197 | } 198 | -------------------------------------------------------------------------------- /src/ObjectScript/Lookup3.cls: -------------------------------------------------------------------------------- 1 | Class ObjectScript.Lookup3 2 | { 3 | 4 | /// main loop section, dispatch to different methods based on user input 5 | ClassMethod Main() 6 | { 7 | do ..CurrentCount() 8 | while ..GetInput(.type, .search) { 9 | if (type = "help") { do ..Help() set id = "" } 10 | elseif (type = "phone") { do ..Phone(search, .id) } 11 | elseif (type = "name") { do ..Name(search, .id) } 12 | elseif (type = "dob") { do ..DOB(search, .id) } 13 | if ((type '= "") && (id '= "")) { do ..TakeAction(id) } 14 | } 15 | } 16 | 17 | /// prompt user for a lookup string, return search type and search string 18 | ClassMethod GetInput(Output type As %String, Output search As %String) As %Boolean 19 | { 20 | read !, "Lookup: ", lookup 21 | return:(lookup = "") 0 // user entered nothing so return FALSE 22 | if (lookup = "?") { 23 | set type = "help", search = "" 24 | } 25 | // the RegEx accepts ###- or ###-###-#### only 26 | elseif $match(lookup, "\d{3}-(\d{3}-\d{4})?") { 27 | set type = "phone", search = lookup 28 | } 29 | /* the $zconvert converts the last name and first name entered to Last,First format 30 | the pattern match accepts Lastname only, or Lastname,Firstname */ 31 | elseif ($zconvert(lookup, "W")?1U.L.1(1","1U.L)) { 32 | set type = "name", search = $zconvert(lookup, "W") 33 | } 34 | elseif (##class(ObjectScript.DataEntry4).ValidDOB(lookup, .convdate)) { 35 | set type = "dob", search = convdate 36 | } 37 | else { 38 | // this is a hack for invalid input 39 | // ValidDOB() writes an error message, and the text below gets added to that 40 | write ", name, or phone" 41 | set (type, search) = "" 42 | } 43 | return 1 44 | } 45 | 46 | /// display lookup options 47 | ClassMethod Help() 48 | { 49 | write !, "You can enter:", 50 | !?10, "* date of birth", 51 | !?10, "* full phone number or area code only ""617-""", 52 | !?10, "* full name: Smith,John", 53 | !?10, "* last name: Smith", 54 | !?10, "* partial name: Sm,J or Smith,J or Sm,John", ! 55 | } 56 | 57 | /// exact date of birth lookup 58 | ClassMethod DOB(intdob As %Date, Output id As %Integer) 59 | { 60 | set id = "" 61 | // is the date of birth in the index? 62 | if '$data(^PersonI("DOB", intdob) ) { 63 | write "...no matches" 64 | quit 65 | } 66 | 67 | write "...finding birthday matches" 68 | // loop through IDs, and number them 69 | set id = "" 70 | for count = 1:1 { 71 | set id = $order(^PersonI("DOB", intdob, id)) 72 | quit:(id = "") 73 | set matches(count) = id // keep track of matches 74 | write !, count, ") " 75 | do ..DisplayLine(id) 76 | } 77 | do ..Select(.matches, .id) 78 | } 79 | 80 | /// lookup phone or area code 81 | ClassMethod Phone(phone As %String, Output id As %Integer) 82 | { 83 | set id = "" 84 | set count = 0 85 | // handle exact match first 86 | set id = $get(^PersonI("Phone", phone)) 87 | if (id '= "") { 88 | set count = 1 89 | set matches(1) = id // keep track of exact match 90 | write !, "1) " 91 | do ..DisplayLine(id) 92 | quit 93 | } 94 | // handle area code matches next 95 | elseif (phone?3n1"-") { 96 | // use 3-argument $order to get first matching phone number and its ID number 97 | set ph = $order(^PersonI("Phone", phone), 1, id) 98 | // loop through matching phones, and number them 99 | while ($extract(ph, 1, $length(phone)) = phone) { 100 | write:(count = 0) "...finding area code matches" 101 | set count = count + 1 102 | set matches(count) = id // keep track of matches 103 | write !, count, ") " 104 | do ..DisplayLine(id) 105 | // use 3-arg $order to get the next phone number and its ID number 106 | set ph = $order(^PersonI("Phone", ph), 1, id) 107 | } 108 | } 109 | if (count = 0) { write "...no matches" } 110 | else { do ..Select(.matches, .id) } 111 | } 112 | 113 | /// lookup names in these forms: Smith; Smith,John; Smith,J; Sm,John; Sm,J 114 | ClassMethod Name(name As %String, Output id As %Integer) 115 | { 116 | set id = "" 117 | set count = 0 118 | set last = $piece(name, ",", 1), first = $piece(name, ",", 2) 119 | // last may be an exact match, so find preceding last name 120 | set ln = $order(^PersonI("Name", last), -1) 121 | // loop through last names 122 | for { 123 | set ln = $order(^PersonI("Name", ln)) 124 | // quit as soon as last name doesn't match original 125 | quit:($extract(ln, 1, $length(last)) '= last) 126 | // first may be "". Otherwise, it may be an exact match, so find preceding first name 127 | if (first = "") { set fn = "" } 128 | else { set fn = $order(^PersonI("Name", ln, first), -1) } 129 | // loop through first names 130 | for { 131 | set fn = $order(^PersonI("Name", ln, fn)) 132 | // quit as soon as first name doesn't match original, or is "" 133 | quit:(($extract(fn, 1, $length(first)) '= first) || (fn = "")) 134 | set id = "" 135 | // loop through all IDs 136 | for { 137 | set id = $order(^PersonI("Name", ln, fn, id)) 138 | quit:(id = "") 139 | write:(count = 0) "...finding name matches" 140 | set count = count + 1 141 | set matches(count) = id // keep track of matches 142 | write !, count, ") " 143 | do ..DisplayLine(id) 144 | } 145 | } 146 | } 147 | if (count = 0) { write "...no matches" } 148 | else { do ..Select(.matches, .id) } 149 | } 150 | 151 | /// given an ID, retrieve data and write it on a line 152 | ClassMethod DisplayLine(id As %Integer) 153 | { 154 | set $listbuild(name, phone, intdob) = ^PersonD(id) 155 | /* the line above is equivalent to 156 | set answers = ^PersonD(id), 157 | name = $list(answers, 1), 158 | phone = $list(answers, 2), 159 | intdob = $list(answers, 3) */ 160 | write name, ?20, phone, ?35, $zdate(intdob, 2) 161 | } 162 | 163 | /// count the "1" bits from the chunks of the Bitmap-ID index 164 | ClassMethod CurrentCount() 165 | { 166 | set records = 0, chunk = "" 167 | for { 168 | // use the 3-argument $order to get the next chunk and the bits stored there 169 | set chunk = $order(^PersonI("Bitmap-ID", chunk), 1, bits) 170 | quit:(chunk = "") 171 | // add the "1" bits to the count 172 | set records = records + $bitcount(bits, 1) 173 | } 174 | write !, "There are ", records, " records in the database." 175 | } 176 | 177 | /// user makes a choice from the matches array, return the corresponding ID or "" 178 | ClassMethod Select(ByRef matches As %Integer, Output id As %Integer) 179 | { 180 | set id = "" 181 | for { 182 | read !!, "Choose by number: ", choice 183 | quit:(choice = "") 184 | set id = $get(matches(choice)) 185 | quit:(id '= "") // stop looping if user makes a valid choice 186 | write "...Invalid choice" 187 | } 188 | } 189 | 190 | /// display chosen record, and optionally delete/edit/write to file 191 | ClassMethod TakeAction(id As %Integer) 192 | { 193 | set record = ^PersonD(id) 194 | do ##class(ObjectScript.DataEntry4).Display(record) 195 | 196 | // ask if user wants to delete 197 | read !, "Delete? (y/n): ", yn 198 | if ((yn = "y") || (yn = "Y")) { 199 | do ..Delete(id, record) 200 | quit 201 | } 202 | 203 | // ask if user wants to edit 204 | read !, "Edit? (y/n): ", yn 205 | if ((yn = "y") || (yn = "Y")) { 206 | do ..Edit(id, record) 207 | quit 208 | } 209 | } 210 | 211 | /// delete chosen record (lock, start a txn, kill global nodes, commit txn, unlock) 212 | ClassMethod Delete(id As %Integer, record As %String) 213 | { 214 | // try to lock the record for 5 seconds 215 | lock +^PersonD(id):5 216 | if '$test { 217 | write "...someone else is editing this person. Try again later." 218 | quit 219 | } 220 | // retrieve data 221 | set $listbuild(name, phone, intdob) = record 222 | set last = $piece(name, ",", 1), first = $piece(name, ",", 2) 223 | set chunk = (id\64000) + 1, position = (id#64000) + 1 224 | 225 | // change all globals inside a transaction 226 | tstart 227 | kill ^PersonD(id) 228 | kill ^PersonI("Name", last, first, id) 229 | kill ^PersonI("Phone", phone) 230 | kill ^PersonI("DOB", intdob, id) 231 | set $bit(^PersonI("Bitmap-ID", chunk), position) = 0 232 | tcommit 233 | write "...deleted" 234 | lock -^PersonD(id) 235 | } 236 | 237 | /// edit chosen record (lock, reprompt, compare, update globals, unlock) 238 | ClassMethod Edit(id As %Integer, record As %String) 239 | { 240 | // try to lock the record for 5 seconds 241 | lock +^PersonD(id):5 242 | if '$test { 243 | write "...someone else is editing this person. Try again later." 244 | quit 245 | } 246 | // show current data and prompt for updates 247 | do ..Reprompt(record, .newanswers) 248 | // if changes were made, update the record 249 | if '$listsame(record, newanswers) { do ..Update(id, record, newanswers) } 250 | lock -^PersonD(id) 251 | } 252 | 253 | /// prompt for updates - similar to ##class(ObjectScript.DataEntry4).Prompt() 254 | ClassMethod Reprompt(currentdata As %String, ByRef newanswers As %String) 255 | { 256 | 257 | // get current name, phone, intdob so that they can be displayed within prompts 258 | set $listbuild(currentname, currentphone, currentintdob) = currentdata 259 | do { 260 | write !, "Name: ", currentname, " => " 261 | read newname 262 | // enter nothing to keep current value 263 | if (newname = "") { 264 | set newname = currentname 265 | quit 266 | } 267 | } while '##class(ObjectScript.DataEntry4).ValidName(newname) 268 | 269 | do { 270 | write !, "Phone: ", currentphone, " => " 271 | read "(617): ", newphone 272 | // enter nothing to keep current value 273 | if (newphone = "") { 274 | set newphone = currentphone 275 | quit 276 | } 277 | } while '##class(ObjectScript.DataEntry4).ValidPhone(.newphone) 278 | 279 | do { 280 | write !, "DOB: ", $zdate(currentintdob, 2), "=> " 281 | read newdob 282 | // enter nothing to keep current value 283 | if (newdob = "") { 284 | set newintdob = currentintdob 285 | quit 286 | } 287 | } while '##class(ObjectScript.DataEntry4).ValidDOB(newdob, .newintdob) 288 | 289 | set newanswers = $listbuild(newname, newphone, newintdob) 290 | } 291 | 292 | /// save the updated record (start a txn, updating data and index globals using set and kill, commit txn) 293 | ClassMethod Update(id As %Integer, currentdata As %String, ByRef newanswers As %String) 294 | { 295 | read !, "Store updates? (y/n): ", yn // ask if user wants to store 296 | // only go on if user says yes 297 | if ((yn '= "y") && (yn '= "Y")) { 298 | write "...not stored." 299 | quit 300 | } 301 | 302 | // get current and new data for comparisons 303 | set $listbuild(currentname, currentphone, currentintdob) = currentdata 304 | set currentlast = $piece(currentname, ",", 1), currentfirst = $piece(currentname, ",", 2) 305 | set $listbuild(newname, newphone, newintdob) = newanswers 306 | set newlast = $piece(newname, ",", 1), newfirst = $piece(newname, ",", 2) 307 | 308 | // update all globals inside a transaction 309 | // only update indices if the data was changed 310 | tstart 311 | set ^PersonD(id) = newanswers 312 | if (newname '= currentname) { 313 | // kill old name and add new name to index 314 | kill ^PersonI("Name", currentlast, currentfirst, id) 315 | set ^PersonI("Name", newlast, newfirst, id) = "" 316 | } 317 | if (newphone '= currentphone) { 318 | // kill old phone and add new phone to index 319 | kill ^PersonI("Phone", currentphone) 320 | set ^PersonI("Phone", newphone) = id 321 | } 322 | if (newintdob '= currentintdob) { 323 | // kill old dob and add new dob to index 324 | kill ^PersonI("DOB", currentintdob, id) 325 | set ^PersonI("DOB", newintdob, id) = "" 326 | } 327 | tcommit // commit the transaction 328 | write "...updated." 329 | } 330 | 331 | } 332 | -------------------------------------------------------------------------------- /src/ObjectScript/Person.cls: -------------------------------------------------------------------------------- 1 | /// Persistent class for Persons 2 | Class ObjectScript.Person Extends %Persistent 3 | { 4 | 5 | Property Name As %String(PATTERN = "1U.L1"",""1U.L"); 6 | 7 | Property LastName As %String [ Calculated, SqlComputeCode = {set {LastName}=$p({Name},",",1)}, SqlComputed ]; 8 | 9 | Property FirstName As %String [ Calculated, SqlComputeCode = {set {FirstName}=$p({Name},",",2)}, SqlComputed ]; 10 | 11 | Property Phone As %String(PATTERN = "3n1""-""3n1""-""4n"); 12 | 13 | Property DOB As %Date(MAXVAL = "$piece($horolog, "","", 1)"); 14 | 15 | /// Index for LastName,FirstName 16 | Index NameIndex On (LastName, FirstName); 17 | 18 | /// Uniqueness index for property Phone 19 | Index PhoneIndex On Phone [ Unique ]; 20 | 21 | /// Index for property DOB 22 | Index DOBIndex On DOB; 23 | 24 | /// Bitmap index of ID numbers 25 | Index IDIndex [ Extent, Type = bitmap ]; 26 | 27 | Storage Default 28 | { 29 | 30 | 31 | %%CLASSNAME 32 | 33 | 34 | Name 35 | 36 | 37 | Phone 38 | 39 | 40 | DOB 41 | 42 | 43 | ^ObjectScript.PersonD 44 | PersonDefaultData 45 | ^ObjectScript.PersonD 46 | ^ObjectScript.PersonI 47 | ^ObjectScript.PersonS 48 | %Storage.Persistent 49 | } 50 | 51 | } 52 | -------------------------------------------------------------------------------- /src/ObjectScript/RightTriangle.cls: -------------------------------------------------------------------------------- 1 | /// Right triangle class, with examples of ObjectScript features 2 | Class ObjectScript.RightTriangle 3 | { 4 | 5 | /// Compute area and hypotenuse of a right triangle 6 | ClassMethod Main() 7 | { 8 | Write !, "Compute the area and hypotenuse of a right triangle", 9 | !, "given the lengths of its two sides." 10 | Read !!, "First, choose a unit of measurement: ", 11 | !, "1) inches", !, "2) feet", !, "3) miles", !, 12 | "4) centimeters", !, "5) meters", !, "6) kilometers ", !!, 13 | "Option? ", units 14 | // Translate units to a word 15 | Set units = $Case(units, 1:"inches", 16 | 2:"feet", 17 | 3:"miles", 18 | 4:"centimeters", 19 | 5:"meters", 20 | 6:"kilometers", 21 | :"units") 22 | Do { 23 | Read !!, "Length of side 1: ", side1 24 | Quit:(side1 = "") // Exit the do loop 25 | } 26 | While ..IsNegative(side1) 27 | Quit:(side1 = "") // Exit the routine 28 | Do { 29 | Read !, "Length of side 2: ", side2 30 | Quit:(side2 = "") // Exit the do loop 31 | } 32 | While ..IsNegative(side2) 33 | Quit:(side2 = "") // Exit the routine 34 | Do ..Compute(units, side1, side2) 35 | Write !!, "Current date: " 36 | Do ^%D 37 | Write !, "Current time:" 38 | Do ^%T 39 | } 40 | 41 | /// Is num negative? 42 | ClassMethod IsNegative(num As %Numeric) 43 | { 44 | 45 | If (num '> 0) { 46 | Write " Enter a positive number." 47 | Return 1 // Return true 48 | } 49 | Else { 50 | Write " Accepted." 51 | Return 0 // Return false 52 | } 53 | } 54 | 55 | /// Compute and display area and hypotenuse 56 | ClassMethod Compute(units As %String, A As %Numeric, B As %Numeric) [ Private ] 57 | { 58 | Set area = (A * B) / 2, 59 | area = $Justify(area, 0, 2), // Round hypot to 2 places 60 | squaredSides = (A ** 2) + (B ** 2) 61 | Set hypot = $ZSqr(squaredSides) // $ZSqr function computes square root 62 | Set hypot = $Justify(hypot, 0, 2) // Round hypot to 2 places 63 | Write !!, "The area of this triangle is ", area, " square ", units, ".", 64 | !!, "The hypotenuse is ", hypot, " ", units, "." 65 | } 66 | 67 | } 68 | --------------------------------------------------------------------------------