Running PH from Cobol

[Tim Ericson]

Hi,

Since I wrote...

> Qdesign screens from COBOL are okay, but it's much more effecient
> if a Qdesign screen can run the COBOL program (because COBOL can
> be suspended from within Quick, and then re-activated, picking
> up just where it left off, without having to re-open any files)
> If you'd like a sample of that (developed from old "Cognos Tech
> News" articles), let me know and I'll forward it.

I've received a couple requests for this sample, so here's the
whole thing, sending and receiving CI variables from a Quick
screen to an MPE/iX COBOL program and the other way around, plus
calling and suspending an MPE/iX COBOL program from a Quick
screen:

In COBOL:
......
 SPECIAL-NAMES.
     CONDITION-CODE IS COND-CODE.
......
     02  THRU-DATE-INTEGER         PIC S9(09) COMP.
     02  DISPLAY-NUMERIC           PIC  9(08).
     02  RECORD-COUNT              PIC  9(04).
     02  COUNT-DISPLAY
         REDEFINES RECORD-COUNT    PIC  X(04).
     02  STATUS-RETURNED           PIC S9(09) COMP.
     02  STATUS-REDEFINED REDEFINES STATUS-RETURNED.
         03  STATUS-INFO           PIC S9(04) COMP.
         03  STATUS-SUBSYS         PIC S9(04) COMP.
     02  STRING-LENGTH             PIC  9(09) COMP.
     02  STRING-VALUE              PIC  9(09) COMP.
     02  VARIABLE-NAME             PIC  X(16).
......
 01-LOOP-POINT.

     MOVE "THRU_DATE" TO VARIABLE-NAME.
     MOVE 1 TO STRING-VALUE.
     CALL INTRINSIC "HPCIGETVAR"
         USING VARIABLE-NAME, STATUS-RETURNED,
             STRING-VALUE, THRU-DATE-INTEGER.
     IF STATUS-RETURNED <> ZERO
        DISPLAY "HPCIGETVAR 'THRU_DATE' failed in PROGRAM1."
        GO TO 01-STOP-RUN.

     MOVE "PLACE" TO VARIABLE-NAME.
     MOVE 2 TO STRING-VALUE.
     CALL INTRINSIC "HPCIGETVAR"
         USING VARIABLE-NAME, STATUS-RETURNED,
             STRING-VALUE, PLACE-HOLD.
     IF STATUS-RETURNED <> ZERO
        DISPLAY "HPCIGETVAR 'PLACE' failed in PROGRAM1
        GO TO 01-STOP-RUN.

     MOVE 0 TO RECORD-COUNT.
     PERFORM 50-PROCESS-RECORDS THRU 50-EXIT.

     MOVE "RECORD_COUNT" TO VARIABLE-NAME.
     MOVE 2 TO STRING-VALUE.
     MOVE 4 TO STRING-LENGTH.
     CALL INTRINSIC "HPCIPUTVAR"
         USING VARIABLE-NAME, STATUS-RETURNED,
             STRING-VALUE, COUNT-DISPLAY,
             11, STRING-LENGTH.                     
     IF STATUS-RETURNED <> ZERO
        DISPLAY "HPCIPUTVAR 'RECORD_COUNT' failed in PROGRAM1."
        COMPUTE DISPLAY-NUMERIC = STATUS-INFO
        DISPLAY "STATUS-INFO   = ", DISPLAY-NUMERIC
        COMPUTE DISPLAY-NUMERIC = STATUS-SUBSYS
        DISPLAY "STATUS-SUBSYS = ", DISPLAY-NUMERIC
        DISPLAY "RECORD-COUNT    ", RECORD-COUNT
        DISPLAY "      -DISPLAY  ", COUNT-DISPLAY
        GO TO 01-STOP-RUN.

     CALL INTRINSIC "ACTIVATE" USING ZERO.
     IF COND-CODE <> ZERO
        DISPLAY "The ACTIVATE intrinsic failed in PROGRAM1."
        GO TO 01-STOP-RUN.

     CALL INTRINSIC "SUSPEND" USING 1.
     IF COND-CODE <> ZERO
        DISPLAY "The SUSPEND intrinsic failed in PROGRAM1."
        GO TO 01-STOP-RUN.

     GO TO 01-LOOP-POINT.
