ENY2K ;;(WIRMFO)/DH-Equipment Y2K Management ;5.18.98
;;7.0;ENGINEERING;**51**;August 17, 1993
;
; This module identifies individual pieces of equipment that may fail
; to operate properly as of January 1, 2000.
; It also provides a means (the Y2K worklist) of tracking the
; necessary corrective actions.
;
IND ; data entry for manually selected equipment list
K ^TMP($J)
N DIC,ENY2K,ESCAPE,COUNT
S COUNT=0
W !!,"First we'll get answers for the Y2K questions, then we'll ask for an",!,"equipment list.",!
D DATA^ENY2K1
G:$G(ESCAPE) EXIT
F J="PRE","FC","NC","CC","NA" S COUNT(J)=0
S DIC="^ENG(6914,",DIC(0)="AEQM"
F D GETEQ^ENUTL Q:Y'>0 D:$D(^ENG(6914,+Y,0))
. Q:$D(^TMP($J,+Y))
. I "^4^5^"[(U_$P($G(^ENG(6914,+Y,3)),U)_U) W !,?5,"Sorry, but "_+Y_" is not an active equipment record." Q
. S X=$P($G(^ENG(6914,+Y,11)),U) I X]"" S COUNT("PRE")=COUNT("PRE")+1,COUNT(X)=COUNT(X)+1,^TMP($J,X,+Y)=""
. S ^TMP($J,+Y)="",COUNT=COUNT+1
D:$D(^TMP($J))
. W !!,"You have selected "_COUNT_" equipment records for updating."
. W !,"Do you wish to proceed?"
. S DIR(0)="Y",DIR("B")="YES"
. D ^DIR K DIR Q:$D(DIRUT)!('Y)
. D:COUNT("PRE") OVERWRT^ENY2K8
. D:'$G(ESCAPE) UPDATE^ENY2K1
G EXIT
;
CAT ; data entry by EQUIPMENT CATEGORY
N CAT,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE
F D CAT1 D Q:$G(ESCAPE)
. I $G(ESCAPE),$G(CAT)]"" L -^ENG("CAT",CAT)
. Q:$G(ESCAPE)
. D:$G(ENY2K("CONT")) DATA^ENY2K1
. I $G(ESCAPE) L -^ENG("CAT",CAT) Q
. D UPDATE^ENY2K1
. L -^ENG("CAT",CAT) S CAT="",CAT(0)=""
G EXIT
;
CAT1 K ^TMP($J) W !
S DIC="^ENG(6911,",DIC(0)="AEMQ" D ^DIC I Y'>0 S ESCAPE=1 Q
S CAT=$P(Y,U,2),CAT(0)=$P(Y,U)
L +^ENG("CAT",CAT):1 I '$T W !,"Another user is editing this equipment category. Can't proceed." S CAT="",CAT(0)="" G CAT1
F J="PRE","FC","NC","CC","NA" S COUNT(J)=0
S (DA,COUNT)=0 F S DA=$O(^ENG(6914,"G",CAT(0),DA)) Q:'DA D
. I $D(^ENG(6914,DA,0)),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)="",X=$P($G(^ENG(6914,DA,11)),U) I X]"" S COUNT("PRE")=COUNT("PRE")+1,COUNT(X)=COUNT(X)+1,^TMP($J,X,DA)=""
I 'COUNT W !!,"There are no active equipment records in the EQUIPMENT CATEGORY of",!,CAT_"." L -^ENG("CAT",CAT) S CAT="",CAT(0)="" G CAT1
W !!,"There are "_COUNT_" active equipment records in the "_CAT,!,"EQUIPMENT CATEGORY. Do you wish to proceed?"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
S ENY2K("CONT")=Y I 'ENY2K("CONT") L -^ENG("CAT",CAT) S CAT="",CAT(0)="" G CAT1
I COUNT("PRE"),'$D(CRITER) D OVERWRT^ENY2K8
Q
;
CSN ; data entry by CATEGORY STOCK NUMBER
N CSN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE
F D CSN1 D Q:$G(ESCAPE)
. I $G(ESCAPE),$G(CSN)]"" L -^ENG("CSN",CSN)
. Q:$G(ESCAPE)
. D:$G(ENY2K("CONT")) DATA^ENY2K1
. I $G(ESCAPE) L -^ENG("CSN",CSN) Q
. D UPDATE^ENY2K1
. L -^ENG("CSN",CSN) S CSN="",CSN(0)=""
G EXIT
;
CSN1 K ^TMP($J) W !
S DIC="^ENCSN(6917,",DIC(0)="AEQM" D ^DIC I Y'>0 S ESCAPE=1 Q
S CSN=$P(Y,U,2),CSN(0)=$P(Y,U)
L +^ENG("CSN",CSN):1 I '$T W !,"Another user is editing this CATEGORY STOCK NUMBER. Can't proceed." S CSN="",CSN(0)="" G CSN1
F J="PRE","FC","NC","CC","NA" S COUNT(J)=0
S (DA,COUNT)=0 F S DA=$O(^ENG(6914,"J",CSN(0),DA)) Q:'DA D
. I $D(^ENG(6914,DA,0)),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)="",X=$P($G(^ENG(6914,DA,11)),U) I X]"" S COUNT("PRE")=COUNT("PRE")+1,COUNT(X)=COUNT(X)+1,^TMP($J,X,DA)=""
I 'COUNT W !!,"There are no active equipment records whose CATEGORY STOCK NUMBER is",!,CSN_"." S CSN="",CSN(0)="" G CSN1
W !!,"There are "_COUNT_" active equipment records whose CATEGORY STOCK ",!,"NUMBER is "_CSN_". Do you wish to proceed?"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
S ENY2K("CONT")=Y I 'ENY2K("CONT") L -^ENG("CSN",CSN) S CSN="",CSN(0)="" G CSN1
I COUNT("PRE"),'$D(CRITER) D OVERWRT^ENY2K8
Q
;
MFG ; data entry by MANUFACTURER (all models)
N MFG,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE
F D MFG1 D Q:$G(ESCAPE)
. I $G(ESCAPE),$G(MFG)]"" L -^ENG("MFG",MFG)
. Q:$G(ESCAPE)
. D:$G(ENY2K("CONT")) DATA^ENY2K1
. I $G(ESCAPE) L -^ENG("MFG",MFG) Q
. D UPDATE^ENY2K1
. L -^ENG("MFG",MFG) S MFG="",MFG(0)=""
G EXIT
;
MFG1 K ^TMP($J)
S DIC="^ENG(""MFG"",",DIC(0)="AEMQ" D ^DIC I Y'>0 S ESCAPE=1 Q
S MFG=$P(Y,U,2),MFG(0)=$P(Y,U)
L +^ENG("MFG",MFG):1 I '$T W !,"Another user is editing this MANUFACTURER. Can't proceed." S MFG="",MFG(0)="" G MFG1
F J="PRE","FC","NC","CC","NA" S COUNT(J)=0
S (DA,COUNT)=0 F S DA=$O(^ENG(6914,"K",MFG(0),DA)) Q:'DA D
. I $D(^ENG(6914,DA,0)),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)="",X=$P($G(^ENG(6914,DA,11)),U) I X]"" S COUNT("PRE")=COUNT("PRE")+1,COUNT(X)=COUNT(X)+1,^TMP($J,X,DA)=""
I 'COUNT W !!,"There are no active equipment entries manufactured by "_MFG_"." L -^ENG("MFG",MFG) S MFG="",MFG(0)="" G MFG1
W !!,"There are "_COUNT_" equipment entries that were manufactured by",!,MFG_". Do you wish to proceed?"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
S ENY2K("CONT")=Y I 'ENY2K("CONT") L -^ENG("MFG",MFG) S MFG="",MFG(0)="" G MFG1
I COUNT("PRE"),'$D(CRITER) D OVERWRT^ENY2K8
Q
;
LOC ; data entry by LOCAL ID
N LOC,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,PAGE,DATE
F D LOC1^ENY2K9 D Q:$G(ESCAPE)
. I $G(ESCAPE),$G(LOC)]"" L -^ENG("LOC",LOC)
. Q:$G(ESCAPE)
. D:$G(ENY2K("CONT")) DATA^ENY2K1
. I $G(ESCAPE) L -^ENG("LOC",LOC) Q
. D UPDATE^ENY2K1
. L -^ENG("LOC",LOC) S LOC="",LOC(0)="",END=""
G EXIT
;
MOD ; data entry by MANUFACTURER and MODEL
N MFG,MOD,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,ENDX
F D MOD1 D Q:$G(ESCAPE)
. I $G(ESCAPE),$G(MFG)]"" L -^ENG("MFG","MOD",MFG,MOD)
. Q:$G(ESCAPE)
. D:$G(ENY2K("CONT")) DATA^ENY2K1
. I $G(ESCAPE) L -^ENG("MFG","MOD",MFG,MOD)
. D UPDATE^ENY2K1
. L -^ENG("MFG","MOD",MFG,MOD) S (MFG,MOD)="",MFG(0)=""
G EXIT
;
MOD1 K ^TMP($J) W !
S DIC="^ENG(""MFG"",",DIC(0)="AEQM" D ^DIC I Y'>0 S ESCAPE=1 Q
S MFG=$P(Y,U,2),MFG(0)=$P(Y,U)
I '$O(^ENG(6914,"K",MFG(0),0)) W !!,"There are no active equipment records for devices made by",!,MFG_"." S MFG="",MFG(0)="" G MOD1
MOD2 R !,"Please enter the MODEL (as recorded in Equipment File): ",X:DTIME I '$T!($E(X)="^")!(X="") S ESCAPE=1,MFG="",MFG(0)="" Q
I $E(X)="?" W !,"Enter a valid MODEL number (ex: "_$O(^ENG(6914,"E","M"))_")." G MOD2
I '$D(^ENG(6914,"E",X)) D I X="" W "??",*7 G MOD2
. S DIC="^ENG(6914,",ENDX="E"
. D IX^ENLIB1
S MOD=X
L +^ENG("MFG","MOD",MFG,MOD):1 I '$T W !,"Another user is editing this MANUFACTURER~MODEL. Can't proceed." S (MFG,MOD)="",MFG(0)="" G MOD1
F J="PRE","FC","NC","CC","NA" S COUNT(J)=0
S (DA,COUNT)=0 F S DA=$O(^ENG(6914,"E",MOD,DA)) Q:'DA D
. I $D(^ENG(6914,DA,0)),$P($G(^(1)),U,4)=MFG(0),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)="",X=$P($G(^ENG(6914,DA,11)),U) I X]"" S COUNT("PRE")=COUNT("PRE")+1,COUNT(X)=COUNT(X)+1,^TMP($J,X,DA)=""
I 'COUNT W !!,"There are no active equipment records for which MANUFACTURER and MODEL are",!,MFG_" and "_MOD_", respectively." L -^ENG("MFG","MOD",MFG,MOD) S (MFG,MOD)="",MFG(0)="" G MOD1
W !!,"There are "_COUNT_" active equipment records that meet your search criteria.",!,"Do you wish to proceed?"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
S ENY2K("CONT")=Y I 'ENY2K("CONT") L -^ENG("MFG","MOD",MFG,MOD) S (MFG,MOD)="",MFG(0)="" G MOD1
I COUNT("PRE"),'$D(CRITER) D OVERWRT^ENY2K8
Q
;
EXIT K ^TMP($J)
Q
;ENY2K
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2K 7489 printed Apr 09, 2024@20:56:43 Page 2
ENY2K ;;(WIRMFO)/DH-Equipment Y2K Management ;5.18.98
+1 ;;7.0;ENGINEERING;**51**;August 17, 1993
+2 ;
+3 ; This module identifies individual pieces of equipment that may fail
+4 ; to operate properly as of January 1, 2000.
+5 ; It also provides a means (the Y2K worklist) of tracking the
+6 ; necessary corrective actions.
+7 ;
IND ; data entry for manually selected equipment list
+1 KILL ^TMP($JOB)
+2 NEW DIC,ENY2K,ESCAPE,COUNT
+3 SET COUNT=0
+4 WRITE !!,"First we'll get answers for the Y2K questions, then we'll ask for an",!,"equipment list.",!
+5 DO DATA^ENY2K1
+6 if $GET(ESCAPE)
GOTO EXIT
+7 FOR J="PRE","FC","NC","CC","NA"
SET COUNT(J)=0
+8 SET DIC="^ENG(6914,"
SET DIC(0)="AEQM"
+9 FOR
DO GETEQ^ENUTL
if Y'>0
QUIT
if $DATA(^ENG(6914,+Y,0))
Begin DoDot:1
+10 if $DATA(^TMP($JOB,+Y))
QUIT
+11 IF "^4^5^"[(U_$PIECE($GET(^ENG(6914,+Y,3)),U)_U)
WRITE !,?5,"Sorry, but "_+Y_" is not an active equipment record."
QUIT
+12 SET X=$PIECE($GET(^ENG(6914,+Y,11)),U)
IF X]""
SET COUNT("PRE")=COUNT("PRE")+1
SET COUNT(X)=COUNT(X)+1
SET ^TMP($JOB,X,+Y)=""
+13 SET ^TMP($JOB,+Y)=""
SET COUNT=COUNT+1
End DoDot:1
+14 if $DATA(^TMP($JOB))
Begin DoDot:1
+15 WRITE !!,"You have selected "_COUNT_" equipment records for updating."
+16 WRITE !,"Do you wish to proceed?"
+17 SET DIR(0)="Y"
SET DIR("B")="YES"
+18 DO ^DIR
KILL DIR
if $DATA(DIRUT)!('Y)
QUIT
+19 if COUNT("PRE")
DO OVERWRT^ENY2K8
+20 if '$GET(ESCAPE)
DO UPDATE^ENY2K1
End DoDot:1
+21 GOTO EXIT
+22 ;
CAT ; data entry by EQUIPMENT CATEGORY
+1 NEW CAT,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE
+2 FOR
DO CAT1
Begin DoDot:1
+3 IF $GET(ESCAPE)
IF $GET(CAT)]""
LOCK -^ENG("CAT",CAT)
+4 if $GET(ESCAPE)
QUIT
+5 if $GET(ENY2K("CONT"))
DO DATA^ENY2K1
+6 IF $GET(ESCAPE)
LOCK -^ENG("CAT",CAT)
QUIT
+7 DO UPDATE^ENY2K1
+8 LOCK -^ENG("CAT",CAT)
SET CAT=""
SET CAT(0)=""
End DoDot:1
if $GET(ESCAPE)
QUIT
+9 GOTO EXIT
+10 ;
CAT1 KILL ^TMP($JOB)
WRITE !
+1 SET DIC="^ENG(6911,"
SET DIC(0)="AEMQ"
DO ^DIC
IF Y'>0
SET ESCAPE=1
QUIT
+2 SET CAT=$PIECE(Y,U,2)
SET CAT(0)=$PIECE(Y,U)
+3 LOCK +^ENG("CAT",CAT):1
IF '$TEST
WRITE !,"Another user is editing this equipment category. Can't proceed."
SET CAT=""
SET CAT(0)=""
GOTO CAT1
+4 FOR J="PRE","FC","NC","CC","NA"
SET COUNT(J)=0
+5 SET (DA,COUNT)=0
FOR
SET DA=$ORDER(^ENG(6914,"G",CAT(0),DA))
if 'DA
QUIT
Begin DoDot:1
+6 IF $DATA(^ENG(6914,DA,0))
IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
SET COUNT=COUNT+1
SET ^TMP($JOB,DA)=""
SET X=$PIECE($GET(^ENG(6914,DA,11)),U)
IF X]""
SET COUNT("PRE")=COUNT("PRE")+1
SET COUNT(X)=COUNT(X)+1
SET ^TMP($JOB,X,DA)=""
End DoDot:1
+7 IF 'COUNT
WRITE !!,"There are no active equipment records in the EQUIPMENT CATEGORY of",!,CAT_"."
LOCK -^ENG("CAT",CAT)
SET CAT=""
SET CAT(0)=""
GOTO CAT1
+8 WRITE !!,"There are "_COUNT_" active equipment records in the "_CAT,!,"EQUIPMENT CATEGORY. Do you wish to proceed?"
+9 SET DIR(0)="Y"
SET DIR("B")="YES"
+10 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+11 SET ENY2K("CONT")=Y
IF 'ENY2K("CONT")
LOCK -^ENG("CAT",CAT)
SET CAT=""
SET CAT(0)=""
GOTO CAT1
+12 IF COUNT("PRE")
IF '$DATA(CRITER)
DO OVERWRT^ENY2K8
+13 QUIT
+14 ;
CSN ; data entry by CATEGORY STOCK NUMBER
+1 NEW CSN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE
+2 FOR
DO CSN1
Begin DoDot:1
+3 IF $GET(ESCAPE)
IF $GET(CSN)]""
LOCK -^ENG("CSN",CSN)
+4 if $GET(ESCAPE)
QUIT
+5 if $GET(ENY2K("CONT"))
DO DATA^ENY2K1
+6 IF $GET(ESCAPE)
LOCK -^ENG("CSN",CSN)
QUIT
+7 DO UPDATE^ENY2K1
+8 LOCK -^ENG("CSN",CSN)
SET CSN=""
SET CSN(0)=""
End DoDot:1
if $GET(ESCAPE)
QUIT
+9 GOTO EXIT
+10 ;
CSN1 KILL ^TMP($JOB)
WRITE !
+1 SET DIC="^ENCSN(6917,"
SET DIC(0)="AEQM"
DO ^DIC
IF Y'>0
SET ESCAPE=1
QUIT
+2 SET CSN=$PIECE(Y,U,2)
SET CSN(0)=$PIECE(Y,U)
+3 LOCK +^ENG("CSN",CSN):1
IF '$TEST
WRITE !,"Another user is editing this CATEGORY STOCK NUMBER. Can't proceed."
SET CSN=""
SET CSN(0)=""
GOTO CSN1
+4 FOR J="PRE","FC","NC","CC","NA"
SET COUNT(J)=0
+5 SET (DA,COUNT)=0
FOR
SET DA=$ORDER(^ENG(6914,"J",CSN(0),DA))
if 'DA
QUIT
Begin DoDot:1
+6 IF $DATA(^ENG(6914,DA,0))
IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
SET COUNT=COUNT+1
SET ^TMP($JOB,DA)=""
SET X=$PIECE($GET(^ENG(6914,DA,11)),U)
IF X]""
SET COUNT("PRE")=COUNT("PRE")+1
SET COUNT(X)=COUNT(X)+1
SET ^TMP($JOB,X,DA)=""
End DoDot:1
+7 IF 'COUNT
WRITE !!,"There are no active equipment records whose CATEGORY STOCK NUMBER is",!,CSN_"."
SET CSN=""
SET CSN(0)=""
GOTO CSN1
+8 WRITE !!,"There are "_COUNT_" active equipment records whose CATEGORY STOCK ",!,"NUMBER is "_CSN_". Do you wish to proceed?"
+9 SET DIR(0)="Y"
SET DIR("B")="YES"
+10 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+11 SET ENY2K("CONT")=Y
IF 'ENY2K("CONT")
LOCK -^ENG("CSN",CSN)
SET CSN=""
SET CSN(0)=""
GOTO CSN1
+12 IF COUNT("PRE")
IF '$DATA(CRITER)
DO OVERWRT^ENY2K8
+13 QUIT
+14 ;
MFG ; data entry by MANUFACTURER (all models)
+1 NEW MFG,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE
+2 FOR
DO MFG1
Begin DoDot:1
+3 IF $GET(ESCAPE)
IF $GET(MFG)]""
LOCK -^ENG("MFG",MFG)
+4 if $GET(ESCAPE)
QUIT
+5 if $GET(ENY2K("CONT"))
DO DATA^ENY2K1
+6 IF $GET(ESCAPE)
LOCK -^ENG("MFG",MFG)
QUIT
+7 DO UPDATE^ENY2K1
+8 LOCK -^ENG("MFG",MFG)
SET MFG=""
SET MFG(0)=""
End DoDot:1
if $GET(ESCAPE)
QUIT
+9 GOTO EXIT
+10 ;
MFG1 KILL ^TMP($JOB)
+1 SET DIC="^ENG(""MFG"","
SET DIC(0)="AEMQ"
DO ^DIC
IF Y'>0
SET ESCAPE=1
QUIT
+2 SET MFG=$PIECE(Y,U,2)
SET MFG(0)=$PIECE(Y,U)
+3 LOCK +^ENG("MFG",MFG):1
IF '$TEST
WRITE !,"Another user is editing this MANUFACTURER. Can't proceed."
SET MFG=""
SET MFG(0)=""
GOTO MFG1
+4 FOR J="PRE","FC","NC","CC","NA"
SET COUNT(J)=0
+5 SET (DA,COUNT)=0
FOR
SET DA=$ORDER(^ENG(6914,"K",MFG(0),DA))
if 'DA
QUIT
Begin DoDot:1
+6 IF $DATA(^ENG(6914,DA,0))
IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
SET COUNT=COUNT+1
SET ^TMP($JOB,DA)=""
SET X=$PIECE($GET(^ENG(6914,DA,11)),U)
IF X]""
SET COUNT("PRE")=COUNT("PRE")+1
SET COUNT(X)=COUNT(X)+1
SET ^TMP($JOB,X,DA)=""
End DoDot:1
+7 IF 'COUNT
WRITE !!,"There are no active equipment entries manufactured by "_MFG_"."
LOCK -^ENG("MFG",MFG)
SET MFG=""
SET MFG(0)=""
GOTO MFG1
+8 WRITE !!,"There are "_COUNT_" equipment entries that were manufactured by",!,MFG_". Do you wish to proceed?"
+9 SET DIR(0)="Y"
SET DIR("B")="YES"
+10 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+11 SET ENY2K("CONT")=Y
IF 'ENY2K("CONT")
LOCK -^ENG("MFG",MFG)
SET MFG=""
SET MFG(0)=""
GOTO MFG1
+12 IF COUNT("PRE")
IF '$DATA(CRITER)
DO OVERWRT^ENY2K8
+13 QUIT
+14 ;
LOC ; data entry by LOCAL ID
+1 NEW LOC,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,PAGE,DATE
+2 FOR
DO LOC1^ENY2K9
Begin DoDot:1
+3 IF $GET(ESCAPE)
IF $GET(LOC)]""
LOCK -^ENG("LOC",LOC)
+4 if $GET(ESCAPE)
QUIT
+5 if $GET(ENY2K("CONT"))
DO DATA^ENY2K1
+6 IF $GET(ESCAPE)
LOCK -^ENG("LOC",LOC)
QUIT
+7 DO UPDATE^ENY2K1
+8 LOCK -^ENG("LOC",LOC)
SET LOC=""
SET LOC(0)=""
SET END=""
End DoDot:1
if $GET(ESCAPE)
QUIT
+9 GOTO EXIT
+10 ;
MOD ; data entry by MANUFACTURER and MODEL
+1 NEW MFG,MOD,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,ENDX
+2 FOR
DO MOD1
Begin DoDot:1
+3 IF $GET(ESCAPE)
IF $GET(MFG)]""
LOCK -^ENG("MFG","MOD",MFG,MOD)
+4 if $GET(ESCAPE)
QUIT
+5 if $GET(ENY2K("CONT"))
DO DATA^ENY2K1
+6 IF $GET(ESCAPE)
LOCK -^ENG("MFG","MOD",MFG,MOD)
+7 DO UPDATE^ENY2K1
+8 LOCK -^ENG("MFG","MOD",MFG,MOD)
SET (MFG,MOD)=""
SET MFG(0)=""
End DoDot:1
if $GET(ESCAPE)
QUIT
+9 GOTO EXIT
+10 ;
MOD1 KILL ^TMP($JOB)
WRITE !
+1 SET DIC="^ENG(""MFG"","
SET DIC(0)="AEQM"
DO ^DIC
IF Y'>0
SET ESCAPE=1
QUIT
+2 SET MFG=$PIECE(Y,U,2)
SET MFG(0)=$PIECE(Y,U)
+3 IF '$ORDER(^ENG(6914,"K",MFG(0),0))
WRITE !!,"There are no active equipment records for devices made by",!,MFG_"."
SET MFG=""
SET MFG(0)=""
GOTO MOD1
MOD2 READ !,"Please enter the MODEL (as recorded in Equipment File): ",X:DTIME
IF '$TEST!($EXTRACT(X)="^")!(X="")
SET ESCAPE=1
SET MFG=""
SET MFG(0)=""
QUIT
+1 IF $EXTRACT(X)="?"
WRITE !,"Enter a valid MODEL number (ex: "_$ORDER(^ENG(6914,"E","M"))_")."
GOTO MOD2
+2 IF '$DATA(^ENG(6914,"E",X))
Begin DoDot:1
+3 SET DIC="^ENG(6914,"
SET ENDX="E"
+4 DO IX^ENLIB1
End DoDot:1
IF X=""
WRITE "??",*7
GOTO MOD2
+5 SET MOD=X
+6 LOCK +^ENG("MFG","MOD",MFG,MOD):1
IF '$TEST
WRITE !,"Another user is editing this MANUFACTURER~MODEL. Can't proceed."
SET (MFG,MOD)=""
SET MFG(0)=""
GOTO MOD1
+7 FOR J="PRE","FC","NC","CC","NA"
SET COUNT(J)=0
+8 SET (DA,COUNT)=0
FOR
SET DA=$ORDER(^ENG(6914,"E",MOD,DA))
if 'DA
QUIT
Begin DoDot:1
+9 IF $DATA(^ENG(6914,DA,0))
IF $PIECE($GET(^(1)),U,4)=MFG(0)
IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
SET COUNT=COUNT+1
SET ^TMP($JOB,DA)=""
SET X=$PIECE($GET(^ENG(6914,DA,11)),U)
IF X]""
SET COUNT("PRE")=COUNT("PRE")+1
SET COUNT(X)=COUNT(X)+1
SET ^TMP($JOB,X,DA)=""
End DoDot:1
+10 IF 'COUNT
WRITE !!,"There are no active equipment records for which MANUFACTURER and MODEL are",!,MFG_" and "_MOD_", respectively."
LOCK -^ENG("MFG","MOD",MFG,MOD)
SET (MFG,MOD)=""
SET MFG(0)=""
GOTO MOD1
+11 WRITE !!,"There are "_COUNT_" active equipment records that meet your search criteria.",!,"Do you wish to proceed?"
+12 SET DIR(0)="Y"
SET DIR("B")="YES"
+13 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+14 SET ENY2K("CONT")=Y
IF 'ENY2K("CONT")
LOCK -^ENG("MFG","MOD",MFG,MOD)
SET (MFG,MOD)=""
SET MFG(0)=""
GOTO MOD1
+15 IF COUNT("PRE")
IF '$DATA(CRITER)
DO OVERWRT^ENY2K8
+16 QUIT
+17 ;
EXIT KILL ^TMP($JOB)
+1 QUIT
+2 ;ENY2K
