*! v 1.0.0 ARB 15Jul98 STB-46 dm63 * Dialog which allows the user to browse, edit or enter observations program define winshow version 5.0 local varlist "opt exist" local if "opt" local in "opt" local options "MAXdisp(int 14) EDit new del STrict nopreserve call(str) log(str) dateord(str) noNUm noVAr noDEsc noTYpe CAPtion(str)" parse "`*'" if "`dateord'" != "" { if date("01/01/01","`dateord'") == . { /* check valid date order */ disp in r "Invalid date order specified" exit } global GWSdord `dateord' /* date order */ } else { global GWSdord dmy /* default order */ } if "`call'" != "" { cap `call' cause an error quickly if _rc == 199 { disp in r "File `call'.ado not found" exit 601 } } if "`log'" != "" { confirm var `log' } * These options are used in sub-routines so need to be global: global GWScall `call' global GWSlog `log' global GWSstrt = ("`strict'" == "strict") /* 1 if strict, 0 if not */ global GWSedit = ("`edit'" == "edit") /* 1 if edit, 0 if not */ qui count `if' `in' global GWSnmax = _result(1) /* No of observations to be displayed */ if $GWSnmax == 0 { exit } disp in b "Initialising." _cont local sm : set more /* remember set more setting */ set more off cap drop __touse mark __touse `if' `in' global GWSfrec 1 /* Observation no of first record */ while __touse[$GWSfrec] == 0 { global GWSfrec = $GWSfrec + 1 } global GWSobsno $GWSfrec /* Current observation number */ global GWSlrec = _N /* Observation no of last record */ while __touse[$GWSlrec] == 0 { global GWSlrec = $GWSlrec - 1 } * Chop up varlist into pages (var1, var2 etc..). Also creates * new characteristics for each variable: * [vtype] str, lon, byt etc... + new type dat (date) * [no] variable order number * [deslen] length of variable decription label in pixels * [len] length of edit box in characters * [edlen] length of edit box in pixels local maxvll 0 /* maximum variable label length */ local maxebl 5 /* maximum edit box length */ local no 1 /* Variable order */ global GWSpage 1 /* page counter */ global GWSlpage 1 /* Last page no */ global GWSmod 0 /* Modified dataset trip switch */ global GWSnew 0 /* Data-entry mode flag */ parse "`varlist'", parse(" ") while "`1'" != "" { global GWSlpage $GWSpage /* Last page no */ local var$GWSpage "`var$GWSpage' `1'" * Create variable description global macro if "`num'" == "" { global GWSvd`no' "`no'. " local slen 3 } else { global GWSvd`no' local slen 0 } if "`var'" == "" { global GWSvd`no' "${GWSvd`no'}`1', " local slen = `slen' + 8 } if "`desc'" == "" { local varlab : variable label `1' if "`varlab'" == upper("`varlab'") { local varlab = lower("`varlab'") } global GWSvd`no' "${GWSvd`no'}`varlab' " local slen = `slen' + length("`varlab'") } local vartype : type `1' if "`type'" == "" { global GWSvd`no' "${GWSvd`no'}(`vartype')" local slen = `slen' + 8 } local slen = int(`slen' * 3.6) /* Actual width */ if `slen' > `maxvll' { local maxvll `slen' } char `1'[deslen] `slen' local vtype = substr("`vartype'",1,3) local varform : format `1' if substr("`varform'",1,2) == "%d" { /* date */ local vtype dat } char `1'[vtype] `vtype' local slen : char `1'[len] if "`slen'" == "" { if "`vtype'" == "str" { local slen = substr("`vartype'",4,.) if `slen' > 35 { local slen 35 /* Truncate edit region */ } } else if "`vtype'" == "dat" { local slen 10 } else { summ `1', mean local max = _result(6) local slen = length("`max'") + 2 } char `1'[len] `slen' /* Char edit box width */ } local slen = `slen' * 4 + 3 /* Actual edit box width */ if `slen' > `maxebl' { local maxebl `slen' } char `1'[edlen] `slen' char `1'[no] `no' macro shift if `no' == $GWSpage * `maxdisp' { global GWSpage = $GWSpage + 1 disp in b "." _cont } local no = `no' + 1 } disp _newline if $GWSpage == 1 { local hgt = `no' * 9 + 50 /* Height of dialog */ } else { local hgt = `maxdisp' * 9 + 59 } local wdt = `maxvll' + `maxebl' + 40 /* Width of dialog */ if `maxebl' < 65 { local wdt = `maxvll' + 120 } if `wdt' < 170 { local wdt 170 /* Minimum width of dialog */ } if ($GWSedit | "`del'" == "del" | "`new'" == "new") & "`preserv'" == "" { preserve disp in g "- preserve" } window control clear global GWSpage 1 if "`var2'" != "" { local next next } * Populate values and value labels for current page: pop `var1' global GWS_del "branch, rc(10)" global GWS_np "branch `var1', rc(3007)" global GWS_bp "branch, rc(8)" cap exit 3100 while _rc > 3000 { if _rc == 3007 { /* Next page */ global GWSpage = $GWSpage + 1 global GWS_bp "branch `var$GWSpage', rc(3008)" if $GWSpage == $GWSlpage { global GWS_np "branch, rc(7)" } pop `var$GWSpage' } else if _rc == 3008 { /* Back a page */ global GWSpage = $GWSpage - 1 global GWS_np "branch `var$GWSpage', rc(3007)" if $GWSpage == 1 { global GWS_bp "branch, rc(8)" } pop `var$GWSpage' } if _rc == 3017 { /* Next page in data-entry mode */ global GWSpage = $GWSpage + 1 global GWS_bp "exit 3018" if $GWSpage == $GWSlpage { global GWS_np "branch, rc(7)" } global GWSpgtxt "Page $GWSpage of $GWSlpage" } else if _rc == 3018 { /* Back a page in data-entry mode */ global GWSpage = $GWSpage - 1 global GWS_np "exit 3017" if $GWSpage == 1 { global GWS_bp "branch, rc(8)" } global GWSpgtxt "Page $GWSpage of $GWSlpage" } else if _rc == 3009 { /* New */ global GWSnew 1 newob `varlist' } else if _rc == 3001 { /* Reset next and back */ global GWS_bp "branch `var$GWSpage', rc(3008)" global GWS_np "branch `var$GWSpage', rc(3007)" if $GWSpage == $GWSlpage { global GWS_np "branch, rc(7)" } if $GWSpage == 1 { global GWS_bp "branch, rc(8)" } } if "`caption'" == "" { global GWScapt "Showing $GWSnmax observations" } else { global GWScapt "`caption'" } setbox `var$GWSpage' , `next' `new' `del' wdt(`wdt') hgt(`hgt') cap nois window dialog "$GWScapt" . . `wdt' `hgt' } if _rc == 0 { /* User closed using x */ if "${GWSnew}" == "Submit" { window stopbox note "The new observation will be discarded as it was not submitted." } else { branch `var$GWSpage', rc(0) } } if $GWSmod == 1 & "`preserv'" == "" { cap window stopbox rusure "Exit window:" "OK to accept changes." "Cancel to Restore last Preserve" if _rc { restore /* User cancelled */ disp in g "- restore" } } cap restore, not /* prevent auto restore on close */ macro drop GWS* /* Tidy up before exiting */ if `sm' == 0 { set more on /* remember set more setting */ } drop __touse end * Subroutine called by show. Sets up the dialogue box for one record * Options to display back, next, new and delete buttons. * Width & height of box must be supplied in wdt() and hgt(). program define setbox version 5.0 local varlist "req exist" local options "next new del wdt(int 170) hgt(int 45)" parse "`*'" local x 5 /* x co-ord of labels */ local y 12 /* y co-ord of first line */ local maxvll 0 /* maximum variable label length */ parse "`varlist'", parse(" ") local vno : char `1'[no] /* variable counter */ while "`1'" != "" { /* Find max description length */ local slen : char `1'[deslen] if `slen' > `maxvll' { local maxvll `slen' } macro shift } local xe = `maxvll' +7 /* x co-ord of edit boxes */ window control static GWSobtxt `x' 2 140 7 /* observation no */ local xp = `wdt' - 80 window control static GWSpgtxt `xp' 2 70 7 right /* page no */ parse "`varlist'", parse(" ") while "`1'" != "" { local we : char `1'[edlen] /* width in pixels of edit region */ local len : char `1'[len] /* width in characters */ local xv = `xe' + `we' + 5 /* x co-ord of value label */ window control static GWSvd`vno' `x' `y' `maxvll' 7 local noed : char `1'[noedit] /* Can variable be edited? */ if "`noed'" == "1" { /* No */ window control static GWSvv`vno' `xe' `y' `we' 7 } else { window control edit `xe' `y' `we' 7 GWSvv`vno' maxlen `len' } window control static GWSvl`vno' `xv' `y' 60 7 macro shift local y = `y' + 9 local vno = `vno' + 1 } local y = `hgt' - 45 /* Y co-ord of buttons */ local bx1 = int(`wdt'/2) - 44 /* X co-ords of buttons */ local bx2 = int(`wdt'/2) - 21 local bx3 = int(`wdt'/2) + 1 local bx4 = int(`wdt'/2) + 24 local bx5 = int(`wdt'/2) + 50 local bx6 = int(`wdt'/2) - 80 if "`next'" == "next" { window control button "More -->" `bx5' `y' 30 11 GWS_np window control button "<-- Back" `bx6' `y' 30 11 GWS_bp } window control button "|<" `bx1' `y' 20 11 GWS_fst window control button "<" `bx2' `y' 20 11 GWS_prev window control button ">" `bx3' `y' 20 11 GWS_next window control button ">|" `bx4' `y' 20 11 GWS_last local y = `y' + 15 /* Y co-ord of buttons */ if "`del'" == "del" & "`new'" == "new" { local bx7 = int(`wdt'/2) - 39 local bx8 = int(`wdt'/2) + 1 } else { local bx7 = int(`wdt'/2) - 19 /* centre new & del buttons */ local bx8 = int(`wdt'/2) - 19 } local bx9 = int(`wdt'/2) + 42 local but 0 if "`del'" == "del" { window control button "Delete" `bx7' `y' 38 11 GWS_del local but 1 } if "`new'" == "new" { window control button "New" `bx8' `y' 38 11 GWS_new local but 1 } if $GWSedit | "`new'" == "new" { window control button "Submit" `bx9' `y' 38 11 GWS_sub local but 1 } if `but' == 0 { local bx10 = int(`wdt'/2) - 19 /* centre cancel button */ } else { local bx10 `bx6' } window control button "Cancel" `bx10' `y' 38 11 GWS_can escape end * Subroutine. Populates the global macros in the dialogue * box with the nth observation of the variables given. * Also defines the commands associated with the navigation buttons. program define pop version 5.0 local varlist "req exist" parse "`*'" local N = _N global GWSobtxt "Observation number: $GWSobsno of `N'" global GWSpgtxt "Page $GWSpage of $GWSlpage" parse "`varlist'", parse(" ") local vno : char `1'[no] while "`1'" != "" { global GWSvv`vno' = `1'[$GWSobsno] /* value */ global GWSov`vno' ${GWSvv`vno'} /* original value */ global GWSvl`vno' /* value label */ local vtype : char `1'[vtype] if "`vtype'" == "dat" { local varform : format `1' global GWSvl`vno' : display `varform' ${GWSvv`vno'} } else if "`vtype'" != "str" { local vallab : value label `1' if "`vallab'" != "" { global GWSvl`vno' : label `vallab' ${GWSvv`vno'} } } macro shift local vno = `vno' + 1 } global GWS_can branch `varlist', rc(3000) global GWS_new branch `varlist', rc(3009) global GWS_fst branch `varlist', rc(1) global GWS_prev branch `varlist', rc(2) global GWS_next branch `varlist', rc(3) global GWS_last branch `varlist', rc(4) global GWS_sub branch `varlist', rc(11) if $GWSobsno == $GWSfrec { global GWS_fst branch, rc(5) global GWS_prev branch, rc(5) } if $GWSobsno == $GWSlrec { global GWS_next branch, rc(6) global GWS_last branch, rc(6) } end * Act according to last button pressed on dialog program define branch version 5.0 local varlist "exist opt" local options "rc(int 3000)" parse "`*'" if `rc' == 5 { window stopbox note "Already at first observation" exit } else if `rc' == 6 { window stopbox note "Already at last observation" exit } else if `rc' == 7 { window stopbox note "Already at last page" exit } else if `rc' == 8 { window stopbox note "Already at first page" exit } if $GWSnew { /* in data-entry mode */ if `rc' == 10 { /* User pressed delete */ cap window stopbox rusure "Are you sure you want to delete this new observation?" "Press OK to continue." if _rc { /* User cancelled */ exit } pop `varlist' } else if `rc' == 3009 { /* User pressed New */ window stopbox stop "You cannot create a new observation until" "this one has been dealt with." } else if `rc' == 11 { /* User pressed Submit */ cap checkval `varlist' /* Standard checks */ if _rc { /* Invalid value */ exit } if "$GWScall" != "" { cap $GWScall `varlist' /* User checking routine */ set trace off if _rc ==1 { /* Invalid value */ exit } else if _rc > 1 { nois disp in bl "The following error occurred in your checking program " in w "$GWScall" in bl ":" cap nois error _rc exit } } local n = _N + 1 disp in g "- set obs `n'" qui set obs `n' global GWSlrec `n' global GWSobsno `n' global GWSnmax = $GWSnmax + 1 saveval `varlist' global GWSmod 1 /* Modified dataset trip switch */ } else { cap window stopbox rusure "The new observation will be discarded if you" "continue as it has not been submitted successfully." "Press OK to continue anyway." if _rc { /* User cancelled */ exit } } global GWSnew 0 if `rc' != 3000 { /* Unless user cancelled */ local redraw yes /* Force re-draw of dialog */ } } else { /* In editing mode */ if `rc' == 10 { /* User pressed delete */ if $GWSnmax == 1 { cap window stopbox rusure "This is the only observation in the dataset - are you sure you want to delete it?" "Press OK to continue." } else { cap window stopbox rusure "Are you sure you want to delete the" "current observation?" "Press OK to continue." } if _rc { /* User cancelled */ exit } else { if "$GWSlog" != "" { logdisp /* Display identifiers of curr obs */ disp "was deleted on $S_DATE at " substr("$S_TIME",1,5) "." } qui drop in $GWSobsno disp in g "- drop in $GWSobsno" global GWSmod 1 /* modified dataset tripswitch */ global GWSfrec 1 /* Observation no of first record */ while __touse[$GWSfrec] == 0 { global GWSfrec = $GWSfrec + 1 } global GWSlrec = _N /* Observation no of last record */ while __touse[$GWSlrec] == 0 { global GWSlrec = $GWSlrec - 1 } if $GWSobsno > $GWSlrec { global GWSobsno $GWSlrec } global GWSnmax = $GWSnmax - 1 /* No of observations to be displayed */ pop `varlist' /* Populate dialog box */ if $GWSnmax == 0 { exit 3000 } else { exit 3001 /* force re-draw of dialog */ } } } parse "`varlist'", parse(" ") local vno : char `1'[no] while "`1'" != "" { if "${GWSov`vno'}" != "${GWSvv`vno'}" { /* Check original values against current */ local updvars "`updvars' `1'" } macro shift local vno = `vno' + 1 } if "`updvars'" != "" { if $GWSedit { cap checkval `updvars' /* Standard checks */ if _rc == 0 { if "$GWScall" != "" { cap $GWScall `updvars' /* User checking routine */ set trace off } if _rc == 0 { saveval `updvars' } else if _rc != 1 { nois disp in bl "The following error occurred in your checking program " in w "$GWScall" in bl ":" cap nois error _rc } } } else { window stopbox note "You are in browse mode. Changes in the following" "variables were ignored:`updvars'" } } } if (`rc' > 0 & `rc' < 5) | `rc' == 11 { /* Navigate or submit */ if `rc' == 1 { /* First record */ global GWSobsno $GWSfrec } else if `rc' == 2 { /* Previous record */ global GWSobsno = $GWSobsno - 1 while __touse[$GWSobsno] == 0 { global GWSobsno = $GWSobsno - 1 } } else if `rc' == 3 { /* Next record */ global GWSobsno = $GWSobsno + 1 while __touse[$GWSobsno] == 0 { global GWSobsno = $GWSobsno + 1 } } else if `rc' == 4 { /* Last record */ global GWSobsno $GWSlrec } pop `varlist' /* Populate dialog box */ } if "`redraw'" == "yes" { exit 3001 } else { exit `rc' } end * Check values for validity * return code of 1 if any illegal values encountered program define checkval version 5.0 local varlist "exist req" parse "`*'" parse "`varlist'", parse(" ") if $GWSnew { /* data entry mode: */ local endtex1 This observation is not accepted. local endtex2 Press OK to submit anyway. } else { /* in editing-browsing mode: */ local endtex1 This change will not be saved. local endtex2 Press OK to make change anyway, cancel to restore previous value. } * Check all values are suitable local anyacc 0 /* 0 = no values accepted, 1 = at least 1 value accepted */ while "`1'" != "" { local accept 1 /* 0 = value not accepted, 1 = value accepted */ local vno : char `1'[no] local req : char `1'[req] if "`req'" == "1" & "${GWSvv`vno'}" == "" { /* Check for required */ cap window stopbox stop "You must enter a value in the `1' variable." "`endtex1'" if $GWSnew { exit 1 } else { global GWSvv`vno' ${GWSov`vno'} local accept 0 } } local vtype : char `1'[vtype] if "`vtype'" != "str" & "${GWSvv`vno'}" == "" { global GWSvv`vno' . /* Set blank numbers to missing */ } if "`vtype'" == "dat" { cap confirm integer number ${GWSvv`vno'} if _rc { /* If not number intepret as text date */ global GWSvv`vno' = date("${GWSvv`vno'}","$GWSdord") } } if "${GWSov`vno'}" != "${GWSvv`vno'}" { /* Check original values against current */ local vallab : value label `1' if "`vallab'" != "" & "${GWSvv`vno'}" != "" { /* Check for legal value */ local labtext : label `vallab' ${GWSvv`vno'} if $GWSstrt & "`labtext'" == "${GWSvv`vno'}" & "`labtext'" != "." { cap window stopbox stop "There is no label for the value `labtext' in the `1' variable." "`endtex1'" if $GWSnew { exit 1 } else { global GWSvv`vno' ${GWSov`vno'} local accept 0 } } else if "`labtext'" == "${GWSvv`vno'}" & "`labtext'" != "." { cap window stopbox rusure "There is no label for the value `labtext' in the `1' variable." "`endtex2'" if _rc & $GWSnew { exit 1 } else if _rc { global GWSvv`vno' ${GWSov`vno'} local accept 0 } } } } local range : char `1'[range] if "`range'" != "" { local ranglo : word 1 of `range' local ranghi : word 2 of `range' local rtype : word 3 of `range' if ${GWSvv`vno'} < `ranglo' | ${GWSvv`vno'} > `ranghi' { if "`vtype'" == "dat" { local varform : format `1' local ranglo : display `varform' `ranglo' local ranghi : display `varform' `ranghi' } if "`rtype'" == "strict" { cap window stopbox stop "${GWSvv`vno'} is outside the permitted range of values (`ranglo' to `ranghi') for `1'." "`endtex1'" if $GWSnew { exit 1 } else { global GWSvv`vno' ${GWSov`vno'} local accept 0 } } else if ${GWSvv`vno'} != . { /* note missing allowed if non-strict range */ cap window stopbox rusure "${GWSvv`vno'} is outside the permitted range of values (`ranglo' to `ranghi') for `1'." "`endtex2'" if _rc & $GWSnew { exit 1 } else if _rc { global GWSvv`vno' ${GWSov`vno'} local accept 0 } } } } local anyacc = `anyacc' | `accept' macro shift local vno = `vno' + 1 } exit !`anyacc' end * Save changes program define saveval version 5.0 local varlist "exist req" parse "`*'" if "$GWSlog" != "" { logdisp /* Display identifiers of curr obs */ disp "was edited on $S_DATE at " substr("$S_TIME",1,5) "." } parse "`varlist'", parse(" ") while "`1'" != "" { local vno : char `1'[no] if "${GWSvv`vno'}" != "${GWSov`vno'}" { local vtype : char `1'[vtype] if "`vtype'" == "str" { cap replace `1' = "${GWSvv`vno'}" in $GWSobsno if _rc == 0 { disp in g "- replace `1' = " _quote "${GWSvv`vno'}" _quote " in $GWSobsno" global GWSmod 1 /* Modified dataset trip switch */ } } else { cap replace `1' = ${GWSvv`vno'} in $GWSobsno if _rc == 0 { disp in g "- replace `1' = ${GWSvv`vno'} in $GWSobsno" global GWSmod 1 /* Modified dataset trip switch */ } } if _rc { local vartype : type `1' cap window stopbox stop "${GWSvv`vno'} cannot be stored in the `vartype' variable `1'" global GWSvv`vno' ${GWSov`vno'} /* restore old value */ } else if "$GWSlog" != "" { disp "The variable `1' was changed from ${GWSov`vno'} to ${GWSvv`vno'}" _newline } global GWSov`vno' ${GWSvv`vno'} } macro shift } end * Set up dialog to add a new observation to the dataset program define newob version 5.0 local varlist "exist req" * Note: this is the complete varlist parse "`*'" parse "`varlist'", parse(" ") * Load default values local vno 1 while "`1'" != "" { local def : char `1'[default] local vtype : char `1'[vtype] if "`def'" != "" { global GWSvv`vno' `def' global GWSov`vno' `def' if "`vtype'" == "dat" { local varform : format `1' global GWSvl`vno' : display `varform' ${GWSvv`vno'} } else if "`vtype'" != "str" { local vallab : value label `1' if "`vallab'" != "" { global GWSvl`vno' : label `vallab' ${GWSvv`vno'} } } } else { if "`vtype'" == "str" { global GWSvv`vno' global GWSov`vno' } else { global GWSvv`vno' global GWSov`vno' } global GWSvl`vno' } macro shift local vno = `vno' + 1 } global GWSobtxt "NEW observation" global GWSpage 1 global GWSpgtxt "Page $GWSpage of $GWSlpage" global GWS_np "exit 3017" global GWS_bp "branch, rc(8)" global GWS_sub branch `varlist', rc(11) end * Verbose logging of edits program define logdisp version 5.0 disp "Observation no $GWSobsno in dataset $S_FN" disp "with the following identifiers:" parse "$GWSlog", parse(" ") while "`1'" != "" { local ident = `1'[$GWSobsno] local vtype : char `1'[vtype] local label if "`vtype'" == "dat" { local varform : format `1' local label : display `varform' `ident' local label "(`label')" } else if "`vtype'" != "str" { local vallab : value label `1' if "`vallab'" != "" { local label : label `vallab' `ident' local label "(`label')" } } disp "`1':" _col(11) "`ident' `label'" mac shift } end