......

In Qdesign:
......
TEMPORARY PASS-THRU-DATE CHARACTER * 8  RESET AT STARTUP
TEMPORARY PASS-PLACE     CHARACTER * 2  RESET AT STARTUP
TEMPORARY CHILD          INTEGER SIZE 2 INITIAL 0   RESET AT STARTUP
TEMPORARY COMMAND-STMT   CHARACTER * 80 INITIAL " " RESET AT STARTUP
TEMPORARY PROGRAM-NAME   CHARACTER * 34 INITIAL " " RESET AT STARTUP
TEMPORARY PROGRAM-PIN    INTEGER SIZE 2 INITIAL 0   RESET AT STARTUP
TEMPORARY RECORD-COUNT   NUMERIC * 4    INITIAL 0   RESET AT STARTUP
......
;*************************************************************
PROCEDURE INTERNAL RUN-PROGRAM
  BEGIN

    IF PROGRAM-PIN = 0
      THEN BEGIN
        LET CHILD = NCONVERT ( GETSYSTEMVAL ( "CHILD" ) ) + 1
        LET COMMAND-STMT = "RUN " + PROGRAM-NAME
        RUN COMMAND COMMAND-STMT ON ERROR CONTINUE
        DO EXTERNAL NM "getpin" (CHILD, PROGRAM-PIN)
        IF NOT SETSYSTEMVAL ( "CHILD", ASCII ( CHILD ) )
          THEN INFO = "SETSYSTEMVAL failed in RUN-PROGRAM." NOW
          ELSE NULL
      END
      ELSE BEGIN
        DO EXTERNAL NM "activate" (PROGRAM-PIN)
    END

  END                  
;*************************************************************
......
    IF NOT SETSYSTEMVAL &
      ( "THRU_DATE", PASS-THRU-DATE )
      THEN INFORMATION = "SETSYSTEMVAL failed in REGEN." NOW
      ELSE NULL
    IF NOT SETSYSTEMVAL &
      ( "PLACE", PASS-PLACE )
      THEN INFORMATION = "SETSYSTEMVAL failed in REGEN." NOW
      ELSE BEGIN
        LET PROGRAM-NAME = "PROGRAM1.OBJ.COBOL"
        LET PROGRAM-PIN  = &
          NCONVERT ( GETSYSTEMVAL ( "PROGRAM1_PIN" ) )
        DO INTERNAL RUN-PROGRAM
        LET RECORD-COUNT  = &
          NCONVERT ( GETSYSTEMVAL ( "RECORD_COUNT" ) )
        IF NOT SETSYSTEMVAL &
          ( "PROGRAM1_PIN", ASCII ( PROGRAM-PIN ) )
          THEN INFORMATION = "SETSYSTEMVAL failed in REGEN." NOW
          ELSE NULL
      END
......

Cheers!

 +-------------------------------------------------------------------+
  My mind is my own, as are my ideas and opinions.
  My heart, body, and soul, however, all belong to others.       Tim.
 +-------------------------------------------------------------------+
  Tim Ericson            tericson      DenKor Dental Management Corp.
  Sr. Systems Analyst     at denkor    503-526-4440 (my direct number)
    (& Systems Manager)     dot com         http://www.denkor.com
  Programming HP3000s since 1983!      Quality dental care since 1970!
 +-------------------------------------------------------------------+
  UDCs and Command Files:  http://www.denkor.com/hp3000/command_files
 +-------------------------------------------------------------------+



= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Subscribe: "subscribe powerh-l" in message body to majordomo@lists.swau.edu
Unsubscribe: "unsubscribe powerh-l" in message to majordomo@lists.swau.edu
This list is closed, thus to post to the list, you must be a subscriber.