source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENY2KA.m@ 770

Last change on this file since 770 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1ENY2KA ;;(WIRMFO)/DH-Equipment Y2K Management ;5.12.98
2 ;;7.0;ENGINEERING;**51**;August 17, 1993
3 ; extension of ENY2K
4 ;
5MEN ; data entry by MANUFACTURER EQUIPMENT NAME
6 ; menu option disabled at request of Technical Advisory Group
7 ; thought to be too confusing and of limited utility
8 N MEN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE
9 F D MEN1 D Q:$G(ESCAPE)
10 . I $G(ESCAPE),$G(MEN)]"" L -^ENG("MEN",MEN)
11 . Q:$G(ESCAPE)
12 . D:$G(ENY2K("CONT")) DATA^ENY2K1
13 . I $G(ESCAPE) L -^ENG("MEN",MEN) Q
14 . D UPDATE^ENY2K1
15 . L -^ENG("MEN",MEN) S MEN=""
16 G EXIT
17 ;
18MEN1 K ^TMP($J)
19 R !!,"Please enter MANUFACTURER EQUIPMENT NAME: ",X:DTIME I '$T!($E(X)="^")!(X="") S ESCAPE=1 Q
20 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
21 S MEN=$$UP^XLFSTR(X)
22 I '$D(^ENG(6914,"H",MEN)) D G:MEN="" MEN1 W " ("_MEN_")"
23 . S L=$L(MEN),MEN(1)=$O(^ENG(6914,"H",MEN))
24 . I $E(MEN(1),1,L)=MEN S MEN=MEN(1) Q
25 . S MEN=""
26 L +^ENG("MEN",MEN):10 I '$T W !,"Another user is editing this MANUFACTURER EQUIPMENT NAME. Can't proceed." S MEN="" G MEN1
27 F J="PRE","FC","NC","CC","NA" S COUNT(J)=0
28 S (DA,COUNT)=0 F S DA=$O(^ENG(6914,"H",MEN,DA)) Q:'DA D
29 . 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)=""
30 I 'COUNT W !!,"There are no active equipment records whose MANUFACTURER EQUIPMENT NAME",!,"is "_MEN_"." L -^ENG("MEN",MEN) S MEN="" G MEN1
31 W !!,"There are "_COUNT_" active equipment records whose MANUFACTURER EQUIPMENT",!,"NAME is "_MEN_". Do you wish to proceed?"
32 S DIR(0)="Y",DIR("B")="YES"
33 D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
34 I COUNT("PRE"),'$D(CRITER) D OVERWRT^ENY2K8 Q:$G(ESCAPE)
35 S ENY2K("CONT")=Y I 'ENY2K("CONT") L -^ENG("MEN",MEN) S MEN="" G MEN1
36 Q
37 ;
38EXIT K ^TMP($J)
39 Q
40 ;ENY2KA
Note: See TracBrowser for help on using the repository browser.