source: FOIAVistA/trunk/r/ENGINEERING-EN/ENEQPMP1.m@ 677

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

initial load of FOIAVistA 6/30/08 version

File size: 6.4 KB
Line 
1ENEQPMP1 ;(WIRMFO)/DH/SAB-Maintain PMI Parameters ;7.29.97
2 ;;7.0;ENGINEERING;**35,43**;Aug 17, 1993
3PMSD ; Display device PM schedule
4 N DIC,DIE,DA,DR,X,I,J,I1,TAG,K
5 W @IOF,!! S DIC(0)="AEQM",(DIC,DIE)="^ENG(6914," D ^DIC G:Y'>0 EXIT S DA=+Y D DINV^ENEQPMP3 G:'$D(ENXP) PMSD G EXIT
6 ;
7DTD ; Display Equipment Category PM data
8 N DIC,DIE,DA,DR,X,I,J,I1,TAG,K
9 S DIC(0)="AEQM" D DTL G:ENDTYP'>0 EXIT D DDT^ENEQPMP3 W @IOF
10 Q
11 ;
12DTE ; Edit Equipment Category PM data
13 I '$D(^XUSEC("ENEDPM")) W !!,"Sorry, you need Security Key 'ENEDPM'." D HLD G EXIT
14 N DIC,DIE,DA,DR,I,J,X,I1,TAG,K
15 S DIC(0)="AEQML",DLAYGO=6911 D DTL K DLAYGO G:ENDTYP'>0 EXIT
16 L +^ENG(6911,ENDTYP):1 I '$T W !!,*7,"Someone else is editing this record." G EXIT
17 S DA=ENDTYP,DR="[ENEQPMP]"
18DTE1 D DDT^ENEQPMP3,^DIE
19 L -^ENG(6911,ENDTYP)
20 G:'$D(DA) DTE
21DTE2 W !,"Are you finished with this Equipment Category" S %=1 D YN^DICN G:%=2 DTE1 G:%<0 DTE I %=0 W !,"Please enter 'YES' or 'NO'." G DTE2
22 S ENDVTYP=$P($G(^ENG(6911,ENDTYP,0)),U)
23DTE3 I $O(^ENG(6911,ENDTYP,4,0)) W !,"Do you wish to assign this PM schedule to ALL existing equipment records",!,"in the category of "_ENDVTYP
24 E W !,"Do you want to delete existing PM schedules (if any) from equipment records",!,"in the category of "_ENDVTYP
25 S %=2 D YN^DICN S TAG=$S(%=1:"DTE5",%=2:"DTE",1:"DTE4") G @TAG
26DTE4 D DTEH G DTE3
27DTE5 W !,"Do you wish to confirm each transaction" S %=2 D YN^DICN G:%<1 DTEH1 S ENCONF=$S(%=1:1,1:0)
28 F DA=0:0 S DA=$O(^ENG(6914,"G",ENDTYP,DA)) Q:DA'>0 W !,DA W:$D(^ENG(6914,DA,3)) ?10,$P(^(3),U,6) D DTE51
29 D HLD G DTE
30DTE51 I 'ENCONF D PMSE3^ENEQPMP Q
31 W " OK" S %=1 D YN^DICN D:%=1 PMSE3^ENEQPMP
32 Q
33 ;
34DTL W @IOF,!! S (DIC,DIE)="^ENG(6911," D ^DIC S ENDTYP=+Y
35 Q
36 ;
37DTEH W !!,"'YES' will cause the system to immediately find every equipment record of",!,"type "_ENDVTYP_" and assign each of them the PM schedule just entered."
38 W !,"The ENTRY NUMBER of each affected equipment record will be displayed at",!,"your terminal, but you will not be asked to confirm the transaction unless",!,"you say that you want to."
39 W !,"Once this process has begun, it should not be interrupted."
40 Q
41DTEH1 W !!,"You should enter 'YES' if you want to apply the revised schedule to some",!,ENDVTYP,"'s but not others."
42 W !,"Enter 'NO' if you want the revised schedule applied to all equipment of",!,"type ",ENDVTYP,"."
43 G DTE5
44SKPCK ;SKP MNTHS = ENA ;Called by FileMan Input X-form
45 S ENA=X,ENB=$P(ENA,"-",2),ENA=$P(ENA,"-",1)
46 I ENA'="JUN",ENA'="SEP",ENA'="MAY",ENA'="OCT",ENA'="APR",ENA'="AUG",ENA'="JUL",ENA'="NOV",ENA'="MAR",ENA'="DEC",ENA'="FEB",ENA'="JAN" S ENA="ERR"
47 I ENB'="JUN",ENB'="SEP",ENB'="MAY",ENB'="OCT",ENB'="APR",ENB'="AUG",ENB'="JUL",ENB'="NOV",ENB'="MAR",ENB'="DEC",ENB'="FEB",ENB'="JAN" S ENA="ERR"
48 I ENA="ERR"!(ENB="ERR") D EN^DDIOL("You seem to have an invalid entry for 'SKIP MONTHS'. Valid abbreviations are") D EN^DDIOL("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV, and DEC. Please re-edit.")
49 Q
50HLD I $E(IOST,1,2)="C-" R !,"Press <RETURN> to continue...",X:DTIME
51 Q
52EXIT K ENDTYP,ENDVTYP,ENA,ENB,ENCRIT,ENXP,ENC,ENCONF,ENX
53 Q
54 ;
55RT ;Reassign a Technicians PMI Responsibilities
56 ;
57RTASK ; ask user
58 W !
59 S DIC=6929,DIC(0)="AQEM",DIC("A")="Replace this TECHNICIAN: "
60 D ^DIC K DIC G:Y'>0 RTEX S ENTEC("O")=+Y,ENTECN("O")=$P(Y,U,2)
61 ;
62 S DIC=6929,DIC(0)="AQEM",DIC("A")="With this TECHNICIAN: "
63 D ^DIC K DIC G:Y'>0 RTEX S ENTEC("N")=+Y,ENTECN("N")=$P(Y,U,2)
64 ;
65 S DIR(0)="S^0:ONE RESPONSIBLE SHOP;1:ALL RESPONSIBLE SHOPS"
66 S DIR("A")="For PM schedules by",DIR("B")="ALL"
67 D ^DIR K DIR G:$D(DIRUT) RTEX S ENSHKEY("ALL")=Y
68 ;
69 I 'ENSHKEY("ALL") D I ENSHKEY'>0 G RTEX
70 . S DIC=6922,DIC(0)="AQEM" D ^DIC K DIC S ENSHKEY=+Y,ENSHOP=$P(Y,U,2)
71 ;
72 S DIR(0)="Y",DIR("A")="Do you want to individually edit each entry"
73 S DIR("B")="NO"
74 S DIR("?",1)="If YES is entered here, the system will pause after each entry"
75 S DIR("?",2)="for which TECHNICIAN "_ENTECN("O")_" has been changed"
76 S DIR("?",3)="and allow you to edit the TECHNICIAN field."
77 S DIR("?",4)=" "
78 S DIR("?")="Enter YES or NO"
79 D ^DIR K DIR G:$D(DTOUT) RTEX S ENEDTEC=Y
80 ;
81 W !!,"All occurrences of TECHNICIAN in both the EQUIPMENT CATEGORY and"
82 W !,"EQUIPMENT INV. preventive maintenance schedules will be changed"
83 W !,"from ",ENTECN("O")," to ",ENTECN("N"),"."
84 W !,"This change will be made for "
85 I ENSHKEY("ALL") W "the PM schedules of ALL responsible shops."
86 E W "only the PM schedules of the ",ENSHOP," shop."
87 I ENEDTEC W !,"You will be able to individually edit the TECHNICAN."
88 W ! S DIR(0)="Y",DIR("A")="OK to Proceed"
89 D ^DIR K DIR G:'Y!$D(DIRUT) RTEX
90 ;
91RTDO S END=0
92 W !!,"Updating EQUIPMENT CATEGORY file"
93 I ENEDTEC S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S END=1 G RTEX
94 S (ENC,ENT)=0
95 S ENDA=0 F S ENDA=$O(^ENG(6911,ENDA)) Q:'ENDA D Q:END
96 . S ENI=0 F S ENI=$O(^ENG(6911,ENDA,4,ENI)) Q:'ENI D Q:END
97 . . S ENT=ENT+1
98 . . I 'ENEDTEC W:'(ENT#50) "."
99 . . S ENY=$G(^ENG(6911,ENDA,4,ENI,0))
100 . . S ENRS=$P(ENY,U)
101 . . I 'ENSHKEY("ALL"),ENRS'=ENSHKEY Q
102 . . I $P(ENY,U,2)'=ENTEC("O") Q
103 . . ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
104 . . S $P(^ENG(6911,ENDA,4,ENI,0),U,2)=ENTEC("N")
105 . . S ENC=ENC+1
106 . . I ENEDTEC D
107 . . . S ENDTYP=ENDA,ENNOHLD=1 D DDT^ENEQPMP3
108 . . . W !!,"For the ",$P($G(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
109 . . . S DIE="^ENG(6911,"_ENDA_",4,",DA(1)=ENDA,DA=ENI,DR="1"
110 . . . D ^DIE K DA S:$D(Y) END=1
111 W !," ",ENC,$S(ENC=1:" entry was",1:" entries were")," changed."
112 G:END RTEX
113 ;
114 W !!,"Updating EQUIPMENT INV. file"
115 I ENEDTEC S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S END=1 G RTEX
116 S (ENC,ENT)=0
117 I 'ENSHKEY("ALL") S ENRS=ENSHKEY D RTSHOP
118 I ENSHKEY("ALL") S ENRS=0 F S ENRS=$O(^ENG(6914,"AB",ENRS)) Q:'ENRS D RTSHOP Q:END
119 W !," ",ENC,$S(ENC=1:" entry was",1:" entries were")," changed."
120 ;
121RTEX ; reassign tech exit
122 K DA,DIC,DIE,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
123 K ENC,END,ENDA,ENDTYP,ENDVTYP,ENEDTEC,ENI,ENNOHLD,ENRS
124 K ENSHKEY,ENSHOP,ENT,ENTEC,ENTECN,ENX,ENY
125 Q
126 ;
127RTSHOP ; update all entries for responsible shop ENRS
128 S ENDA=0 F S ENDA=$O(^ENG(6914,"AB",ENRS,ENDA)) Q:'ENDA D Q:END
129 . S ENT=ENT+1
130 . I 'ENEDTEC W:'(ENT#50) "."
131 . S ENI=$O(^ENG(6914,"AB",ENRS,ENDA,0))
132 . S ENY=$G(^ENG(6914,ENDA,4,ENI,0))
133 . I $P(ENY,U,2)'=ENTEC("O") Q
134 . ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
135 . S $P(^ENG(6914,ENDA,4,ENI,0),U,2)=ENTEC("N")
136 . S ENC=ENC+1
137 . I ENEDTEC D
138 . . S DA=ENDA,ENNOHLD=1 D DINV^ENEQPMP3
139 . . W !!,"For the ",$P($G(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
140 . . S DIE="^ENG(6914,"_ENDA_",4,",DA(1)=ENDA,DA=ENI,DR="1"
141 . . D ^DIE K DA S:$D(Y) END=1
142 Q
143 ;
144 ;ENEQPMP1
Note: See TracBrowser for help on using the repository browser.