Weirdness in screen program (long source included!)
Bruin, J.M. de
Bruin@WT.TNO.NL
Tue, 27 Apr 2004 16:20:06 +0200
Hi there,
I'm encountering some weirdness in a screen program that I'm in the process of
updating.
The environment is: VMS 7.2, PH 710G1
First of all: the program is running correctly, though it being in the
development phase. It performs the tasks it is supposed to. So far no problem.
The weird thing however is that although at compile time the fields t'QUESTION,
t'QUESTION2, t'ANSWER and t'OBJECT_CODE are positioned correctly (i.e. BELOW the
cluster), at run-time they ARE NOT.
Giving in the COPY command at the ACTION Field the user is prompted at the
DESCRIPTION field (that is normally not prompted!!!) at the last occurrence of
the cluster.
The t'QUESTION2 field is NOT displayed at all, dispite the Display t'QUESTION2
statement in the COPY designer.
Checking the field with ?? comes up with t'OBJECT_CODE !!!!!!! This is correct.
Can anyone comment on this and maybe solved this weird problem. I have never
come accross such a behaviour!
At first I suspected the SILENT field in the cluster, however deleting that from
the programdoes not solve the problem.
Moving the complete set of temporary field above the cluster, results in a
correct compile with the fields on the right place on the screen and into a
"Fatal error" at run-time after entering the copy command.
Weird, weird, weird.
Regards,
Mark de Bruin
Use BEGRIP$USE:SETS.QKU Nolist
&
Nodetail
;
; Program name : BEGRIP_S8033
; Program type : POWERHOUSE-VMS-710G1/Qdesign
;
; COPYRIGHT ) 2001 BY:
;
; Crash Safety Center
; of
; TNO Automotive, Delft, The Netherlands
;
; ALL RIGHTS RESERVED
;
; Purpose :
;
; Usage
; RUN SCREEN BEGRIP_S8033 &
; Passing t'SECURITY
; Or
; SUBSCREEN BEGRIP_S8033 &
; Passing t'SECURITY
;
; Description of parameters
; Name Type R/W Description
; ------------------- ----------- ---
------------------------------
; t'SECURITY NUM*1 RJust a dummy to prevent
screen to be
; run from the command line
;
;-----------------------------------------------------------------------------
;
; Module invoked from :
; Modules invoked :
; Module environment :
; Files used :
; Technical notes : User defined Find procedure to prevent objects
; being used that are already in use
; in PLTOBJ_PLTPG
;
;-----------------------------------------------------------------------------
;
; Keywords (max 10)
;
; Revision history
; at: by: reason:
;-----------------------------------------------------------------------------
; 2-JAN-2001 Frans Ahrendt Creation
;
;-----------------------------------------------------------------------------
;***** SCREEN AND DESCRIPTION ************************************************
;-----------------------------------------------------------------------------
Screen BEGRIP_S8033 Help Popup From 3,4 To 23,76 &
Receiving t'SECURITY
Description Of Screen
&
"<Enter your screen description here>"
;-----------------------------------------------------------------------------
;***** DATA DECLARATIONS - Files, Temps & Defines ****************************
;-----------------------------------------------------------------------------
Temp t'SECURITY Numeric*1
Temp t'LOC_OBJECT Character
&
Size 1
&
Initial '*'
&
Reset At Startup
Temp t'LOC_NR_STR Character
&
Size 4
Temp t'LOC_SEQ_NR Num*2
Temp t'SPLIT_POS Num*2
Temp t'zu10OBJECT_ID Zoned &
Unsigned
&
Size 10
&
Reset At Startup
Temp t'zu10TRANS_LOC_NR Zoned
&
Unsigned
&
Size 10
&
Reset At Startup
File PLOTSESSION_OBJ Primary&
Nodelete
Access Via DPP-OBJECT-TYPE-ID,&
PLTOBJ_MNEM
&
Using DPP-OBJECT-TYPE-ID Of PLOTSESSION_OBJ,
&
PLTOBJ_MNEM Of PLOTSESSION_OBJ
&
Request PLTOBJ_MNEM Of PLOTSESSION_OBJ
Access Via DPP-OBJECT-TYPE-ID
&
Using DPP-OBJECT-TYPE-ID Of PLOTSESSION_OBJ
Access Via DPP-OBJECT-ID
&
Using t'zu10OBJECT_ID
File PLTOBJ_PLTPG Secondary
Access ViaDPP-OBJECT-P'ID
&
Using DPP-OBJECT-ID Of PLOTSESSION_OBJ
File PLTSES_LOC_V60 Detail
&
Occurs 13
&
Cache 255
Access Via PLTOBJ_NR
&
Using PLTOBJ_NR Of PLOTSESSION_OBJ
Item PLTOBJ_NR Initial PLTOBJ_NR Of
PLOTSESSION_OBJ &
Fixed
File DESCRIPTION Reference&
Occurs With PLTSES_LOC_V60
Access Via DESCR_ID
&
Using DESCR_ID Of PLTSES_LOC_V60
File DESCRIPTION Designer
&
AliasDESCRIPTION_DEL
Access Via DESCR_ID
&
Using DESCR_ID Of PLTSES_LOC_V60
File DESCRIPTION_ELEMENT_TXT Designer
Access Via DESCR_ID
&
Using DESCR_ID Of DESCRIPTION
File DESCRIPTION_ELEMENT_KEY Designer
Access Via DESCR_ID
&
Using DESCR_ID Of DESCRIPTION
Temp t'TRANS-LOC-CODE Char*4
&
Occurs With PLTSES_LOC_V60
Temp t'SP_DEL Char*1
&
Occurs With PLTSES_LOC_v60
&
Initial "N"
Temp t'X_DEL Char*1
&
Occurs With PLTSES_LOC_v60
&
Initial "N"
Temp t'M_DEL Char*1
&
Occurs With PLTSES_LOC_v60
&
Initial "N"
Temp t'Y_DEL Char*1
&
Occurs With PLTSES_LOC_v60
&
Initial "N"
Temp t'Z_DEL Char*1
&
Occurs With PLTSES_LOC_v60
&
Initial "N"
Temp t'R_DEL Char*1
&
Occurs With PLTSES_LOC_v60
&
Initial "N"
File PLTSES_LOC_AXIS_PG Secondary&
Noitems
&
Alias PLTSES_LOC_AXIS_PG_SP
&
Occurs With PLTSES_LOC_v60
Access Via PLTSES_LOC_ID,
&
TRANS_LOC_AXIS
&
Using PLTSES_LOC_ID Of PLTSES_LOC_v60,
&
"__"
Item TRANS_LOC_AXIS Initial "__"
&
Fixed
Item PLTSES_LOC_ID Initial PLTSES_LOC_ID Of PLTSES_LOC_v60
&
Fixed
File PLTPGReference &
Alias PLTPG_SP
&
Occurs With PLTSES_LOC_v60
&
Open 2
Access Via PLTPG_NR
&
Using PLTPG_NR Of PLTSES_LOC_AXIS_PG_SP
File PLTSES_LOC_AXIS_PG Secondary&
Open 2
&
Noitems
&
Alias PLTSES_LOC_AXIS_PG_X
&
Occurs With PLTSES_LOC_v60
Access Via PLTSES_LOC_ID,
&
TRANS_LOC_AXIS
&
Using PLTSES_LOC_ID Of PLTSES_LOC_v60,
&
"X"
Item TRANS_LOC_AXIS Initial "X"&
Fixed
Item PLTSES_LOC_ID Initial PLTSES_LOC_ID Of PLTSES_LOC_v60
&
Fixed
File PLTPGReference &
Alias PLTPG_X&
Occurs With PLTSES_LOC_v60
&
Open 2
Access Via PLTPG_NR
&
Using PLTPG_NR Of PLTSES_LOC_AXIS_PG_X
Temp t'c1MULTI_AXIS Character
&
Size 1
&
Occurs With PLTSES_LOC_v60
File PLTSES_LOC_AXIS_PG Secondary&
Open 3
&
Noitems
&
Alias PLTSES_LOC_AXIS_PG_M
&
Occurs With PLTSES_LOC_v60
Access Via PLTSES_LOC_ID,
&
TRANS_LOC_AXIS
&
Using PLTSES_LOC_ID Of PLTSES_LOC_v60,
&
"M@"
Item PLTSES_LOC_ID Initial PLTSES_LOC_ID Of PLTSES_LOC_v60
&
Fixed
File PLTPGReference &
Alias PLTPG_M&
Occurs With PLTSES_LOC_v60
&
Open 3
Access Via PLTPG_NR
&
Using PLTPG_NR Of PLTSES_LOC_AXIS_PG_M
File PLTSES_LOC_AXIS_PG Secondary&
Open 4
&
Noitems
&
Alias PLTSES_LOC_AXIS_PG_Y
&
Occurs With PLTSES_LOC_v60
Access Via PLTSES_LOC_ID,
&
TRANS_LOC_AXIS
&
Using PLTSES_LOC_ID Of PLTSES_LOC_v60,
&
"Y"
Item TRANS_LOC_AXIS Initial "Y"&
Fixed
Item PLTSES_LOC_ID Initial PLTSES_LOC_ID Of PLTSES_LOC_v60
&
Fixed
File PLTPGReference &
Alias PLTPG_Y&
Occurs With PLTSES_LOC_v60
&
Open 4
Access Via PLTPG_NR
&
Using PLTPG_NR Of PLTSES_LOC_AXIS_PG_Y
File PLTSES_LOC_AXIS_PG Secondary&
Open 6
&
Noitems
&
Alias PLTSES_LOC_AXIS_PG_Z
&
Occurs With PLTSES_LOC_v60
Access Via PLTSES_LOC_ID,
&
TRANS_LOC_AXIS
&
Using PLTSES_LOC_ID Of PLTSES_LOC_v60,
&
"Z"
Item TRANS_LOC_AXIS Initial "Z"&
Fixed
Item PLTSES_LOC_ID Initial PLTSES_LOC_ID Of
PLTSES_LOC_v60 &
Fixed
File PLTPGReference &
Alias PLTPG_Z&
Occurs With PLTSES_LOC_v60
&
Open 6
Access Via PLTPG_NR
&
Using PLTPG_NR Of PLTSES_LOC_AXIS_PG_Z
File PLTSES_LOC_AXIS_PG Secondary&
Open 7
&
Noitems
&
Alias PLTSES_LOC_AXIS_PG_R
&
Occurs With PLTSES_LOC_v60
Access Via PLTSES_LOC_ID,
&
TRANS_LOC_AXIS
&
Using PLTSES_LOC_ID Of PLTSES_LOC_v60,
&
"R"
Item TRANS_LOC_AXIS Initial "R"&
Fixed
Item PLTSES_LOC_ID Initial PLTSES_LOC_ID Of
PLTSES_LOC_v60 &
Fixed
File PLTPGReference &
Alias PLTPG_R&
Occurs With PLTSES_LOC_v60
&
Open 8
Access Via PLTPG_NR
&
Using PLTPG_NR Of PLTSES_LOC_AXIS_PG_R
File DPP-OBJECTS Designer
&
Open 10
&
Read
Temp T-DPP-OBJECT-TYPE-ID Zoned Unsigned Size 10
&
Initial DPP-OBJECT-TYPE-ID Of
PLTPG_X
Temp T-DPP-OBJECT-ID Char*10
File DPP-CONTROL Designer
File TRANS-LOCS Designer
&
Occurs With PLTSES_LOC_v60
Access Via TRANS-LOC-NR
&
Using TRANS-LOC-NR Of PLTSES_LOC_v60
File O_MME_PD Reference
Access Via O_OBJECT_TYPE_ID
&
, O_OBJECT_NAME
&
Using O_OBJECT_TYPE_ID Of O_MME_PD
&
, MME_PD_CODE Of PLTSES_LOC_V60
Temp t'OBJECT_CODE Character
&
Size 6
&
Reset At Mode
File PLOTSESSION_OBJ Reference
&
Alias REF_OBJECT
Access Via DPP-OBJECT-TYPE-ID
&
, PLTOBJ_MNEM&
Using DPP-OBJECT-TYPE-ID Of PLOTSESSION_OBJ
&
, t'OBJECT_CODE
Temp t'SIGNAL_SPECIAL_LOCATIONCharacter
&
Size 1
Temp t'UPDATE_DESC Numeric*1
Temp t'n4ID Numeric*4
Temp t'c80DESCRIPTION Character
&
Size 80
&
Occurs With PLTSES_LOC_v60
Temp t'n10OBJECT_ID_PASS Numeric*10
Temp t'n10OBJECT_TYPE_ID_PASS Numeric*10 &
Initial O_OBJECT_TYPE_ID Of
O_MME_PD &
Reset At Startup
Temp t'c32OBJECT_NAME_PASS Character&
Size 32
Temp t'QUESTION Char
&
Size 44
&
Reset At Mode
Temp t'ANSWER Char
&
Size 1
&
Reset At Mode
Temp t'QUESTION2 Char
&
Size 44
&
Reset At Mode
Temp t'zu10OLD_OBJECT_ID_PASS Zoned &
Unsigned
&
Size 10
Temp t'zu10NEW_OBJECT_ID_PASS Zoned &
Unsigned
&
Size 10
;-----------------------------------------------------------------------------
;***** SCREEN LAYOUT DEFINITION **********************************************
;-----------------------------------------------------------------------------
Use BEGRIP$USE:SCRID.QKU Nolist
&
Nodetail
Title "BEGRIP: Plot Object"
Title "(S8033)"
;-----------------------------------------------------------------------------
;***** SETUP STANDARD HILITING ***********************************************
;-----------------------------------------------------------------------------
Use BEGRIP$USE:HILITE.QKU Nolist
&
Nodetail
;-----------------------------------------------------------------------------
;***** FIELD STATEMENTS ******************************************************
;-----------------------------------------------------------------------------
Align (,,20)
Skip To 4
Align (1,4,13)(,20,32)(,73,80)
Field PLTOBJ_MNEM Of PLOTSESSION_OBJ
&
Required
&
Lookup NotonPLOTSESSION_OBJ
&
Via DPP-OBJECT-TYPE-ID,
&
PLTOBJ_MNEM,
&
DPP-OBJECT-OWNER,&
DPP-OBJECT-VERSION
&
UsingDPP-OBJECT-TYPE-ID Of PLOTSESSION_OBJ,
&
PLTOBJ_MNEM,
&
DPP-OBJECT-OWNER Of PLOTSESSION_OBJ,
&
DPP-OBJECT-VERSION Of PLOTSESSION_OBJ
Field PLTOBJ_DESC Of PLOTSESSION_OBJ
&
Label 'description'
&
Required
Field PLTOBJ_ORIENT Of PLOTSESSION_OBJ
&
Label 'orient'
&
Predisplay
Skip 1
Align (12,,) (20,,) (27,,) (34,,) (41,,) (48,,) (55,,) (58,,) (60,,)
Title "* Dim"
Title "* X"
Title "* Y"
Title "* Z"
Title "* R"
Title "* Mult"
Title "Ax"
Title "V"
Title "Desc"
Align (1,,4) (,,12) (,,14) (,,21) (,,28) (,,35) (,,42) (,,49) &
(,,56) (,,58) (,,60)
Cluster Occurs With PLTSES_LOC_v60 For 1,80 Id Base 10
Field TRANS-LOC-NR Of PLTSES_LOC_v60Character
&
Size 6
&
Picture "^^^^"
&
Lookup On TRANS-LOCS
&
Message '*E* Incorrect location-code. Type "*" for valid codes'
Field MME_PD_CODE Of PLTSES_LOC_V60
&
Upshift
&
Lookup On O_MME_PD
&
Message "*E* This is not a valid dimension. Use * for list"
Field t'SIGNAL_SPECIAL_LOCATION
&
Silent
&
Lookup Noton PLTSES_LOC_v60
&
ViaPLTOBJ_NR,
&
TRANS-LOC-NR,
&
MME_PD_CODE
&
Using PLTOBJ_NR Of PLTSES_LOC_v60,
&
TRANS-LOC-NR Of PLTSES_LOC_v60,&
MME_PD_CODE Of PLTSES_LOC_v60
&
Optional
&
Message "*W* This location / dimension combination is already
defined"
Field PLTPG_NR Of PLTSES_LOC_AXIS_PG_SP
&
Character
&
Size 6
&
If TRANS-LOC-OBJECT Of TRANS-LOCS Eq "S"
Description Of PLTPG_NR Of PLTSES_LOC_AXIS_PG_SP
&
"The location entered is a 'special' location i.e. a location that" &
"has no 'orientation'."
&
"Thus no pages can be entered for the different axii and resul-" &
"tants."
&
" "
&
"This is f.i. for the locations that are needed for processing the" &
"output of the Airbag Timer Unit with recorder option."
Field PLTPG_NR Of PLTSES_LOC_AXIS_PG_X
&
Character
&
Size 6
&
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Description Of PLTPG_NR Of PLTSES_LOC_AXIS_PG_X&
"The location entered is a 'normal' location i.e. a location that" &
"has to be oriented in 'space'."
&
"Thus no pages can be entered for the 'special' category."
Field PLTPG_NR Of PLTSES_LOC_AXIS_PG_Y
&
Character
&
Size 6
&
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Field PLTPG_NR Of PLTSES_LOC_AXIS_PG_Z
&
Character
&
Size 6
&
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Field PLTPG_NR Of PLTSES_LOC_AXIS_PG_R
&
Character
&
Size 6
&
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Field PLTPG_NR Of PLTSES_LOC_AXIS_PG_M
&
Character
&
Size 6
&
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Field t'c1MULTI_AXIS
&
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
&
Values "X", "Y", "Z", "A"
&
Upshift
Field VARIABLE_LOCATIONS Of PLTSES_LOC_AXIS_PG_M &
If 0 Ne PLTPG_NR Of PLTSES_LOC_AXIS_PG_M
&
Predisplay
Field t'UPDATE_DESC Silent ID Same
Field t'c80DESCRIPTION
&
Display
&
For 1,20
Cluster
Skip
Align (,,6) (,,50)
Cluster
Field t'QUESTION
&
Noid
&
Nolabel
&
Display
Field t'ANSWER
&
Values 'Y', 'N'
&
Upshift
&
Noid
&
Nolabel
&
Display
Field t'QUESTION2
&
Noid
&
Nolabel
&
Display
Field t'OBJECT_CODE&
Upshift
&
Noid
&
Nolabel
&
Lookup On REF_OBJECT
&
Message '*E* This object is not known.'&
Required
&
Display
Cluster
;-----------------------------------------------------------------------------
;***** PROCEDURES ************************************************************
;-----------------------------------------------------------------------------
;-----------------------------------------------------------------------------
;***** INTERNAL PROCEDURES ***************************************************
;-----------------------------------------------------------------------------
;-----------------------------------------------------------------------------
;***** FIELD LEVEL PROCEDURES ************************************************
;-----------------------------------------------------------------------------
Procedure Input MME_PD_CODE
Begin
If "*" Eq Reverse(FIELDTEXT)[1:1]
Then Begin
Let t'c32OBJECT_NAME_PASS = Upshift(FIELDTEXT)
Run Screen BEGRIP_S99069902&
Passing t'n10OBJECT_TYPE_ID_PASS
&
, t'n10OBJECT_ID_PASS
&
, t'c32OBJECT_NAME_PASS
If t'n10OBJECT_ID_PASS Ne 0
Then Let FIELDTEXT = t'c32OBJECT_NAME_PASS
End
End
Procedure Input TRANS-LOC-NR
Begin
If 0 <> Size(Fieldtext)
Then Begin
; This field can include TRANS-LOC-SEQ. This can be recognized
; by the numberic part before the point (.) sign.
; Split the temporary in two parts:
; 1. LOC_SEQ_NR (optional)
; 2. LOC_CODE
Let t'SPLIT_POS = INDEX(FIELDTEXT,'.')
If 0 Ne t'SPLIT_POS
Then Begin
; LOC_SEQ_NR is filled in.
Let t'LOC_SEQ_NR = NCONVERT(FIELDTEXT[1:(t'SPLIT_POS - 1)])
Let FIELDTEXT
&
= Trunc(FIELDTEXT[(t'SPLIT_POS + 1):(6 - t'SPLIT_POS)])
End
Else Begin
; LOC_SEQ_NR is NOT filled in.
Let t'LOC_SEQ_NR = 0
If 4 Lt Size(Trunc(FIELDTEXT))
Then Error "*E* This is not a valid location code. Use * for
list"
End
; Check for picklist request.
If '*' Eq Reverse(TRUNC(FIELDTEXT))[1:1]
Then Begin
Let t'LOC_OBJECT = '*'
Let t'LOC_NR_STR
&
= Upshift(FIELDTEXT) ; TRANS-LOC-NR Of PLTSES_LOC_v60
Run Screen BEGRIP_S0914 Mode F Passing t'LOC_OBJECT,
&
t'LOC_NR_STR
Get TRANS-LOCS
&
Via TRANS-LOC-NR
&
Using Nconvert(t'LOC_NR_STR)
&
Optional
If Accessok
Then Begin
Let t'TRANS-LOC-CODE = TRANS-LOC-CODE Of TRANS-LOCS
Let Fieldtext = t'LOC_NR_STR
End
Else Let FIELDTEXT = ' '
End
Else begin
If Not Matchpattern(Fieldtext,"#>")
Then Begin
Get TRANS-LOCS
&
Via TRANS-LOC-CODE
&
Using Upshift(Fieldtext) Optional
If Accessok
Then Let Fieldtext = Ascii(TRANS-LOC-NR Of TRANS-LOCS)
Else Let Fieldtext = "0"
End
End
End
End
;Procedure Process TRANS-LOC-NR
;Begin
;
; Let TRANS-LOC-SEQ Of PLTSES_LOC_v60&
; = t'LOC_SEQ_NR
; Display TRANS-LOC-SEQ Of PLTSES_LOC_v60
; Let t'TRANS-LOC-CODE = TRANS-LOC-CODE Of TRANS-LOCS
;
;End
Procedure Output TRANS-LOC-NR
Begin
; Let Fieldtext = t'TRANS-LOC-CODE
Let Fieldtext = TRANS-LOC-CODE Of TRANS-LOCS
End
Procedure Edit t'SIGNAL_SPECIAL_LOCATION
If TRANS-LOC-OBJECT Of TRANS-LOCS Eq "S"
Then Info = "*I* This is a 'special' location; "
&
+ "no entries for axii. Type ?? for help."
Else Info = "*I* This is a 'normal' location; "
&
+ "no entries for 'spec'. Type ?? for help."
Use begrip$USE:DP0003.QKU Nolist
&
Nodetail
;========================================================================
; SP
;========================================================================
Procedure Input PLTPG_NR Of PLTSES_LOC_AXIS_PG_SP
Begin
If 0 <> Index(FIELDTEXT,'*')
Then Do Internal GET-OBJECT
Else If 0 <> Size(FIELDTEXT) And Fieldtext <> " "
Then Begin
Get DPP-OBJECTS&
Via DPP-OBJECT-TYPE-ID,&
DPP-OBJECT-MNEM
&
Using DPP-OBJECT-TYPE-ID Of PLTPG_SP,
&
Upshift(FIELDTEXT)
&
Optional
If Not Accessok
Then Error '*E* This is not a valid Plot Page.'
Else Let FIELDTEXT = ASCII(DPP-OBJECT-ID Of DPP-OBJECTS)
End
End
Procedure Process PLTPG_NR Of PLTSES_LOC_AXIS_PG_SP
Begin
Let t'SP_DEL = "N"
If PLTPG_NR Of PLTSES_LOC_AXIS_PG_SP = 0
Then Begin
If Newrecord Of PLTSES_LOC_AXIS_PG_SP
Then Begin
Delete PLTSES_LOC_AXIS_PG_SP
Get PLTSES_LOC_AXIS_PG_SP Optional
End
Else Let t'SP_DEL = "Y"
End
End
Procedure Output PLTPG_NR Of PLTSES_LOC_AXIS_PG_SP
Begin
;-
; Perform an extra GET on PLTPG to force PH to retrieve the correct
record
; This did not happen for certain PLTPG ID's. Why ? Do not know !!!!
;-
If 0 <> PLTPG_NR Of PLTSES_LOC_AXIS_PG_SP
Then Begin
Get PLTPG_SP Optional
If Not Accessok
Then Error '*E* Error retrieving plot page. Contact system
manager.'
Let FIELDTEXT = Pack(PLTPG_MNEM Of PLTPG_SP)
End
Else Let Fieldtext = ""
End
;========================================================================
; XL
;========================================================================
Procedure Input PLTPG_NR Of PLTSES_LOC_AXIS_PG_X
Begin
If 0 <> Index(FIELDTEXT,'*')
Then Do Internal GET-OBJECT
Else If 0 <> Size(FIELDTEXT) And Fieldtext <> " "
Then Begin
Get DPP-OBJECTS&
Via DPP-OBJECT-TYPE-ID,&
DPP-OBJECT-MNEM
&
Using DPP-OBJECT-TYPE-ID Of PLTPG_X,
&
Upshift(FIELDTEXT)
&
Optional
If Not Accessok
Then Error '*E* This is not a valid Plot Page.'
Else Let FIELDTEXT = ASCII(DPP-OBJECT-ID Of DPP-OBJECTS)
End
End
Procedure Process PLTPG_NR Of PLTSES_LOC_AXIS_PG_X
Begin
Let t'X_DEL = "N"
If PLTPG_NR Of PLTSES_LOC_AXIS_PG_X = 0
Then Begin
If Newrecord Of PLTSES_LOC_AXIS_PG_X
Then Begin
Delete PLTSES_LOC_AXIS_PG_X
Get PLTSES_LOC_AXIS_PG_X Optional
End
Else Let t'X_DEL = "Y"
End
End
Procedure Output PLTPG_NR Of PLTSES_LOC_AXIS_PG_X
Begin
;-
; Perform an extra GET on PLTPG to force PH to retrieve the correct
record
; This did not happen for certain PLTPG ID's. Why ? Do not know !!!!
;-
If 0 <> PLTPG_NR Of PLTSES_LOC_AXIS_PG_X
Then Begin
Get PLTPG_X Optional
If Not Accessok
Then Error '*E* Error retrieving plot page. Contact system
manager.'
Let FIELDTEXT = Pack(PLTPG_MNEM Of PLTPG_X)
End
Else Let Fieldtext = ""
End
;========================================================================
; XG
;========================================================================
Procedure Input PLTPG_NR Of PLTSES_LOC_AXIS_PG_M
Begin
If 0 <> Index(FIELDTEXT,'*')
Then Do Internal GET-OBJECT
Else If 0 <> Size(FIELDTEXT) And Fieldtext <> " "
Then Begin
GetDPP-OBJECTS
&
Via DPP-OBJECT-TYPE-ID,&
DPP-OBJECT-MNEM
&
Using DPP-OBJECT-TYPE-ID Of PLTPG_M,
&
Upshift(FIELDTEXT)
&
Optional
If Not Accessok
Then Error '*E* This is not a valid Plot Page.'
Else Let FIELDTEXT = ASCII(DPP-OBJECT-ID Of DPP-OBJECTS)
End
End
Procedure Process PLTPG_NR Of PLTSES_LOC_AXIS_PG_M
Begin
Let t'M_DEL = "N"
If PLTPG_NR Of PLTSES_LOC_AXIS_PG_M = 0
Then Begin
If Newrecord Of PLTSES_LOC_AXIS_PG_M
Then Begin
Delete PLTSES_LOC_AXIS_PG_M
Get PLTSES_LOC_AXIS_PG_M Optional
End
Else Begin
Let t'M_DEL = "Y"
Let t'c80DESCRIPTION = ""
Display t'c80DESCRIPTION
End
End
End
Procedure Output PLTPG_NR Of PLTSES_LOC_AXIS_PG_M
Begin
;-
; Perform an extra GET on PLTPG to force PH to retrieve the correct
record
; This did not happen for certain PLTPG ID's. Why ? Do not know !!!!
;-
If 0 <> PLTPG_NR Of PLTSES_LOC_AXIS_PG_M
Then Begin
Get PLTPG_M Optional
If Not Accessok
Then Error '*E* Error retrieving plot page. Contact system
manager.'
Let FIELDTEXT = Pack(PLTPG_MNEM Of PLTPG_M)
If Changemode Or Entrymode
Then Info
&
"Enter the axis (X,Y or Z) for which this page is to be generated"
End
Else Let Fieldtext = ""
End
Procedure Output t'c1MULTI_AXIS
Begin
If Changemode Or Entrymode
Then Info
&
"Generate with variable location information ([Y]|N)? (?? for help)"
End
;========================================================================
; YL
;========================================================================
Procedure Input PLTPG_NR Of PLTSES_LOC_AXIS_PG_Y
Begin
If 0 <> Index(FIELDTEXT,'*')
Then Do Internal GET-OBJECT
Else If 0 <> Size(FIELDTEXT) And Fieldtext <> " "
Then Begin
GetDPP-OBJECTS
&
Via DPP-OBJECT-TYPE-ID,&
DPP-OBJECT-MNEM
&
Using DPP-OBJECT-TYPE-ID Of PLTPG_Y,
&
Upshift(FIELDTEXT)
&
Optional
If Not Accessok
Then Error '*E* This is not a valid Plot Page.'
Else Let FIELDTEXT = ASCII(DPP-OBJECT-ID Of DPP-OBJECTS)
End
End
Procedure Process PLTPG_NR Of PLTSES_LOC_AXIS_PG_Y
Begin
Let t'Y_DEL = "N"
If PLTPG_NR Of PLTSES_LOC_AXIS_PG_Y = 0
Then Begin
If Newrecord Of PLTSES_LOC_AXIS_PG_Y
Then Begin
Delete PLTSES_LOC_AXIS_PG_Y
Get PLTSES_LOC_AXIS_PG_Y Optional
End
Else Let t'Y_DEL = "Y"
End
End
Procedure Output PLTPG_NR Of PLTSES_LOC_AXIS_PG_Y
Begin
;-
; Perform an extra GET on PLTPG to force PH to retrieve the correct
record
; This did not happen for certain PLTPG ID's. Why ? Do not know !!!!
;-
If 0 <> PLTPG_NR Of PLTSES_LOC_AXIS_PG_Y
Then Begin
Get PLTPG_Y Optional
If Not Accessok
Then Error '*E* Error retrieving plot page. Contact system
manager.'
Let FIELDTEXT = Pack(PLTPG_MNEM Of PLTPG_Y)
End
Else Let Fieldtext = ""
End
;========================================================================
; ZL
;========================================================================
Procedure Input PLTPG_NR Of PLTSES_LOC_AXIS_PG_Z
Begin
If 0 <> Index(FIELDTEXT,'*')
Then Do Internal GET-OBJECT
Else If 0 <> Size(FIELDTEXT) And Fieldtext <> " "
Then Begin
GetDPP-OBJECTS
&
Via DPP-OBJECT-TYPE-ID,&
DPP-OBJECT-MNEM
&
Using DPP-OBJECT-TYPE-ID Of PLTPG_Z,
&
Upshift(FIELDTEXT)
&
Optional
If Not Accessok
Then Error '*E* This is not a valid Plot Page.'
Else Let FIELDTEXT = ASCII(DPP-OBJECT-ID Of DPP-OBJECTS)
End
End
Procedure Process PLTPG_NR Of PLTSES_LOC_AXIS_PG_Z
Begin
Let t'Z_DEL = "N"
If PLTPG_NR Of PLTSES_LOC_AXIS_PG_Z = 0
Then Begin
If Newrecord Of PLTSES_LOC_AXIS_PG_Z
Then Begin
Delete PLTSES_LOC_AXIS_PG_Z
Get PLTSES_LOC_AXIS_PG_Z Optional
End
Else Let t'Z_DEL = "Y"
End
End
Procedure Output PLTPG_NR Of PLTSES_LOC_AXIS_PG_Z
Begin
;-
; Perform an extra GET on PLTPG to force PH to retrieve the correct
record
; This did not happen for certain PLTPG ID's. Why ? Do not know !!!!
;-
If 0 <> PLTPG_NR Of PLTSES_LOC_AXIS_PG_Z
Then Begin
Get PLTPG_Z Optional
If Not Accessok
Then Error '*E* Error retrieving plot page. Contact system
manager.'
Let FIELDTEXT = Pack(PLTPG_MNEM Of PLTPG_Z)
End
Else Let Fieldtext = ""
End
;========================================================================
; RL
;========================================================================
Procedure Input PLTPG_NR Of PLTSES_LOC_AXIS_PG_R
Begin
If 0 <> Index(FIELDTEXT,'*')
Then Do Internal GET-OBJECT
Else If 0 <> Size(FIELDTEXT) And Fieldtext <> " "
Then Begin
GetDPP-OBJECTS
&
Via DPP-OBJECT-TYPE-ID,&
DPP-OBJECT-MNEM
&
Using DPP-OBJECT-TYPE-ID Of PLTPG_R,
&
Upshift(FIELDTEXT)
&
Optional
If Not Accessok
Then Error '*E* This is not a valid Plot Page.'
Else Let FIELDTEXT = ASCII(DPP-OBJECT-ID Of DPP-OBJECTS)
End
End
Procedure Process PLTPG_NR Of PLTSES_LOC_AXIS_PG_R
Begin
Let t'R_DEL = "N"
If PLTPG_NR Of PLTSES_LOC_AXIS_PG_R = 0
Then Begin
If Newrecord Of PLTSES_LOC_AXIS_PG_R
Then Begin
Delete PLTSES_LOC_AXIS_PG_R
Get PLTSES_LOC_AXIS_PG_R Optional
End
Else Begin
Let t'R_DEL = "Y"
End
End
End
Procedure Output PLTPG_NR Of PLTSES_LOC_AXIS_PG_R
Begin
;-
; Perform an extra GET on PLTPG to force PH to retrieve the correct
record
; This did not happen for certain PLTPG ID's. Why ? Do not know !!!!
;-
If 0 <> PLTPG_NR Of PLTSES_LOC_AXIS_PG_R
Then Begin
Get PLTPG_R Optional
If Not Accessok
Then Error '*E* Error retrieving plot page. Contact system
manager.'
Let FIELDTEXT = Pack(PLTPG_MNEM Of PLTPG_R)
End
Else Let Fieldtext = ""
End
;========================================================================
Procedure Edit t'UPDATE_DESC
Begin
Let t'n4ID = DESCR_ID Of PLTSES_LOC_v60
If 0 Ne t'n4ID
Then Begin
Run Screen BEGRIP_S9000
&
Passing t'n4ID,
&
t'c80DESCRIPTION
&
Mode F
End
Else Begin
Run Screen BEGRIP_S9000
&
Passing t'n4ID,
&
t'c80DESCRIPTION
End
Let DESCR_ID Of PLTSES_LOC_v60 = t'n4ID
Display t'c80DESCRIPTION
End
;-----------------------------------------------------------------------------
;***** SCREEN LEVEL PROCEDURES ***********************************************
;-----------------------------------------------------------------------------
Use BEGRIP$USE:DP0004.QKU Nolist
&
Nodetail
Procedure Find
Begin
If Path = 1
Then Get PLOTSESSION_OBJ
&
Via DPP-OBJECT-TYPE-ID,
&
PLTOBJ_MNEM&
Using DPP-OBJECT-TYPE-ID Of PLOTSESSION_OBJ,
&
PLTOBJ_MNEM Of PLOTSESSION_OBJ
If Path = 2
Then Get PLOTSESSION_OBJ
&
Via DPP-OBJECT-TYPE-ID
&
Using DPP-OBJECT-TYPE-ID Of PLOTSESSION_OBJ
If Path = 3
Then Get PLOTSESSION_OBJ
&
Via DPP-OBJECT-ID
&
Using t'zu10OBJECT_ID
Get PLTOBJ_PLTPG Optional
If AccessOk
Then Error ""
End
Procedure Detail Find
Begin
For Missing PLTSES_LOC_v60
Begin
Get PLTSES_LOC_v60 Optional
Get PLTSES_LOC_AXIS_PG_SP Optional
Get PLTSES_LOC_AXIS_PG_X Optional
Get PLTSES_LOC_AXIS_PG_Y Optional
Get PLTSES_LOC_AXIS_PG_Z Optional
Get PLTSES_LOC_AXIS_PG_R Optional
Get PLTSES_LOC_AXIS_PG_M Optional
End
End
Procedure Detail Postfind
Begin
For PLTSES_LOC_v60
Begin
Get TRANS-LOCS
Let t'TRANS-LOC-CODE = TRANS-LOC-CODE Of TRANS-LOCS
Let t'c80DESCRIPTION = DESCRIPTION Of DESCRIPTION
Let t'c1MULTI_AXIS = TRANS_LOC_AXIS Of PLTSES_LOC_AXIS_PG_M[2:1]
End
End
Procedure Internal DEL_DESC_FILES
Begin
While Retrieving DESCRIPTION_ELEMENT_TXT
Begin
Del DESCRIPTION_ELEMENT_TXT
Put DESCRIPTION_ELEMENT_TXT
End
While Retrieving DESCRIPTION_ELEMENT_KEY
Begin
Del DESCRIPTION_ELEMENT_KEY
Put DESCRIPTION_ELEMENT_KEY
End
Del DESCRIPTION_DEL
Put DESCRIPTION_DEL Reset
End
Procedure Preupdate Recoverable
Begin
Lock DPP-CONTROL
Get DPP-CONTROL
&
Using (1)
&
Optional
If Newrecord Of PLOTSESSION_OBJ
&
And Not Deletedrecord Of PLOTSESSION_OBJ
Then Begin
Do Internal CHECK_AT_SIGN
Let PLTOBJ_NR Of PLOTSESSION_OBJ
&
= DPP-OBJECT-ID Of DPP-CONTROL
End
For PLTSES_LOC_v60
Begin
If t'SP_DEL = "Y"
&
And Not Deletedrecord Of PLTSES_LOC_AXIS_PG_SP
Then Delete PLTSES_LOC_AXIS_PG_SP
If t'X_DEL = "Y"&
And Not Deletedrecord Of PLTSES_LOC_AXIS_PG_X
Then Delete PLTSES_LOC_AXIS_PG_X
If t'Y_DEL = "Y"&
And Not Deletedrecord Of PLTSES_LOC_AXIS_PG_Y
Then Delete PLTSES_LOC_AXIS_PG_Y
If t'Z_DEL = "Y"&
And Not Deletedrecord Of PLTSES_LOC_AXIS_PG_Z
Then Delete PLTSES_LOC_AXIS_PG_Z
If t'R_DEL = "Y"&
And Not Deletedrecord Of PLTSES_LOC_AXIS_PG_R
Then Delete PLTSES_LOC_AXIS_PG_R
If t'M_DEL = "Y"&
And Not Deletedrecord Of PLTSES_LOC_AXIS_PG_M
Then Begin
Delete PLTSES_LOC_AXIS_PG_M
Get DESCRIPTION_DEL Optional
If Accessok
Then Begin
Do Internal DEL_DESC_FILES
Let DESCR_ID Of PLTSES_LOC_V60 = 0
End
End
Else Let TRANS_LOC_AXIS Of PLTSES_LOC_AXIS_PG_M
&
= "M" + t'c1MULTI_AXIS
If Newrecord Of PLTSES_LOC_v60
&
And Not Deletedrecord Of PLTSES_LOC_v60
Then Begin
Do Internal CHECK_AT_SIGN
Let PLTSES_LOC_ID Of PLTSES_LOC_v60
&
= DPP-OBJECT-ID Of DPP-CONTROL
End
If Deletedrecord of PLTSES_LOC_V60
Then Do Internal DEL_DESC_FILES
End
Put DPP-CONTROL Reset
Unlock DPP-CONTROL
End
Procedure Path
Begin
Let PATH = 0
If t'zu10OBJECT_ID Ne 0
Then Let PATH = 3
If PATH = 0
Then Begin
REQUEST PLTOBJ_MNEM OF PLOTSESSION_OBJ
IF PROMPTOK
THEN LET PATH = 1
End
IF PATH = 0
THEN LET PATH = 2
End
Procedure Postfind
Let t'zu10OBJECT_ID = 0
Procedure Postupdate
Begin
Let t'zu10OBJECT_ID = DPP-OBJECT-ID Of PLOTSESSION_OBJ
Push Find
End
;-----------------------------------------------------------------------------
;***** DESIGNER PROCEDURES ***************************************************
;-----------------------------------------------------------------------------
Procedure Designer 02
Begin
Accept TRANS-LOC-NR Of PLTSES_LOC_v60
Edit t'SIGNAL_SPECIAL_LOCATION
If TRANS-LOC-OBJECT Of TRANS-LOCS EQ "S"
Then ACCEPT PLTPG_NR Of PLTSES_LOC_AXIS_PG_SP
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Then ACCEPT PLTPG_NR Of PLTSES_LOC_AXIS_PG_X
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Then ACCEPT PLTPG_NR Of PLTSES_LOC_AXIS_PG_Y
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Then ACCEPT PLTPG_NR Of PLTSES_LOC_AXIS_PG_Z
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Then ACCEPT PLTPG_NR Of PLTSES_LOC_AXIS_PG_R
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
Then ACCEPT PLTPG_NR Of PLTSES_LOC_AXIS_PG_M
If TRANS-LOC-OBJECT Of TRANS-LOCS Ne "S"
&
And0 Ne PLTPG_NR Of PLTSES_LOC_AXIS_PG_M
Then Begin
Accept VARIABLE_LOCATIONS Of PLTSES_LOC_AXIS_PG_M
Edit t'UPDATE_DESC
End
End
Procedure Designer MULT
Begin
Let t'zu10OBJECT_ID = DPP-OBJECT-ID Of PLOTSESSION_OBJ
Let t'zu10TRANS_LOC_NR = TRANS-LOC-NR Of PLTSES_LOC_V60
Run Screen BEGRIP_S803301
&
Passing t'zu10OBJECT_ID,
&
t'zu10TRANS_LOC_NR
&
Mode F
Push Find
End
Procedure Designer COPY Precommand Update Stay
Begin
; This is due to the fact that we've got two ways of entering this screen
; 1 - Normal as usual
; 2 - Trough teh new Browse screen
; When entering this screen by the new Browse screen then the copy
; must be made on that screen by the action Save As ..
; Check if copying is allowed.
If Alteredrecord Of PLTSES_LOC_V60&
Or Alteredrecord Of PLOTSESSION_OBJ
Then Error '*E* You have to issue an update first.'
If PLTOBJ_NR OF PLOTSESSION_OBJ Eq0
Then Error = 'There is NO PLOT OBJECT active.'
; 1. Ask for plot object mnemomnic to be copied from
Let t'QUESTION2 = 'Enter object mnemonic to copy from: '
Display t'QUESTION2
Accept t'OBJECT_CODE
If t'OBJECT_CODE Eq ' '
Then Error = '*E* An object mnemonic is required.'
; 2. Copy object
Let t'zu10OLD_OBJECT_ID_PASS = DPP-OBJECT-ID Of REF_OBJECT
Let t'zu10NEW_OBJECT_ID_PASS = DPP-OBJECT-ID of PLOTSESSION_OBJ
Run Screen TEST
&
Passing t'zu10OLD_OBJECT_ID_PASS
&
,t'zu10NEW_OBJECT_ID_PASS
;-
; Perform a find with the plotsession_obj ID to update the screen
;-
Let t'zu10OBJECT_ID = DPP-OBJECT-ID Of PLOTSESSION_OBJ
Push Find
End
;-----------------------------------------------------------------------------
;***** GENERAL COMMAND DESIGNER PROCEDURES ***********************************
;-----------------------------------------------------------------------------
@IF DEBUG
Build List Detail
@ELSE
Build
@ENDIF