ENEQLT1 ;;(WIRMFO)/DH-LOCKOUT FLAG ;12.18.97
;;7.0;ENGINEERING;**35,47**;Aug 17, 1993
LST ;Listing is done interactively (upon request) as part of the
;equipment selection process. Reporting is done when changes are
;actually made.
;
; NOTE: This is a list of Equipment Categories,
; not Equipment Records
N LINE,COUNT,PAGE
S PAGE=0 D HDRLST
S CAT=0 F S CAT=$O(CATEGORY(CAT)) Q:'CAT D Q:ESCAPE
. W !,?10,CATEGORY(CAT) S LINE=LINE+1 D
.. S (COUNT,DA)=0 F S DA=$O(^ENG(6914,"G",CAT,DA)) Q:'DA S COUNT=COUNT+1
.. W " (",COUNT," Equipment Records)"
. I LINE>(IOSL-3),$O(CATEGORY(CAT)) D HOLD Q:ESCAPE D HDRLST
D HOLD
Q
;
HDRLST W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1,LINE=3,$X=0
W "EQUIPMENT CATEGORIES SELECTED",?40,ENDATE,?65,"Page ",PAGE,!
Q
;
REPAT ; Report of edited Equipment Records (Action Taken)
; Called by ^ENEQLT
K %IS("Q") S %ZIS="QM",%ZIS("A")="Select DEVICE for Action Taken Report: "
D ^%ZIS K %ZIS Q:POP I $D(IO("Q")) D D ^%ZISC Q
. S ZTRTN="DQAT^ENEQLT1",ZTSAVE("EN*")="",ZTDESC="Lockout/Tagout Report"
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
DQAT N PAGE,LINE,ESCAPE,DA,X,T S (PAGE,ESCAPE)=0
U IO D TABS,HDRAT
I $D(ZTQUEUED),'$D(^XUTL("ENLT",ENDATE("I"))) D D ^%ZISC G EXIT
. W !!,?20,"No list to process."
S DA=0 F S DA=$O(^XUTL("ENLT",ENDATE("I"),DA)) Q:'DA D
. D PRTAT
. I LINE>(IOSL-4),$O(^XUTL("ENLT",ENDATE("I"),DA)) D HOLD,HDRAT
D HOLD,^%ZISC
G EXIT ;Design EXIT POINT
;
PRTAT ; Get and print equipment data
S X(1)=$$GET1^DIQ(6914,DA,6),X(2)=$$GET1^DIQ(6914,DA,3)
S X(3)=$$GET1^DIQ(6914,DA,24),X(4)=$$GET1^DIQ(6914,DA,1)
S X(5)=$$GET1^DIQ(6914,DA,4),X(6)=$$GET1^DIQ(6914,DA,5)
I T(13)=59 D
. S X(1)=$E(X(1),1,20),X(2)=$E(X(2),1,30),X(4)=$E(X(4),1,32)
. S X(5)=$E(X(5),1,21)
. I $L(X(6))>21 S X(6)=$E(X(6),1,20)_"*"
I T(13)=66 S X(1)=$E(X(1),1,30),X(2)=$E(X(2),1,36),X(4)=$E(X(4),1,32)
I T(13)=94 S X(4)=$E(X(4),1,60)
W !,DA,?T(1),X(1),?T(2),X(2),?T(3),X(3)
W !,?T(11),X(4),?T(12),X(5),?T(13),X(6)
S LINE=LINE+2
Q
;
TABS ; Store tabs in local array T
I IOM<96 S T(1)=12,T(2)=33,T(3)=64,T(11)=4,T(12)=37,T(13)=59
I IOM>95,IOM<128 S T(1)=12,T(2)=43,T(3)=80,T(11)=2,T(12)=35,T(13)=66
I IOM>127 S T(1)=12,T(2)=43,T(3)=112,T(11)=2,T(12)=63,T(13)=94
Q
;
HDRAT ; Header for Activity Report
W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1,LINE=6,$X=0
W "'LOCKOUT REQUIRED?' Flag "_$S(ENACT="S":"SET",1:"CLEARED")_" for ... ",?(IOM-38),ENDATE,?(IOM-8),"Page "_PAGE
W !,"ENTRY #",?T(1),"Equipment Category",?T(2),"Manufacturer Equipment Name",?T(3),"Location"
W !,?T(11),"Manufacturer",?T(12),"Model",?T(13),"Serial Number"
K X S $P(X,"-",IOM)="-" W !,X,!
Q
;
HOLD Q:$E(IOST,1,2)'="C-"
W !!,"Press <RETURN> to continue, or '^' to escape..." R X:DTIME
S:$E(X)="^" ESCAPE=1
Q
;
EXIT K ^XUTL("ENLT",ENDATE("I"))
I $D(ZTQUEUED) S ZTREQ="@"
K ENACT,ENDATE
;ENEQLT1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQLT1 2945 printed Nov 22, 2024@17:02:37 Page 2
ENEQLT1 ;;(WIRMFO)/DH-LOCKOUT FLAG ;12.18.97
+1 ;;7.0;ENGINEERING;**35,47**;Aug 17, 1993
LST ;Listing is done interactively (upon request) as part of the
+1 ;equipment selection process. Reporting is done when changes are
+2 ;actually made.
+3 ;
+4 ; NOTE: This is a list of Equipment Categories,
+5 ; not Equipment Records
+6 NEW LINE,COUNT,PAGE
+7 SET PAGE=0
DO HDRLST
+8 SET CAT=0
FOR
SET CAT=$ORDER(CATEGORY(CAT))
if 'CAT
QUIT
Begin DoDot:1
+9 WRITE !,?10,CATEGORY(CAT)
SET LINE=LINE+1
Begin DoDot:2
+10 SET (COUNT,DA)=0
FOR
SET DA=$ORDER(^ENG(6914,"G",CAT,DA))
if 'DA
QUIT
SET COUNT=COUNT+1
+11 WRITE " (",COUNT," Equipment Records)"
End DoDot:2
+12 IF LINE>(IOSL-3)
IF $ORDER(CATEGORY(CAT))
DO HOLD
if ESCAPE
QUIT
DO HDRLST
End DoDot:1
if ESCAPE
QUIT
+13 DO HOLD
+14 QUIT
+15 ;
HDRLST if PAGE>0!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
SET PAGE=PAGE+1
SET LINE=3
SET $X=0
+1 WRITE "EQUIPMENT CATEGORIES SELECTED",?40,ENDATE,?65,"Page ",PAGE,!
+2 QUIT
+3 ;
REPAT ; Report of edited Equipment Records (Action Taken)
+1 ; Called by ^ENEQLT
+2 KILL %IS("Q")
SET %ZIS="QM"
SET %ZIS("A")="Select DEVICE for Action Taken Report: "
+3 DO ^%ZIS
KILL %ZIS
if POP
QUIT
IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="DQAT^ENEQLT1"
SET ZTSAVE("EN*")=""
SET ZTDESC="Lockout/Tagout Report"
+5 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
DO ^%ZISC
QUIT
DQAT NEW PAGE,LINE,ESCAPE,DA,X,T
SET (PAGE,ESCAPE)=0
+1 USE IO
DO TABS
DO HDRAT
+2 IF $DATA(ZTQUEUED)
IF '$DATA(^XUTL("ENLT",ENDATE("I")))
Begin DoDot:1
+3 WRITE !!,?20,"No list to process."
End DoDot:1
DO ^%ZISC
GOTO EXIT
+4 SET DA=0
FOR
SET DA=$ORDER(^XUTL("ENLT",ENDATE("I"),DA))
if 'DA
QUIT
Begin DoDot:1
+5 DO PRTAT
+6 IF LINE>(IOSL-4)
IF $ORDER(^XUTL("ENLT",ENDATE("I"),DA))
DO HOLD
DO HDRAT
End DoDot:1
+7 DO HOLD
DO ^%ZISC
+8 ;Design EXIT POINT
GOTO EXIT
+9 ;
PRTAT ; Get and print equipment data
+1 SET X(1)=$$GET1^DIQ(6914,DA,6)
SET X(2)=$$GET1^DIQ(6914,DA,3)
+2 SET X(3)=$$GET1^DIQ(6914,DA,24)
SET X(4)=$$GET1^DIQ(6914,DA,1)
+3 SET X(5)=$$GET1^DIQ(6914,DA,4)
SET X(6)=$$GET1^DIQ(6914,DA,5)
+4 IF T(13)=59
Begin DoDot:1
+5 SET X(1)=$EXTRACT(X(1),1,20)
SET X(2)=$EXTRACT(X(2),1,30)
SET X(4)=$EXTRACT(X(4),1,32)
+6 SET X(5)=$EXTRACT(X(5),1,21)
+7 IF $LENGTH(X(6))>21
SET X(6)=$EXTRACT(X(6),1,20)_"*"
End DoDot:1
+8 IF T(13)=66
SET X(1)=$EXTRACT(X(1),1,30)
SET X(2)=$EXTRACT(X(2),1,36)
SET X(4)=$EXTRACT(X(4),1,32)
+9 IF T(13)=94
SET X(4)=$EXTRACT(X(4),1,60)
+10 WRITE !,DA,?T(1),X(1),?T(2),X(2),?T(3),X(3)
+11 WRITE !,?T(11),X(4),?T(12),X(5),?T(13),X(6)
+12 SET LINE=LINE+2
+13 QUIT
+14 ;
TABS ; Store tabs in local array T
+1 IF IOM<96
SET T(1)=12
SET T(2)=33
SET T(3)=64
SET T(11)=4
SET T(12)=37
SET T(13)=59
+2 IF IOM>95
IF IOM<128
SET T(1)=12
SET T(2)=43
SET T(3)=80
SET T(11)=2
SET T(12)=35
SET T(13)=66
+3 IF IOM>127
SET T(1)=12
SET T(2)=43
SET T(3)=112
SET T(11)=2
SET T(12)=63
SET T(13)=94
+4 QUIT
+5 ;
HDRAT ; Header for Activity Report
+1 if PAGE>0!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
SET PAGE=PAGE+1
SET LINE=6
SET $X=0
+2 WRITE "'LOCKOUT REQUIRED?' Flag "_$SELECT(ENACT="S":"SET",1:"CLEARED")_" for ... ",?(IOM-38),ENDATE,?(IOM-8),"Page "_PAGE
+3 WRITE !,"ENTRY #",?T(1),"Equipment Category",?T(2),"Manufacturer Equipment Name",?T(3),"Location"
+4 WRITE !,?T(11),"Manufacturer",?T(12),"Model",?T(13),"Serial Number"
+5 KILL X
SET $PIECE(X,"-",IOM)="-"
WRITE !,X,!
+6 QUIT
+7 ;
HOLD if $EXTRACT(IOST,1,2)'="C-"
QUIT
+1 WRITE !!,"Press <RETURN> to continue, or '^' to escape..."
READ X:DTIME
+2 if $EXTRACT(X)="^"
SET ESCAPE=1
+3 QUIT
+4 ;
EXIT KILL ^XUTL("ENLT",ENDATE("I"))
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ENACT,ENDATE
+3 ;ENEQLT1
