ENY2KA ;;(WIRMFO)/DH-Equipment Y2K Management ;5.12.98
;;7.0;ENGINEERING;**51**;August 17, 1993
; extension of ENY2K
;
MEN ; data entry by MANUFACTURER EQUIPMENT NAME
; menu option disabled at request of Technical Advisory Group
; thought to be too confusing and of limited utility
N MEN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE
F D MEN1 D Q:$G(ESCAPE)
. I $G(ESCAPE),$G(MEN)]"" L -^ENG("MEN",MEN)
. Q:$G(ESCAPE)
. D:$G(ENY2K("CONT")) DATA^ENY2K1
. I $G(ESCAPE) L -^ENG("MEN",MEN) Q
. D UPDATE^ENY2K1
. L -^ENG("MEN",MEN) S MEN=""
G EXIT
;
MEN1 K ^TMP($J)
R !!,"Please enter MANUFACTURER EQUIPMENT NAME: ",X:DTIME I '$T!($E(X)="^")!(X="") S ESCAPE=1 Q
I $E(X)="?" W !!,"Please enter a MANUFACTURER EQUIPMENT NAME, of the form" F J="A","F","P" W !,?10,$O(^ENG(6914,"H",J)) G MEN1
S MEN=$$UP^XLFSTR(X)
I '$D(^ENG(6914,"H",MEN)) D G:MEN="" MEN1 W " ("_MEN_")"
. S L=$L(MEN),MEN(1)=$O(^ENG(6914,"H",MEN))
. I $E(MEN(1),1,L)=MEN S MEN=MEN(1) Q
. S MEN=""
L +^ENG("MEN",MEN):10 I '$T W !,"Another user is editing this MANUFACTURER EQUIPMENT NAME. Can't proceed." S MEN="" G MEN1
F J="PRE","FC","NC","CC","NA" S COUNT(J)=0
S (DA,COUNT)=0 F S DA=$O(^ENG(6914,"H",MEN,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 MANUFACTURER EQUIPMENT NAME",!,"is "_MEN_"." L -^ENG("MEN",MEN) S MEN="" G MEN1
W !!,"There are "_COUNT_" active equipment records whose MANUFACTURER EQUIPMENT",!,"NAME is "_MEN_". Do you wish to proceed?"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
I COUNT("PRE"),'$D(CRITER) D OVERWRT^ENY2K8 Q:$G(ESCAPE)
S ENY2K("CONT")=Y I 'ENY2K("CONT") L -^ENG("MEN",MEN) S MEN="" G MEN1
Q
;
EXIT K ^TMP($J)
Q
;ENY2KA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2KA 1923 printed Dec 13, 2024@01:57:21 Page 2
ENY2KA ;;(WIRMFO)/DH-Equipment Y2K Management ;5.12.98
+1 ;;7.0;ENGINEERING;**51**;August 17, 1993
+2 ; extension of ENY2K
+3 ;
MEN ; data entry by MANUFACTURER EQUIPMENT NAME
+1 ; menu option disabled at request of Technical Advisory Group
+2 ; thought to be too confusing and of limited utility
+3 NEW MEN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE
+4 FOR
DO MEN1
Begin DoDot:1
+5 IF $GET(ESCAPE)
IF $GET(MEN)]""
LOCK -^ENG("MEN",MEN)
+6 if $GET(ESCAPE)
QUIT
+7 if $GET(ENY2K("CONT"))
DO DATA^ENY2K1
+8 IF $GET(ESCAPE)
LOCK -^ENG("MEN",MEN)
QUIT
+9 DO UPDATE^ENY2K1
+10 LOCK -^ENG("MEN",MEN)
SET MEN=""
End DoDot:1
if $GET(ESCAPE)
QUIT
+11 GOTO EXIT
+12 ;
MEN1 KILL ^TMP($JOB)
+1 READ !!,"Please enter MANUFACTURER EQUIPMENT NAME: ",X:DTIME
IF '$TEST!($EXTRACT(X)="^")!(X="")
SET ESCAPE=1
QUIT
+2 IF $EXTRACT(X)="?"
WRITE !!,"Please enter a MANUFACTURER EQUIPMENT NAME, of the form"
FOR J="A","F","P"
WRITE !,?10,$ORDER(^ENG(6914,"H",J))
GOTO MEN1
+3 SET MEN=$$UP^XLFSTR(X)
+4 IF '$DATA(^ENG(6914,"H",MEN))
Begin DoDot:1
+5 SET L=$LENGTH(MEN)
SET MEN(1)=$ORDER(^ENG(6914,"H",MEN))
+6 IF $EXTRACT(MEN(1),1,L)=MEN
SET MEN=MEN(1)
QUIT
+7 SET MEN=""
End DoDot:1
if MEN=""
GOTO MEN1
WRITE " ("_MEN_")"
+8 LOCK +^ENG("MEN",MEN):10
IF '$TEST
WRITE !,"Another user is editing this MANUFACTURER EQUIPMENT NAME. Can't proceed."
SET MEN=""
GOTO MEN1
+9 FOR J="PRE","FC","NC","CC","NA"
SET COUNT(J)=0
+10 SET (DA,COUNT)=0
FOR
SET DA=$ORDER(^ENG(6914,"H",MEN,DA))
if 'DA
QUIT
Begin DoDot:1
+11 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
+12 IF 'COUNT
WRITE !!,"There are no active equipment records whose MANUFACTURER EQUIPMENT NAME",!,"is "_MEN_"."
LOCK -^ENG("MEN",MEN)
SET MEN=""
GOTO MEN1
+13 WRITE !!,"There are "_COUNT_" active equipment records whose MANUFACTURER EQUIPMENT",!,"NAME is "_MEN_". Do you wish to proceed?"
+14 SET DIR(0)="Y"
SET DIR("B")="YES"
+15 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+16 IF COUNT("PRE")
IF '$DATA(CRITER)
DO OVERWRT^ENY2K8
if $GET(ESCAPE)
QUIT
+17 SET ENY2K("CONT")=Y
IF 'ENY2K("CONT")
LOCK -^ENG("MEN",MEN)
SET MEN=""
GOTO MEN1
+18 QUIT
+19 ;
EXIT KILL ^TMP($JOB)
+1 QUIT
+2 ;ENY2KA
