H*-------------------------------------------------------------MRB H* DRTOBJLCK - Display Real Time Object Lock H*---------------------------------------------------------------- H J FDRTOBJL IF F 46 DISK UC FDRTOBJLPCF E WORKSTN F REG KSFILE DRTSFL IDRTOBJL AA 01 I 1 5 DATUSE I P 6 80ODUCNT I 9 18 ODLBNM I 19 28 ODOBNM I 29 36 ODOBTP I 37 46 ODOBAT C*---------------------------------------------------------------- C *ENTRY PLIST C PARM LIBNAM 10 Library C* Carga variables C 'CHKOBJ' CAT 'LCKC' PGM 10 C 'WRKOBJ' CAT 'LCK ' CMD 10 C ' OUTPU' CAT 'T(*)' OUT 10 C 'QUSCMD' CAT 'LN' API 10 C*---------------------------------------------------------------- C* BUCLE PRINCIPAL C*---------------------------------------------------------------- C START TAG C*................... Inicializa subarchivo C EXSR RUT1 C*................... Carga subarchivo C EXSR RUT2 C*................... Visualiza subarchivo C WRITEDRTTOP Titulo C WRITEDRTBOT Pie C EXFMTDRTCTL Subarchivo C*................... Ejecuta opciones C EXSR RUT5 C*................... Salir C *IN05 CABEQ'1' START C *IN03 CABEQ'1' END C *IN12 CABEQ'1' END C *IN21 CASEQ'1' OPC21 C ENDCS C IND CABEQ'0' END C GOTO START C*................... Fin de programa C END TAG C MOVE '1' *INLR C RETRN /EJECT C***************************************************************** C* SUBRUTINAS * C***************************************************************** C*---------------------------------------------------------------- C* Inicializa Subarchivo C*---------------------------------------------------------------- C RUT1 BEGSR C MOVE '0' *IN30 C Z-ADD*ZEROS REG 30 Count Reg. C Z-ADD1 ERR 30 Count ERR. C MOVE '1' *IN20 C WRITEDRTCTL Clear Subfile C MOVE '0' *IN20 C ENDSR /SPACE C*---------------------------------------------------------------- C* Carga subarchivo C*---------------------------------------------------------------- C RUT2 BEGSR C OPEN DRTOBJL C *IN30 DOWEQ*ZEROS C READ DRTOBJL 30Fin Archivo C *IN30 IFEQ *ZEROS C ADD 1 REG C* Inicializa campos de pantalla C MOVE *BLANKS OPC C MOVE *BLANKS OPC2 C MOVE *BLANKS OBJECT C MOVE *BLANKS OBJEC2 C MOVE *BLANKS TYPE C MOVE *BLANKS TYPE2 C MOVE *BLANKS ATR C MOVE *BLANKS ATR2 C* MOVE *BLANKS LOCKED C* MOVE *BLANKS LOCKE2 C MOVE *BLANKS STATUS C MOVE *BLANKS STATU2 C* Subfile 1 C EXSR RUT3 C* Subfile 2 C *IN30 IFEQ *ZEROS *IN30=0 (2) C READ DRTOBJL 30Fin Archivo C *IN30 IFEQ *ZEROS *IN30=0 (3) C EXSR RUT4 C ENDIF *IN30=0 (3) C ENDIF *IN30=0 (2) C* C WRITEDRTSFL 30Subarch.Lleno C* C ENDIF *IN30=0 C ENDDO *IN30=0 C CLOSEDRTOBJL C ENDSR /SPACE C*---------------------------------------------------------------- C* Llena campos subarchivo 1 C*---------------------------------------------------------------- C RUT3 BEGSR C MOVELODOBNM OBJECT C* Comprueba bloqueo C MOVEL'*ALL' MEMBER 10 C MOVELODOBTP TYPE C MOVELODOBAT ATR C MOVE 'E' STS 1 C MOVE 'E' STSLCK 10 C CALL PGM 40 C PARM ODOBNM C PARM ODLBNM C PARM TYPE C PARM MEMBER C PARM STS C PARM STSLCK C* Carga estado y colores C STS IFEQ 'Y' C MOVELSTSLCK STATUS C ELSE C MOVE *BLANKS STATUS C ENDIF C SETOF 303132 C SETOF 333435 C STATUS COMP '*SHRRD' 31 C STATUS COMP '*SHRUPD' 32 C STATUS COMP '*SHRNUP' 33 C STATUS COMP '*EXCLRD' 34 C STATUS COMP '*EXCL' 35 C ENDSR /SPACE C*---------------------------------------------------------------- C* Llena campos subarchivo 2 C*---------------------------------------------------------------- C RUT4 BEGSR C MOVELODOBNM OBJEC2 C* Comprueba bloqueo C MOVEL'*ALL' MEMBER 10 C MOVELODOBTP TYPE2 C MOVELODOBAT ATR2 C MOVE 'E' STS 1 C MOVE 'E' STSLCK 10 C CALL PGM 40 C PARM ODOBNM C PARM ODLBNM C PARM TYPE2 C PARM MEMBER C PARM STS C PARM STSLCK C* Carga estado y colores C STS IFEQ 'Y' C MOVELSTSLCK STATU2 C ELSE C MOVE *BLANKS STATU2 C ENDIF C SETOF 404142 C SETOF 434445 C STATU2 COMP '*SHRRD' 41 C STATU2 COMP '*SHRUPD' 42 C STATU2 COMP '*SHRNUP' 43 C STATU2 COMP '*EXCLRD' 44 C STATU2 COMP '*EXCL' 45 C ENDSR /SPACE C*---------------------------------------------------------------- C* Ejecuta opciones C*---------------------------------------------------------------- C RUT5 BEGSR C MOVE '0' IND 1 C MOVE *BLANKS OBJ 10 C MOVE *BLANKS TYP 7 C MOVE *BLANKS ATF 10 C MOVE '0' *IN30 C *IN30 DOWEQ'0' C READCDRTSFL 30Fin Subarchivo C *IN30 IFEQ '0' C* Ejecuta opciones C OBJECT IFNE *BLANKS C OPC ANDNE*BLANKS C OBJEC2 ORNE *BLANKS C OPC2 ANDNE*BLANKS C* WRKOBJLCK C* Subfile 1 C OPC IFEQ '5' C MOVELOBJECT OBJ C MOVELTYPE TYP C EXSR OPC5 C ENDIF C* Subfile 2 C OPC2 IFEQ '5' C MOVELOBJEC2 OBJ C MOVELTYPE2 TYP C EXSR OPC5 C ENDIF C* WRKOBJ C* Subfile 1 C OPC IFEQ '6' C MOVELOBJECT OBJ C MOVELTYPE TYP C EXSR OPC6 C ENDIF C* Subfile 2 C OPC2 IFEQ '6' C MOVELOBJEC2 OBJ C MOVELTYPE2 TYP C EXSR OPC6 C ENDIF C* WRKF C* Subfile 1 C OPC IFEQ '8' C MOVELOBJECT OBJ C MOVELATR ATF C EXSR OPC8 C ENDIF C* Subfile 2 C OPC2 IFEQ '8' C MOVELOBJEC2 OBJ C MOVELATR2 ATF C EXSR OPC8 C ENDIF C* Borrar opcion en SFL C MOVE *BLANKS OPC C MOVE *BLANKS OPC2 C UPDATDRTSFL C ENDIF <>*BLANKS C ENDIF *IN30=0 C ENDDO *IN30=0 C ENDSR /SPACE C*---------------------------------------------------------------- C* Ejecuta opción 5 C* WRKOBJLCK OBJ(&LIBRARY/&OBJECT) OBJTYPE(&TYPE) OUTPUT(*) C*---------------------------------------------------------------- C OPC5 BEGSR C MOVE '1' IND C MOVE *BLANKS CMD1 49 C Z-ADD49 LEN 155 C* Procesa mandato C CMD CAT LIBNAM CMD1 C CMD1 CAT '/':0 CMD1 C CMD1 CAT OBJ:0 CMD1 C CMD1 CAT TYP:1 CMD1 C CMD1 CAT OUT CMD1 C CALL 'QCMDEXC' 40 C PARM CMD1 C PARM LEN C ENDSR /SPACE C*---------------------------------------------------------------- C* Ejecuta opción 6 C* WRKOBJ OBJ(&LIBRARY/&OBJECT) OBJTYPE(&TYPE) C*---------------------------------------------------------------- C OPC6 BEGSR C MOVE '1' IND C MOVE *BLANKS CMD1 49 C Z-ADD49 LEN 155 C* Procesa mandato C 'WRKOBJ' CAT LIBNAM:1 CMD1 C CMD1 CAT '/':0 CMD1 C CMD1 CAT OBJ:0 CMD1 C CMD1 CAT TYP:1 CMD1 C CALL 'QCMDEXC' 40 C PARM CMD1 C PARM LEN C ENDSR /SPACE C*---------------------------------------------------------------- C* Ejecuta opción 8 C* WRKF FILE(&LIBRARY/&OBJECT) FILEATR(&ATR) C*---------------------------------------------------------------- C OPC8 BEGSR C MOVE '1' IND C MOVE *BLANKS CMD1 49 C Z-ADD49 LEN 155 C* Procesa mandato C 'WRKF' CAT LIBNAM:1 CMD1 C CMD1 CAT '/':0 CMD1 C CMD1 CAT OBJ:0 CMD1 C CMD1 CAT ATF:1 CMD1 C CALL 'QCMDEXC' 40 C PARM CMD1 C PARM LEN C ENDSR /SPACE C*---------------------------------------------------------------- C* Ejecuta Mandato 21: Ventana linea mandatos C*---------------------------------------------------------------- C OPC21 BEGSR C CALL API C MOVE '1' IND C ENDSR