- 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 Jan 18, 2025@02:58:34 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