A Note on Error Checking
This chapter contains several examples of PQL retrieval programs and
their FORTRAN counterparts using HOST
subroutine calls. Every HOST function call always
returns a value. In the following examples, this value is stored in
variable 'IERR'. This value should be checked after each function call
in case an error has been detected by the routine. To continue the
program after an error has been generated may damage the databases
that the program accesses.
The examples below do not do this error checking. This is for
readability only. It is not suggested programming practice.
Print the Value of a Variable In a Record
DBMS Retrieval Version
OLD FILE MOTHERS
PASSWORD LOVE
SECURITY RS1, WS1
C
C PRINTS THE STATUS OF PATIENT 1 0001.
C THE DATA IS CONTAINED IN RECORD TYPE 47
C WITH SORT IDS 3 AND 5
C
RETRIEVAL
. OLD CASE IS 10001
. OLD RECORD IS 17 (3,5)
. WRITE 'PATIENT 10001 STATUS IS' STATUS1
. END RECORD IS
. END CASE IS
END RETRIEVAL
HOST Retrieval Version
C IN THE FOLLOWING ROUTINE EACH FUNCTION RETURNS AN
C ERRORVALUE AND THAT VALUE IS STORED IN VARIABLE 'IERR', IN
C COMMON BLOCK 'HERROR'. THE FUNCTION NAME IS STORED
C IN VARIABLE 'ZZNAME', IN THE SAME COMMON BLOCK.
IMPLICIT INTEGER*4 (Z)
.
.
.
CHARACTER*8 DBNAME
CHARACTER*8 DBPASS
CHARACTER*S HSPASS
CHARACTER*8 RDPASS
CHARACTER*8 WRPASS
CHARACTER*8 VNSTAT
C
CHARACTER*5 PREFIX
CHARACTER*6 MDSN
CHARACTER*10 SDSN
C
REAL*8 VDSTAT
C
INTEGER*4 DUMMY
INTEGER*4 TSPACE
C
C FOR ERROR PROCESSING
C
REAL*8 ZZNAME
INTEGER*4 IERR
INTEGER*4 IDUMMY
COMMON /HERROR/ ZZNAME,IERR,IDUMMY
C
C
C
DATA DBNAME /'MOTHERS '/
DATA DBPASS /'LOVE '/
DATA HSPASS /'HOSTOKAY'/
DATA RDPASS /'RS1 '/
DATA WRPASS /'WS1 '/
DATA VNSTAT /'STATUS'/
C
DATA PREFIX/'[SIR]'/
DATA MDSN /'MASTER'/
DATA SDSN /'MY_PROGRAM'/
C
C START HOST SYSTEM: STEP 1.A
C
IF(ZSTART( 1,1,5000,0).LT.0) STOP 300
C
C LOG INTO MASTER: STEP 1.B
C
IF(ZLOGIN(MDSN,LEN(MDSN),SDSN,LEN(SDSN)).LT.0) GOTO 200
C
C ATTACH DATABASE NEEDED FOR RUN: STEP 2
C
IF (ZORDB(DBNAME,DBPASS,HSPASS,RDPASS,WRPASS,0,
*PREFIX,LEN(PREFIX) ).LT.0) GOTO 200
C
C START A "CASE IS" LEVEL: STEP 3
C
IF(ZCIS(0, 1 ) LT.0) GOTO 200
C
C CREATE A "WITH" KEY: STEP 4.A
C
IF(ZWITH(0).LT.0) GOTO 200
C
C DEFINE THE KEY: STEP 4.B
C
IF(ZINTKY(10001 ).LT.0) GOTO 200
C
C GET THE CASE(FOR SURE, IT IS THERE!): STEP 5
C
IF(ZCNEXT(0).LT.0) GOTO 200
C
C START A "RECORD IS" LEVEL: STEP 7
C
IF(ZRIS(17,0,1 ).LT.0) GOTO 200
C
C CREATE A "WITH" KEY: STEP 8.A
C
IF(ZWITH(0).LT.0) GOTO 200
C
C DEFINE THE KEY: STEP 8.B
C
IF(ZINTKY(3).LT.0) GOTO 200
IF(ZINTKY(5).LT.0) GOTO 200
C
C GET THE RECORD(FOR SURE, IT IS THERE!): STEP 9
C
IF(ZRNEXT(0).LT.0) GOTO 200
C
C BUILD A DESCRIPTOR FOR VARIABLE
C
IF(ZDESCO(VDSTAT,DBNAME,17,VNSTAT,0).LT.0) GOTO 200
C
C RETRIEVE THE VALUE (FOR SURE, ISDEFINED!): STEP 10.A
C
IF(ZRCTIN(VDSTAT,I).LT.0) GOTO 200
PRINT 100,1
100 FORMAT('PATIENT 10001 STATUS IS',I5)
C
C END OF RECORD IS LEVEL: STEP 11
C
IF(ZREXIT(0).LT.0) GOTO 200
C
C END OF CASE IS LEVEL: STEP 13
C
IF(ZCEXIT(0).LT.0) GOTO 200
C
C CLOSE THE DATABASE: STEP 14
C
IF(ZENDDB(DBNAME).LT.0) GOTO 200
C
C SHUT DOWN HOST: STEP 15
C
150 IF(ZEND(TSPACE).LT.0) STOP 400
GOTO 1000
C
C ERROR PROCESSING SECTION
C
200 PRINT 201, ZZNAME,IERR
201 FORMAT(1X,A8,' FAILED WITH ERROR CODE',I4) GOTO 150
1000 STOP
END
Retrieval Update with RECORD IS Nested within
a PROCESS CASE ALL
DBMS Retrieval Version
OLD FILE MOTHERS
PASSWORD LOVE
SECURITY RS1,WS1
C PROCESS ALL CASES IN THE DATABASE
C IF VARIABLE 'SICK' IN RECORD TYPE 16 IS
C GREATER THAN 0 SET 'SICK' EQUAL TO 1
RETRIEVAL UPDATE
. PROCESS CASES ALL
. OLD RECORD IS 16
. IFTHEN (SICK GT 0)
. COMPUTE SICK = 1
. ENDIF
. END RECORD IS
. END PROCESS CASES
END RETRIEVAL
HOST Retrieval Version
C IN THE FOLLOWING ROUTINE EACH FUNCTION RETURNS AN
C ERROR VALUE THAT IS PROCESSED BY 'ZCALL'.
C
IMPLICIT INTEGER*4 (Z)
CHARACTER*8 DBNAME
CHARACTER*8 DBPASS
CHARACTER*8 HSPASS
CHARACTER*8 RDPASS
CHARACTER*8 WRPASS
CHARACTER*8 VNSTAT
C
CHARACTER*5 PREFIX
C
REAL*8 VDSTAT
C
INTEGER*4 DUMMY
INTEGER*4 TSPACE
C
C
C
DATA DBNAME /'MOTHERS '/
DATA DBPASS /'LOVE '/
DATA HSPASS /'HOSTOKAY'/
DATA RDPASS /'RS1 '/
DATA WRPASS /'WS1 '/
DATA VNSTAT /'STATUS'/
C
DATA PREFIX /'[SIR]'/
C
C START HOST SYSTEM: STEP 1.A
C
100 IERR= ZCALL(ZSTART(1,1,5000,0),2,-2,100,0,0)
C
C ATTACH REQUIRED DBMS FILES: STEP 2
C
200 IERR= ZCALL(ZORDB(DBNAME,DBPASS,HSPASS,RDPASS,
*WRPASS,L,PREFIX,LEN(PREFIX)),2,-2,200,0,0)
C
C GET VARIABLE DESCRIPTOR OF VARIABLE 'SICK'
C FOR USE LATER
C
300 IERR= ZCALL(ZDESCD(VDSTAT,DBNAME,16,VNSTAT,0),2,-2,300,0,0)
C
C DO PROCESS CASES ALL LEVEL: STEP 3
C
400 IERR= ZCALL(ZCCNT(-I,1,1),2,-2,400,0,0)
C
C GET THE CASE: STEP 5
C
500 IF(ZCALL(ZCNEXT(0),2,-2,500,-4002,-4001).LT.0)GOT01100
C
C DO RECORD IS LEVEL: STEP 7
C
600 IERR=ZCALL(ZRIS(16,0,1),2,-2,600,0,0)
C
C GET THE RECORD: STEP 9
C
700 IF(ZCALL(ZRNEXT(L),2,-2,700,-4002,-4001).LT.0)GOT01000
C
C RETRIEVE VALUE AND UPDATE IT IF NECESSARY:
C STEP 10
C
800 IF(ZCALL(ZRCTIN(VDSTAT,ISICK).2,-2,800,-5008,(-5005).LT.0) GOTO 1000
IF (ISICK.LE.0) GOTO 1000
I = 1
900 IERR= ZCALL(ZINTRC(I,VDSTAT),2,-2,900,-5008,-5005)
C
C END OF RECORD IS LEVEL: STEP 11
C
1000 IERR= ZCALL(ZREXIT(0),2,-2,1000,0,0)
C
C CONTINUE WITH STEP 5
C
GOTO 500
C
C END OF PROCESS CASE LOOP: STEP 13
C
1100 IERR= ZCALL(ZCEXIT(0),2,-2,1100,0,0)
C
C CLOSE THE DATABASE: STEP 14
C
1200 IERR= ZCALL(ZENDDB(DBNAME),2,-2,1200,0,0)
C
C CLOSE HOST SYSTEM: STEP 15
C
1300 IERR= ZCALL(ZEND(TSPACE),2,-2,1300,0,0)
RECORD IS for a Caseless Database
DBMS Retrieval Version
OLD FILE MOTHERS
PASSWORD LOVE
SECURITY RS1,WS1
C PROCESS ALL RECORD TYPE 16 IN THE DATABASE IF VARIABLE
C 'SICK' IS GREATER THAN 0, SET 'SICK' EQUAL TO 1
RETRIEVAL UPDATE
. PROCESS RECORD 16
. IFTHEN (SICK GT 0)
. COMPUTE SICK = 1
. ENDIF
. END RECORD IS
END RETRIEVAL
HOST Retrieval Version
C IN THE FOLLOWING ROUTINE EACH FUNCTION RETURNS AN
C ERROR VALUE THAT IS PROCESSED BY 'ZCALL'.
IMPLICIT INTEGER*4 (Z)
.
.
.
CHARACTER*8 DBNAME
CHARACTER*8 DBPASS
CHARACTER*8 HSPASS
CHARACTER*8 RDPASS
CHARACTER*8 WRPASS
CHARACTER*8 VNSTAT
C
CHARACTER*5 PREFIX
C
REAL*8 VDSTAT
C
INTEGER*4 DUMMY
INTEGER*4 TSPACE
C
C
C
DATA DBNAME /'MOTHERS '/
DATA DBPASS /'LOVE'/
DATA HSPASS /'HOSTOKAY'/
DATA RDPASS /'RS1 '/
DATA WRPASS /'WS1 '/
DATA VNSTAT /'STATUS'/
C
DATA PREFIX /'[SIR]'/
C
C START HOST SYSTEM: STEP 1.A
C
100 IERR= ZCALL(ZSTART(1,1,5000,0),2,-2,100,0,0)
C
C ATTACH REQUIRED DBMS FILES: STEP 2
C
200 IERR= ZCALL(ZORDB(DBNAME,DBPASS,HSPASS,RDPASS,
*WRPASS,L,PREFIX,LEN(PREFIX)),2,-2,200,0,0)
C
C GET VARIABLE DESCRIPTOR OF VARIABLE'SICK'
C FOR USE LATER
C
300 IERR= ZCALL(ZDESCD(VDSTAT,DBNAME,16,VNSTAT,0),2,-2,300,0,0)
C
C DO PROCESS RECORD LEVEL: STEP 7
C
600 IERR= ZCALL(ZRCNT(16,-1,1,1),2,-2,600,0,0)
C
C GET THE RECORD: STEP 9
C
700 IF(ZCALL(ZRNEXT(1),2,-2,700,-4002,-4001).LT.0)GOT0 1000
C
C RETRIEVE VALUE AND UPDATE IT IF NECESSARY : STEP10
C
800 IF(ZCALL(ZRCTIN(VDSTAT,ISICK),2,-2,800,-5008,5005).LT.0) GOTO 700
IF (ISICK.LE.0) GOTO 700
I = 1
900 IERR= ZCALL(ZINTRC(I,VDSTAT),2,-2,900,-5008,-5005)
C
C CONTINUE WITH STEP 9
C
GOTO 700
C
C END OF RECORD IS LEVEL: STEP 11
C
1000 IERR= ZCALL(ZREXIT(0),2,-2,1000,0,0)
C
C CLOSE THE DATABASE: STEP 14
C
1200 IERR= ZCALL(ZENDDB(DBNAME),2,-2,1200,0,0)
C
C CLOSE HOST SYSTEM: STEP 15
C
1300 IERR= ZCALL(ZEND(TSPACE),2,-2,1300,0,0)
Multiple Nested Network Retrieval
DBMS Retrieval Version
OLD FILE MOTHERS
PASSWORD LOVE
SECURITY RS1,WS1
C RECORD TYPE 1 RECORDS ARE PATIENTS IN THE STUDY.
C RECORD TYPE 2 RECORDS ARE CONTROLS FOR PATIENTS.
C
C EACH PATIENT HAS A CONTROL WHOSE CASE ID IS'IDPOINTR'
C AND RECORD TYPE 2 SORT ID IS'RECPOINT'.
C
C PRINT THE NUMBER OF CONTROLS WHOSE VALUE OF VARIABLE
C 'CNTLSTAT' IS LESS THAN THE PATIENT'S VARIABLE'PATSTAT'.
RETRIEVAL
. PROCESS CASES ALL
. COMPUTE CNT = 0
. PROCESS RECORD 1
. MOVE VARS IDPOINTR RECPOINT PATSTAT
. OLD CASE IS IDPOINTR
. OLD RECORD IS 2 (RECPOINT)
. IFTHEN (CNTLSTAT LT PATSTAT)
. COMPUTE CNT = CNT + 1
. ENDIF
. END RECORD IS
. END CASEIS
. END PROCESS RECORD
. END PROCESS CASE
. WRITE CNT 'CONTROLS ARE BETTER THAN CURRENT PATIENTS.'
END RETRIEVAL
HOST Retrieval Version - Function C
C IN THE FOLLOWING ROUTINE EACH FUNCTION RETURNS A CALL
C ERROR VALUE AND THAT VALUE IS STORED IN VARIABLE'IERR'.
C THIS VARIABLE SHOULD BE CHECKED SOMEHOW AFTER EACH
C FUNCTION CALL, HOWEVER, IN ORDER TO IMPROVE THE
C READABILITY OF THE EXAMPLE THE TEST HAS BEEN OMITTED.
IMPLICIT INTEGER*4 (Z)
.
.
.
CHARACTER*8 DBNAME
CHARACTER*8 DBPASS
CHARACTER*8 HSPASS
CHARACTER*8 RDPASS
CHARACTER*8 WRPASS
CHARACTER*8 VNIDPT
CHARACTER*8 VNRECP
CHARACTER*8 VNPATS
CHARACTER*8 VNCNTL
C
CHARACTER*5 PREFIX
C
REAL*8 VDIDPT
REAL*8 VDRECP
REAL*8 VDPATS
REAL*8 VDCNTL
C
INTEGER*4 DUMMY
INTEGER*4 IERR
INTEGER*4 TSUSED
C
C
C
DATA DBNAME /'MOTHERS'/
DATA DBPASS /'LOVE'/
DATA HSPASS /'HOSTOKAY'/
DATA PREFIX /'[SIR]'/
DATA RDPASS /'RS1 '/
DATA WRPASS /'WS1 '/
DATA VNIDPT /'IDPOINTR'/
DATA VNRECP /'RECPOINT'/
DATA VNPATS /'PATSTAT'/
DATA VNCNTL /'CNTLSTAT'/
C
C START HOST SYSTEM: STEP 1
C
IERR = ZSTART(1,1,5000,0)
C
C ATTACH REQUIRED DBMS FILES: STEP 2
C
IERR = ZORDB(DBNAME,DBPASS,HSPASS,RDPASS,WRPASS,
*0,PREFIX,LEN(PREFIX)
C
C GET VARIABLE DESCRIPTORS FOR REQUIRED VARIABLES CONCE
C
IERR = ZDESCD(VDIDPT,DBNAME,1,VNIDPT,0)
IERR = ZDESCD(VDRECP,DBNAME,1,VNRECP,0)
IERR = ZDESCD(VDPATS,DBNAME,1,VNPATS,0)
IERR = ZDESCD(VDCNTL,DBNAME,2,VNCNTL,0)
C
C DO PROCESS CASES ALL LEVELR
C STEP 3
IERR = ZCCNT(-1,1,1)
C STEP 5
1000 IERR = ZCNEXT(0)
CNT = 0
C
C IF NO CASES LEFT, SKIP TO STEP 13
C
IF (IERR.LT.0) GOTO 6000
C
C DO PROCESS RECORD 1 LEVEL
C
C STEP 7
IERR = ZRCNT(1,-1,1,1)
C STEP 9
2000 IERR = ZRNEXT(0)
C
C IF NO RECORDS LEFT, SKIP TO STEP 11
C
IF (IERR.LT.0) GOTO 5000
C
C DO MOVE VAR STATEMENT
C
C STEP 10.A
IERR = ZRCTIN(VDIDPT,IDPNTR)
IERR = ZRCTIN(VDRECP,RCPNTR)
IERR = ZRCTFP(VDPATS,PATSTT)
C
C DO CASE IS STATEMENT
C STEP 3
IERR = ZCIS(0,I)
C STEP 4.A
IERR = ZWITH(0)
C STEP 4.B
IERR = ZINTKY(IDPNTR)
C STEP 5
IERR = ZCNEXT(0)
C
C IF NO CASES LEFT, SKIP TO STEP 13
C
IF (IERR.LT.0) GOTO 4000
C
C DO RECORD IS STATEMENT
C STEP 7
IERR = ZRIS(2,0,1
C STEP 8.A
IERR = ZWITH(0)
C STEP 8.B
IERR = ZINTKY(RCPNTR)
C STEP 9
IERR = ZRNEXT(0)
C
C IF NO RECORDS LEFT, SKIP TO STEP 11
C
IF ( IERR.LT.0) GOTO 3000
C
C INCREMENT CNT AFTER TEST
C
C STEP 10.A
IERR = ZRCTFP(VDCNTL,CNTSTT)
IF (CNTSTT.LT.PATSTT) CNT = CNT + 1
C
C DO END RECORD IS
C
C STEP 11
3000 IERR = ZREXIT(0)
C
C DO END CASE IS
C
C STEP 13
4000 IERR = ZCEXIT(0)
C
C LOOP OVER INNER CASE BLOCK
C
GOTO 2000
C
C DO END PROCESS REC
C STEP 11
C
5000 IERR = ZREXIT(0)
C
C CONTINUE WITH STEP 5 TO PROCESS A NEW CASE
C
GOTO 1000
C
C DO END PROCESS CASE
C STEP 13
C
6000 IERR = ZCEXIT(0)
C
C END OF RETRIEVAL PRINT RESULT
C
PRINT 100, CNT
100 FORMAT(I6,'CONTROLS ARE BETTER THAN CURRENT PATIENTS.')
C STEP 14
C
IERR = ZENODB(DBNAME) STEP 15
C
IERR = ZEND(TSPACE)
Host/API 
