- 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 Feb 18, 2025@23:23:35 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