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