*DECK DBGETCTXT 
USETEXT CCTTEXT 
USETEXT DBTEXT
PROC GETCTXT(TYPE,VALUE,MSGNO); 
*CALL DEBUGVARS 
*CALL GETSET
*CALL TABLNAMES 
*CALL CTEXT 
*CALL CTXTVALS
#THIS PROCEDURE SETS UP THE CTXT POINTER FROM CCTDBFSCTXT 
ON THE FIRST TIME ENTRY.
NOTE THAT CCTDBFSCTXT IS THE ATOM POINTER OF THE FIRST
DATA BASE CTXT ATOM - NOT A WORD POINTER. 
THEN, THE PROCEDURE ACCESSES THE NEXT CTXT ATOM (LEFT 
OR RIGHT ACCORDING TO THE LEAST SIGNIFICANT BIT OF THE
ATOM POINTER).
THE ATOM TYPE IS COMPARED WITH THE SPECIFIED TYPE AND IF
A MISMATCH IS DETECTED THE PROCEDURE TAKES THE FOLLOWING
ACTION -
  IF THE MSGNO IS ZERO THEN THE CALLER OF GETCTXT DID NOT 
  SPECIFY A MESSAGE NUMBER. INSTEAD THE CALLER SPECIFIED
  A FLAG THAT MUST BE SET TO 1 ON MISMATCH. 
  IF THE MSGNO IS NOT ZERO, THEN THE INTERNAL ERROR ROUTINE 
  IS CALLED WITH THE SPECIFIED ERROR NUMBER.
IF NO MISMATCH IS FOUND, THE SPECIFIED FIELD WILL RECEIVE 
THE CONTENTS OF THE VALUE FIELD FROM THE CTXT ATOM. 
IF THE TYPE INPUT PARAMETER IS ZERO, THE TYPE FIELD IS SET TO THE TYPE
OF THE CURRENT CTEXT ATOM (AND NO MISMATCH CHECK IS MADE).
# 
START("GETCTXT")
XDEF ITEM CTEXTPTR U;        #POINTER TO CURRENT CTEXT# 
XREF BEGIN
PROC IERR$; 
END 
ITEM TYPE, VALUE, MSGNO;
ARRAY [1:1] S(1); 
  BEGIN 
  ITEM PTR U(0,0,60) = [0];  #ATOM POINTER# 
  ITEM SUB U(0,0,59); #WORD POINTER#
  ITEM LOWBIT U(0,59,1); #LEFT/RIGHT INDICATOR# 
  END 
IF PTR[1] EQ 0
  THENB("CTXTPTR NOT YET SETUP")
  SETI("CTEXTPTR",CTEXTPTR,CCTDBFSCTXT+1)  #SET TO ATOM PTR#
#NOTE WD 0 OF CTEXT IS NOT USED. WD 1 HAS ATOM 1 (LEFT), ATOM 2 (R)#
ENDIF 
SETI("PTR[1]",PTR[1],CTEXTPTR)
IF LOWBIT[1] EQ 0 
  THENB("ACCESS LEFT ATOM") 
  IF TYPE EQ 0
    THENB("RETURN CTEXT TYPE")
    SETI("CTEXTTYPE",TYPE,$G(CTEXTTYPE1,CTEXT$,SUB[1])) 
    QUIT
  ENDIF 
  IF TYPE NQ $G(CTEXTTYPE1,CTEXT$,SUB[1]) 
    THENB("MISMATCH") 
    IV$($SET$,"CTEXTTYPE1",$G(CTEXTTYPE1,CTEXT$,SUB[1]))
    IF MSGNO EQ 0 
      THENB("MISMATCH NOT ERROR") 
      MSGNO=1;
      QUIT
      ELSEB("MISMATCH IS ERROR")
      IERR$(MSGNO,ABORT); 
    ENDIF 
    ELSEB("MATCH")
    VALUE=$G(CTEXTVALUE1,CTEXT$,SUB[1]);
  ENDIF 
  ELSEB("ACCESS RIGHT ATOM")
  IF TYPE EQ 0
    THENB("RETURN CTEXT TYPE")
    SETI("CTEXTTYPE",TYPE,$G(CTEXTTYPE2,CTEXT$,SUB[1])) 
    QUIT
  ENDIF 
  IF TYPE NQ $G(CTEXTTYPE2,CTEXT$,SUB[1]) 
    THENB("MISMATCH") 
    IV$($SET$,"CTEXTTYPE2",$G(CTEXTTYPE2,CTEXT$,SUB[1]))
    IF MSGNO EQ 0 
      THENB("MISMATCH NOT ERROR") 
      MSGNO=1;
      QUIT
      ELSEB("MISMATCH IS ERROR")
      IERR$(MSGNO,ABORT); 
    ENDIF 
    ELSEB("MATCH")
    VALUE=$G(CTEXTVALUE2,CTEXT$,SUB[1]);
  ENDIF 
ENDIF 
SETI("CTEXTPTR",CTEXTPTR,CTEXTPTR+1)
IV$($SET$,"CTEXTVALUE",VALUE) 
FINIS("GETCTXT")
TERM
