ENY2KR ;(WASH ISC)/DH-Individual Y2K Close Out ;6.16.98
;;7.0;ENGINEERING;**51**;Aug 17, 1993
CO ; close out Y2K worklist
N DATE,COST,DIC,DIE,DA,DR,WODA,EQDA,ENX,ENY,ENY2K
W @IOF,!,"Closing a Y2K work order normally places the affected piece of equipment in",!,"a Y2K CATEGORY of 'FULLY COMPLIANT' and updates both the Work Order and"
W !,"Equipment files."
W !!,"In exceptional cases, this option may also be used to remove an item from",!,"the conditionally compliant list without actually closing its Y2K work"
W !,"order. If you enter a Y2K CATEGORY of 'NA' rather than 'FC' the system will",!,"automatically delete the Y2K work order. If you enter 'NC' the system will"
W !,"delete the work order and prompt you for Y2K ACTION."
W !!
;
CO1 ; get first Y2K work order
K ENX R !,"Please enter first Y2K work order to be closed: ",ENX:DTIME I ENX=""!(ENX="^")!('$T) G EXIT
D GETWO G:Y'>0 CO1
S (DA,WODA)=+Y,ENY2WO=$P(^ENG(6920,DA,0),U)
S EQDA=$P($G(^ENG(6920,DA,3)),U,8) I EQDA="" W !," This work order lacks an equipment pointer and is being deleted." D DEL G CO1
I '$D(^ENG(6914,EQDA,0)) W !," There is no equipment record for this work order. The work order",!,"is being deleted." D DEL G CO1
L +^ENG(6920,DA):1 I '$T W !,"Work order being edited by another user. Please try again later." G CO1
D CLSWO G:$D(DIRUT)!($D(DTOUT)) EXIT
;
CO2 S ENY2WO(1)=$O(^ENG(6920,"B",ENY2WO)) G:$E(ENY2WO(1),1,3)'="Y2-" EXIT I $P($G(^ENG(6920,ENY2WO(1),5)),U,2)]"" S ENY2WO=ENY2WO(1) G CO2
;
CO3 K ENX W !!,"Next Y2K work order (or sequential portion), '^' to quit: "_ENY2WO(1)_"// " R ENX:DTIME I $E(ENX)="^"!('$T) G EXIT
I ENX?1.N S:$L(ENX)<3 X=$S($L(ENX)=1:"00"_ENX,1:"0"_ENX) S ENX=$P(ENY2WO,"-",1,2)_"-"_ENX W !,?10," ("_ENX_")"
I ENX="" S ENX=ENY2WO(1)
D GETWO G:Y'>0 CO3
S (DA,WODA)=+Y,ENY2WO=$P(^ENG(6920,DA,0),U)
S EQDA=$P($G(^ENG(6920,DA,3)),U,8) I EQDA="" W !," This work order lacks an equipment pointer and is being deleted." D DEL G CO2
I '$D(^ENG(6914,EQDA,0)) W !," There is no equipment record for this work order. The work order",!,"is being deleted." D DEL G CO2
L +^ENG(6920,DA):1 I '$T W !,"Another user is editing this work order. Please try again later." G CO2
D CLSWO G:$D(DIRUT)!($D(DTOUT)) EXIT
G CO2
;
EXIT K ENSHABR,ENSHOP,EN1,ENLOC,ENY2WO
Q
;
HOLD I $E(IOST,1,2)="C-" R !,"<cr> to continue, '^' to quit...",X:DTIME
S ENY=1
Q
;
GETWO ; get a Y2K work order
; expects ENX and returns Y (from ^DIC)
S DIC="^ENG(6920,",DIC("S")="I $P(^(0),U)[""Y2-"",$P($G(^(5)),U,2)="""""
I $E(ENX,2)="." D I D]"" S X=$E(ENX,3,99),DIC(0)="QE" D IX^DIC Q
. S D=""
. I $E(ENX)="E" S D="G" Q ; equipment
. I $E(ENX)="L" S D="C" Q ; location
I $E(ENX)="?" D
. W !," You may use 'E.value' to list W.O.s whose EQUIPMENT ID# equals 'value', or"
. W !," 'L.value' to list W.O.s whose LOCATION starts with 'value'."
S X=ENX,DIC(0)="QEM" D ^DIC
Q
;
CLSWO ; disposition the Y2K work order
W !,"EQUIPMENT ID: "_EQDA_" "_$S($P(^ENG(6914,EQDA,0),U,2)]"":$E($P(^(0),U,2),1,20),1:$E($$GET1^DIQ(6914,EQDA,6),1,20))_" "_$E($$GET1^DIQ(6914,EQDA,1),1,20)_" "_$E($$GET1^DIQ(6914,EQDA,4),1,15)
K DIR S DIR(0)="6914,71",DIR("B")="FULLY COMPLIANT"
D ^DIR K DIR Q:$D(DIRUT)
S ENY2K("CAT")=Y I ENY2K("CAT")="CC" W !!,"Data base unchanged." Q
I ENY2K("CAT")'="FC" D Q
. D DEL
. S DIE="^ENG(6914,",DA=EQDA,DR="71///^S X=ENY2K(""CAT"");72///^S X=""@"";72.1///^S X=""@"";73///^S X=""@"";74///^S X=""@"";75///^S X=""@"";77///^S X=""@""" D ^DIE
. I ENY2K("CAT")="NC" S DR=76 D ^DIE
S DR=$S($D(^DIE("B","ENZY2CLOSE")):"[ENZY2CLOSE]",1:"[ENY2CLOSE]")
S DIE="^ENG(6920," D ^DIE I $D(Y) L -^ENG(6920,DA) Q
I $P($G(^ENG(6920,DA,5)),U,2)]"",$E(^ENG(6920,DA,0),1,3)="Y2-" D S DA=WODA
. S DATE=$P(^ENG(6920,DA,5),U,2),COST=$P(^(5),U,6)+$P(^(5),U,4)+$P($G(^(4)),U,4)
. S DA=EQDA,DIE="^ENG(6914,",DR="71///^S X=""FC"";72.1///^S X=DATE;74///^S X=COST" D ^DIE
L -^ENG(6920,DA)
Q
;
DEL ; delete work orders without valid equipment pointers and work orders
; which should not be closed ('NC' and 'NA')
I $G(EQDA),$D(^ENG(6914,EQDA,0)) S $P(^ENG(6914,EQDA,11),U,8)=""
S DIK="^ENG(6920," D ^DIK K DIK
Q
;ENY2KR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2KR 4224 printed Nov 22, 2024@17:07:31 Page 2
ENY2KR ;(WASH ISC)/DH-Individual Y2K Close Out ;6.16.98
+1 ;;7.0;ENGINEERING;**51**;Aug 17, 1993
CO ; close out Y2K worklist
+1 NEW DATE,COST,DIC,DIE,DA,DR,WODA,EQDA,ENX,ENY,ENY2K
+2 WRITE @IOF,!,"Closing a Y2K work order normally places the affected piece of equipment in",!,"a Y2K CATEGORY of 'FULLY COMPLIANT' and updates both the Work Order and"
+3 WRITE !,"Equipment files."
+4 WRITE !!,"In exceptional cases, this option may also be used to remove an item from",!,"the conditionally compliant list without actually closing its Y2K work"
+5 WRITE !,"order. If you enter a Y2K CATEGORY of 'NA' rather than 'FC' the system will",!,"automatically delete the Y2K work order. If you enter 'NC' the system will"
+6 WRITE !,"delete the work order and prompt you for Y2K ACTION."
+7 WRITE !!
+8 ;
CO1 ; get first Y2K work order
+1 KILL ENX
READ !,"Please enter first Y2K work order to be closed: ",ENX:DTIME
IF ENX=""!(ENX="^")!('$TEST)
GOTO EXIT
+2 DO GETWO
if Y'>0
GOTO CO1
+3 SET (DA,WODA)=+Y
SET ENY2WO=$PIECE(^ENG(6920,DA,0),U)
+4 SET EQDA=$PIECE($GET(^ENG(6920,DA,3)),U,8)
IF EQDA=""
WRITE !," This work order lacks an equipment pointer and is being deleted."
DO DEL
GOTO CO1
+5 IF '$DATA(^ENG(6914,EQDA,0))
WRITE !," There is no equipment record for this work order. The work order",!,"is being deleted."
DO DEL
GOTO CO1
+6 LOCK +^ENG(6920,DA):1
IF '$TEST
WRITE !,"Work order being edited by another user. Please try again later."
GOTO CO1
+7 DO CLSWO
if $DATA(DIRUT)!($DATA(DTOUT))
GOTO EXIT
+8 ;
CO2 SET ENY2WO(1)=$ORDER(^ENG(6920,"B",ENY2WO))
if $EXTRACT(ENY2WO(1),1,3)'="Y2-"
GOTO EXIT
IF $PIECE($GET(^ENG(6920,ENY2WO(1),5)),U,2)]""
SET ENY2WO=ENY2WO(1)
GOTO CO2
+1 ;
CO3 KILL ENX
WRITE !!,"Next Y2K work order (or sequential portion), '^' to quit: "_ENY2WO(1)_"// "
READ ENX:DTIME
IF $EXTRACT(ENX)="^"!('$TEST)
GOTO EXIT
+1 IF ENX?1.N
if $LENGTH(ENX)<3
SET X=$SELECT($LENGTH(ENX)=1:"00"_ENX,1:"0"_ENX)
SET ENX=$PIECE(ENY2WO,"-",1,2)_"-"_ENX
WRITE !,?10," ("_ENX_")"
+2 IF ENX=""
SET ENX=ENY2WO(1)
+3 DO GETWO
if Y'>0
GOTO CO3
+4 SET (DA,WODA)=+Y
SET ENY2WO=$PIECE(^ENG(6920,DA,0),U)
+5 SET EQDA=$PIECE($GET(^ENG(6920,DA,3)),U,8)
IF EQDA=""
WRITE !," This work order lacks an equipment pointer and is being deleted."
DO DEL
GOTO CO2
+6 IF '$DATA(^ENG(6914,EQDA,0))
WRITE !," There is no equipment record for this work order. The work order",!,"is being deleted."
DO DEL
GOTO CO2
+7 LOCK +^ENG(6920,DA):1
IF '$TEST
WRITE !,"Another user is editing this work order. Please try again later."
GOTO CO2
+8 DO CLSWO
if $DATA(DIRUT)!($DATA(DTOUT))
GOTO EXIT
+9 GOTO CO2
+10 ;
EXIT KILL ENSHABR,ENSHOP,EN1,ENLOC,ENY2WO
+1 QUIT
+2 ;
HOLD IF $EXTRACT(IOST,1,2)="C-"
READ !,"<cr> to continue, '^' to quit...",X:DTIME
+1 SET ENY=1
+2 QUIT
+3 ;
GETWO ; get a Y2K work order
+1 ; expects ENX and returns Y (from ^DIC)
+2 SET DIC="^ENG(6920,"
SET DIC("S")="I $P(^(0),U)[""Y2-"",$P($G(^(5)),U,2)="""""
+3 IF $EXTRACT(ENX,2)="."
Begin DoDot:1
+4 SET D=""
+5 ; equipment
IF $EXTRACT(ENX)="E"
SET D="G"
QUIT
+6 ; location
IF $EXTRACT(ENX)="L"
SET D="C"
QUIT
End DoDot:1
IF D]""
SET X=$EXTRACT(ENX,3,99)
SET DIC(0)="QE"
DO IX^DIC
QUIT
+7 IF $EXTRACT(ENX)="?"
Begin DoDot:1
+8 WRITE !," You may use 'E.value' to list W.O.s whose EQUIPMENT ID# equals 'value', or"
+9 WRITE !," 'L.value' to list W.O.s whose LOCATION starts with 'value'."
End DoDot:1
+10 SET X=ENX
SET DIC(0)="QEM"
DO ^DIC
+11 QUIT
+12 ;
CLSWO ; disposition the Y2K work order
+1 WRITE !,"EQUIPMENT ID: "_EQDA_" "_$SELECT($PIECE(^ENG(6914,EQDA,0),U,2)]"":$EXTRACT($PIECE(^(0),U,2),1,20),1:$EXTRACT($$GET1^DIQ(6914,EQDA,6),1,20))_" "_$EXTRACT($$GET1^DIQ(6914,EQDA,1),1,20)_" "_$EXTRACT($$GET1^DIQ(6914,EQDA,4),1,15)
+2 KILL DIR
SET DIR(0)="6914,71"
SET DIR("B")="FULLY COMPLIANT"
+3 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+4 SET ENY2K("CAT")=Y
IF ENY2K("CAT")="CC"
WRITE !!,"Data base unchanged."
QUIT
+5 IF ENY2K("CAT")'="FC"
Begin DoDot:1
+6 DO DEL
+7 SET DIE="^ENG(6914,"
SET DA=EQDA
SET DR="71///^S X=ENY2K(""CAT"");72///^S X=""@"";72.1///^S X=""@"";73///^S X=""@"";74///^S X=""@"";75///^S X=""@"";77///^S X=""@"""
DO ^DIE
+8 IF ENY2K("CAT")="NC"
SET DR=76
DO ^DIE
End DoDot:1
QUIT
+9 SET DR=$SELECT($DATA(^DIE("B","ENZY2CLOSE")):"[ENZY2CLOSE]",1:"[ENY2CLOSE]")
+10 SET DIE="^ENG(6920,"
DO ^DIE
IF $DATA(Y)
LOCK -^ENG(6920,DA)
QUIT
+11 IF $PIECE($GET(^ENG(6920,DA,5)),U,2)]""
IF $EXTRACT(^ENG(6920,DA,0),1,3)="Y2-"
Begin DoDot:1
+12 SET DATE=$PIECE(^ENG(6920,DA,5),U,2)
SET COST=$PIECE(^(5),U,6)+$PIECE(^(5),U,4)+$PIECE($GET(^(4)),U,4)
+13 SET DA=EQDA
SET DIE="^ENG(6914,"
SET DR="71///^S X=""FC"";72.1///^S X=DATE;74///^S X=COST"
DO ^DIE
End DoDot:1
SET DA=WODA
+14 LOCK -^ENG(6920,DA)
+15 QUIT
+16 ;
DEL ; delete work orders without valid equipment pointers and work orders
+1 ; which should not be closed ('NC' and 'NA')
+2 IF $GET(EQDA)
IF $DATA(^ENG(6914,EQDA,0))
SET $PIECE(^ENG(6914,EQDA,11),U,8)=""
+3 SET DIK="^ENG(6920,"
DO ^DIK
KILL DIK
+4 QUIT
+5 ;ENY2KR
