ENEQLT2 ;(WIRMFO)/DH-LOCKOUT FLAG REPORTS ;4.9.97
;;7.0;ENGINEERING;**35**;Aug 17, 1993
;==================================================================
PRTEC ; Print equipment categories with 'LOCKOUT REQUIRED?' field
; set to 'YES'.
;
K IO("Q") S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) S ZTRTN="DQEC^ENEQLT2" D G EXIT
. S ZTDESC="LOCKOUT flag by Equipment Category"
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
DQEC N DATE,CAT,DA,COUNT,PAGE,LINE,ESCAPE,X S (CAT,DA,PAGE)=0
K ^TMP($J) D NOW^%DTC S Y=% X ^DD("DD") S DATE=$P(Y,":")_":"_$P(Y,":",2)
D TABS
F S CAT=$O(^ENG(6911,"AC",1,CAT)) Q:'CAT D
. S COUNT=0 F S DA=$O(^ENG(6914,"G",CAT,DA)) Q:'DA S COUNT=COUNT+1
. S ^TMP($J,CAT)=COUNT
PRTEC1 ; Physical printing of EQUIPMENT CATEGORIES
U IO D HDREC I '$D(^TMP($J)) W !,?5,"No EQUIPMENT CATEGORIES have 'LOCKOUT REQUIRED?' Flag SET"
S CAT=0 F S CAT=$O(^TMP($J,CAT)) Q:'CAT D
. W !,?5,$$GET1^DIQ(6911,CAT,.01)_" ("_^TMP($J,CAT)_" Equipment Records)"
. S LINE=LINE+1
. I LINE>(IOSL-3),$O(^TMP($J,CAT)) D HOLD,HDREC
D HOLD,EXIT
Q ;Design EXIT POINT
;
HDREC ; Header for EQUIPMENT CATEGORY List
W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1,LINE=3,$X=0
W "EQUIPMENT CATEGORIES with 'LOCKOUT REQUIRED?' Flag set to 'YES'"
W ?(IOM-7),"Page "_PAGE,!,DATE
K X S $P(X,"-",IOM-1)="-" W !,X,!
Q
;======================================================================
;
PRTER ; Print Equipment Records with 'LOCKOUT REQUIRED?' flag set to 'YES'
; Sortable by EQUIPMENT CATEGORY
;
S DIR(0)="Y",DIR("A")="Sort Report by EQUIPMENT CATEGORY",DIR("B")="YES"
D ^DIR K DIR Q:$D(DIRUT) S ENSORT=Y
K IO("Q") S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) S ZTRTN="DQER^ENEQLT2" D G EXIT
. S ZTDESC="'LOCKOUT REQUIRED?' Flag by Equipment Record"
. S ZTLOAD("ENSORT")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
DQER N DATE,PAGE,LINE,CAT,ESCAPE,DA,X,T S (PAGE,CAT,ESCAPE,DA)=0
D NOW^%DTC S Y=% X ^DD("DD") S DATE=$P(Y,":")_":"_$P(Y,":",2)
U IO D TABS
I '$D(^ENG(6914,"AJ",1)) D HDRER W !,?5,"No Equipment Records have 'LOCKOUT REQUIRED?' Flag set to 'YES'." D HOLD G EXIT
;
; Sort by EQUIPMENT CATEGORY
I ENSORT K ^TMP($J) D D:'ESCAPE HOLD G EXIT ;Design EXIT POINT
. F S DA=$O(^ENG(6914,"AJ",1,DA)) Q:'DA D
.. S CAT("I")=$P($G(^ENG(6914,DA,1)),U)
.. I CAT("I")'>0 S CAT("E")=0
.. E S CAT("E")=$P($G(^ENG(6911,CAT("I"),0)),U) S:CAT("E")="" CAT("E")=0
.. S ^TMP($J,CAT("E"),DA)=""
. D HDRER F S CAT=$O(^TMP($J,CAT)) Q:CAT=""!(ESCAPE) S DA=0 F S DA=$O(^TMP($J,CAT,DA)) Q:'DA!(ESCAPE) D
.. D PRTDAT
.. I LINE>(IOSL-4),($O(^TMP($J,CAT,DA))!($O(^TMP($J,CAT)))) D HOLD Q:ESCAPE D HDRER
;
; No sort by EQUIPMENT CATEGORY
D HDRER F S DA=$O(^ENG(6914,"AJ",1,DA)) Q:'DA!(ESCAPE) D
. D PRTDAT
. I LINE>(IOSL-4),$O(^ENG(6914,"AJ",1,DA)) D HOLD Q:ESCAPE D HDRER
D:'ESCAPE HOLD
G EXIT ;Design EXIT POINT
;
HDRER ; Header for Equipment Records
W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1,LINE=5,$X=0
W "EQUIPMENT with 'LOCKOUT REQUIRED?' Flag 'SET' "_DATE,?(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-1))="-" W !,X,!
Q
;
;======================================================================
;
PRTEX ; Print Equipment Records for which 'LOCKOUT REQUIRED?' Flag is CLEAR
; while their EQUIPMENT CATEGORY 'LOCKOUT REQUIRED?' Flag is SET
K IO("Q") S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) S ZTRTN="DQEX^ENEQLT2" D G EXIT
. S ZTDESC="'LOCKOUT REQUIRED?' Exception List"
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
DQEX N DATE,PAGE,LINE,ESCAPE,CAT,DA,X,T S (PAGE,ESCAPE,CAT)=0
D NOW^%DTC S Y=% X ^DD("DD") S DATE=$P(Y,":")_":"_$P(Y,":",2)
U IO D TABS
I '$D(^ENG(6911,"AC",1)) D HDREX W !!,?10,"There are no EQUIPMENT CATEGORIES with",!,?10,"'LOCKOUT REQUIRED?' Flag SET." D HOLD G EXIT
F S CAT=$O(^ENG(6911,"AC",1,CAT)) Q:'CAT S DA=0 F S DA=$O(^ENG(6914,"G",CAT,DA)) Q:'DA I '$D(^ENG(6914,"AJ",1,DA)) S ^TMP($J,DA)=""
I '$D(^TMP($J)) D HDREX W !!,?10,"There are no exceptions to report." D HOLD G EXIT
D HDREX S DA=0 F S DA=$O(^TMP($J,DA)) Q:'DA!(ESCAPE) D
. D PRTDAT
. I LINE>(IOSL-4),$O(^TMP($J,DA)) D HOLD Q:ESCAPE D HDREX
D:'ESCAPE HOLD
G EXIT ;Design EXIT POINT
;
HDREX ; Header for 'LOCKOUT REQUIRED?' Exception List
W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1,LINE=6,$X=0
W "'LOCKOUT REQUIRED?' Flag Exception List "_DATE,?(IOM-8),"Page ",PAGE
W !,"(Flag is CLEAR for these ENTRIES, but their EQUIPMENT CATEGORY Flag is SET)"
W !,"ENTRY #",?T(1),"Equipment Category",?T(2),"Manufacturer Equipment Name",?T(3),"Location"
W !,?T(11),"Manufacturer",?T(12),"Model",?T(13),"Serial Nummber"
K X S $P(X,"-",(IOM-1))="-" W !,X,!
Q
;==================================================================
;
PRTDAT ; 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
;
HOLD Q:$E(IOST,1,2)'="C-"
W !!,"Press <RETURN> to continue, '^' to escape..." R X:DTIME
S:$E(X)="^" ESCAPE=1
Q
;
EXIT K ^TMP($J) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
K ENSORT
;ENEQLT2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQLT2 5970 printed Dec 13, 2024@01:52:29 Page 2
ENEQLT2 ;(WIRMFO)/DH-LOCKOUT FLAG REPORTS ;4.9.97
+1 ;;7.0;ENGINEERING;**35**;Aug 17, 1993
+2 ;==================================================================
PRTEC ; Print equipment categories with 'LOCKOUT REQUIRED?' field
+1 ; set to 'YES'.
+2 ;
+3 KILL IO("Q")
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+4 IF $DATA(IO("Q"))
SET ZTRTN="DQEC^ENEQLT2"
Begin DoDot:1
+5 SET ZTDESC="LOCKOUT flag by Equipment Category"
+6 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
DQEC NEW DATE,CAT,DA,COUNT,PAGE,LINE,ESCAPE,X
SET (CAT,DA,PAGE)=0
+1 KILL ^TMP($JOB)
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET DATE=$PIECE(Y,":")_":"_$PIECE(Y,":",2)
+2 DO TABS
+3 FOR
SET CAT=$ORDER(^ENG(6911,"AC",1,CAT))
if 'CAT
QUIT
Begin DoDot:1
+4 SET COUNT=0
FOR
SET DA=$ORDER(^ENG(6914,"G",CAT,DA))
if 'DA
QUIT
SET COUNT=COUNT+1
+5 SET ^TMP($JOB,CAT)=COUNT
End DoDot:1
PRTEC1 ; Physical printing of EQUIPMENT CATEGORIES
+1 USE IO
DO HDREC
IF '$DATA(^TMP($JOB))
WRITE !,?5,"No EQUIPMENT CATEGORIES have 'LOCKOUT REQUIRED?' Flag SET"
+2 SET CAT=0
FOR
SET CAT=$ORDER(^TMP($JOB,CAT))
if 'CAT
QUIT
Begin DoDot:1
+3 WRITE !,?5,$$GET1^DIQ(6911,CAT,.01)_" ("_^TMP($JOB,CAT)_" Equipment Records)"
+4 SET LINE=LINE+1
+5 IF LINE>(IOSL-3)
IF $ORDER(^TMP($JOB,CAT))
DO HOLD
DO HDREC
End DoDot:1
+6 DO HOLD
DO EXIT
+7 ;Design EXIT POINT
QUIT
+8 ;
HDREC ; Header for EQUIPMENT CATEGORY List
+1 if PAGE>0!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
SET PAGE=PAGE+1
SET LINE=3
SET $X=0
+2 WRITE "EQUIPMENT CATEGORIES with 'LOCKOUT REQUIRED?' Flag set to 'YES'"
+3 WRITE ?(IOM-7),"Page "_PAGE,!,DATE
+4 KILL X
SET $PIECE(X,"-",IOM-1)="-"
WRITE !,X,!
+5 QUIT
+6 ;======================================================================
+7 ;
PRTER ; Print Equipment Records with 'LOCKOUT REQUIRED?' flag set to 'YES'
+1 ; Sortable by EQUIPMENT CATEGORY
+2 ;
+3 SET DIR(0)="Y"
SET DIR("A")="Sort Report by EQUIPMENT CATEGORY"
SET DIR("B")="YES"
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
SET ENSORT=Y
+5 KILL IO("Q")
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+6 IF $DATA(IO("Q"))
SET ZTRTN="DQER^ENEQLT2"
Begin DoDot:1
+7 SET ZTDESC="'LOCKOUT REQUIRED?' Flag by Equipment Record"
+8 SET ZTLOAD("ENSORT")=""
+9 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
DQER NEW DATE,PAGE,LINE,CAT,ESCAPE,DA,X,T
SET (PAGE,CAT,ESCAPE,DA)=0
+1 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET DATE=$PIECE(Y,":")_":"_$PIECE(Y,":",2)
+2 USE IO
DO TABS
+3 IF '$DATA(^ENG(6914,"AJ",1))
DO HDRER
WRITE !,?5,"No Equipment Records have 'LOCKOUT REQUIRED?' Flag set to 'YES'."
DO HOLD
GOTO EXIT
+4 ;
+5 ; Sort by EQUIPMENT CATEGORY
+6 ;Design EXIT POINT
IF ENSORT
KILL ^TMP($JOB)
Begin DoDot:1
+7 FOR
SET DA=$ORDER(^ENG(6914,"AJ",1,DA))
if 'DA
QUIT
Begin DoDot:2
+8 SET CAT("I")=$PIECE($GET(^ENG(6914,DA,1)),U)
+9 IF CAT("I")'>0
SET CAT("E")=0
+10 IF '$TEST
SET CAT("E")=$PIECE($GET(^ENG(6911,CAT("I"),0)),U)
if CAT("E")=""
SET CAT("E")=0
+11 SET ^TMP($JOB,CAT("E"),DA)=""
End DoDot:2
+12 DO HDRER
FOR
SET CAT=$ORDER(^TMP($JOB,CAT))
if CAT=""!(ESCAPE)
QUIT
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,CAT,DA))
if 'DA!(ESCAPE)
QUIT
Begin DoDot:2
+13 DO PRTDAT
+14 IF LINE>(IOSL-4)
IF ($ORDER(^TMP($JOB,CAT,DA))!($ORDER(^TMP($JOB,CAT))))
DO HOLD
if ESCAPE
QUIT
DO HDRER
End DoDot:2
End DoDot:1
if 'ESCAPE
DO HOLD
GOTO EXIT
+15 ;
+16 ; No sort by EQUIPMENT CATEGORY
+17 DO HDRER
FOR
SET DA=$ORDER(^ENG(6914,"AJ",1,DA))
if 'DA!(ESCAPE)
QUIT
Begin DoDot:1
+18 DO PRTDAT
+19 IF LINE>(IOSL-4)
IF $ORDER(^ENG(6914,"AJ",1,DA))
DO HOLD
if ESCAPE
QUIT
DO HDRER
End DoDot:1
+20 if 'ESCAPE
DO HOLD
+21 ;Design EXIT POINT
GOTO EXIT
+22 ;
HDRER ; Header for Equipment Records
+1 if PAGE>0!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
SET PAGE=PAGE+1
SET LINE=5
SET $X=0
+2 WRITE "EQUIPMENT with 'LOCKOUT REQUIRED?' Flag 'SET' "_DATE,?(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-1))="-"
WRITE !,X,!
+6 QUIT
+7 ;
+8 ;======================================================================
+9 ;
PRTEX ; Print Equipment Records for which 'LOCKOUT REQUIRED?' Flag is CLEAR
+1 ; while their EQUIPMENT CATEGORY 'LOCKOUT REQUIRED?' Flag is SET
+2 KILL IO("Q")
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+3 IF $DATA(IO("Q"))
SET ZTRTN="DQEX^ENEQLT2"
Begin DoDot:1
+4 SET ZTDESC="'LOCKOUT REQUIRED?' Exception List"
+5 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
DQEX NEW DATE,PAGE,LINE,ESCAPE,CAT,DA,X,T
SET (PAGE,ESCAPE,CAT)=0
+1 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET DATE=$PIECE(Y,":")_":"_$PIECE(Y,":",2)
+2 USE IO
DO TABS
+3 IF '$DATA(^ENG(6911,"AC",1))
DO HDREX
WRITE !!,?10,"There are no EQUIPMENT CATEGORIES with",!,?10,"'LOCKOUT REQUIRED?' Flag SET."
DO HOLD
GOTO EXIT
+4 FOR
SET CAT=$ORDER(^ENG(6911,"AC",1,CAT))
if 'CAT
QUIT
SET DA=0
FOR
SET DA=$ORDER(^ENG(6914,"G",CAT,DA))
if 'DA
QUIT
IF '$DATA(^ENG(6914,"AJ",1,DA))
SET ^TMP($JOB,DA)=""
+5 IF '$DATA(^TMP($JOB))
DO HDREX
WRITE !!,?10,"There are no exceptions to report."
DO HOLD
GOTO EXIT
+6 DO HDREX
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,DA))
if 'DA!(ESCAPE)
QUIT
Begin DoDot:1
+7 DO PRTDAT
+8 IF LINE>(IOSL-4)
IF $ORDER(^TMP($JOB,DA))
DO HOLD
if ESCAPE
QUIT
DO HDREX
End DoDot:1
+9 if 'ESCAPE
DO HOLD
+10 ;Design EXIT POINT
GOTO EXIT
+11 ;
HDREX ; Header for 'LOCKOUT REQUIRED?' Exception List
+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 Exception List "_DATE,?(IOM-8),"Page ",PAGE
+3 WRITE !,"(Flag is CLEAR for these ENTRIES, but their EQUIPMENT CATEGORY Flag is SET)"
+4 WRITE !,"ENTRY #",?T(1),"Equipment Category",?T(2),"Manufacturer Equipment Name",?T(3),"Location"
+5 WRITE !,?T(11),"Manufacturer",?T(12),"Model",?T(13),"Serial Nummber"
+6 KILL X
SET $PIECE(X,"-",(IOM-1))="-"
WRITE !,X,!
+7 QUIT
+8 ;==================================================================
+9 ;
PRTDAT ; 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 ;
HOLD if $EXTRACT(IOST,1,2)'="C-"
QUIT
+1 WRITE !!,"Press <RETURN> to continue, '^' to escape..."
READ X:DTIME
+2 if $EXTRACT(X)="^"
SET ESCAPE=1
+3 QUIT
+4 ;
EXIT KILL ^TMP($JOB)
DO ^%ZISC
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ENSORT
+3 ;ENEQLT2
