ENEQPMP1 ;(WIRMFO)/DH/SAB-Maintain PMI Parameters ;7.29.97
;;7.0;ENGINEERING;**35,43**;Aug 17, 1993
PMSD ; Display device PM schedule
N DIC,DIE,DA,DR,X,I,J,I1,TAG,K
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
;
DTD ; Display Equipment Category PM data
N DIC,DIE,DA,DR,X,I,J,I1,TAG,K
S DIC(0)="AEQM" D DTL G:ENDTYP'>0 EXIT D DDT^ENEQPMP3 W @IOF
Q
;
DTE ; Edit Equipment Category PM data
I '$D(^XUSEC("ENEDPM")) W !!,"Sorry, you need Security Key 'ENEDPM'." D HLD G EXIT
N DIC,DIE,DA,DR,I,J,X,I1,TAG,K
S DIC(0)="AEQML",DLAYGO=6911 D DTL K DLAYGO G:ENDTYP'>0 EXIT
L +^ENG(6911,ENDTYP):1 I '$T W !!,*7,"Someone else is editing this record." G EXIT
S DA=ENDTYP,DR="[ENEQPMP]"
DTE1 D DDT^ENEQPMP3,^DIE
L -^ENG(6911,ENDTYP)
G:'$D(DA) DTE
DTE2 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
S ENDVTYP=$P($G(^ENG(6911,ENDTYP,0)),U)
DTE3 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
E W !,"Do you want to delete existing PM schedules (if any) from equipment records",!,"in the category of "_ENDVTYP
S %=2 D YN^DICN S TAG=$S(%=1:"DTE5",%=2:"DTE",1:"DTE4") G @TAG
DTE4 D DTEH G DTE3
DTE5 W !,"Do you wish to confirm each transaction" S %=2 D YN^DICN G:%<1 DTEH1 S ENCONF=$S(%=1:1,1:0)
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
D HLD G DTE
DTE51 I 'ENCONF D PMSE3^ENEQPMP Q
W " OK" S %=1 D YN^DICN D:%=1 PMSE3^ENEQPMP
Q
;
DTL W @IOF,!! S (DIC,DIE)="^ENG(6911," D ^DIC S ENDTYP=+Y
Q
;
DTEH 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."
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."
W !,"Once this process has begun, it should not be interrupted."
Q
DTEH1 W !!,"You should enter 'YES' if you want to apply the revised schedule to some",!,ENDVTYP,"'s but not others."
W !,"Enter 'NO' if you want the revised schedule applied to all equipment of",!,"type ",ENDVTYP,"."
G DTE5
SKPCK ;SKP MNTHS = ENA ;Called by FileMan Input X-form
S ENA=X,ENB=$P(ENA,"-",2),ENA=$P(ENA,"-",1)
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"
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"
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.")
Q
HLD I $E(IOST,1,2)="C-" R !,"Press <RETURN> to continue...",X:DTIME
Q
EXIT K ENDTYP,ENDVTYP,ENA,ENB,ENCRIT,ENXP,ENC,ENCONF,ENX
Q
;
RT ;Reassign a Technicians PMI Responsibilities
;
RTASK ; ask user
W !
S DIC=6929,DIC(0)="AQEM",DIC("A")="Replace this TECHNICIAN: "
D ^DIC K DIC G:Y'>0 RTEX S ENTEC("O")=+Y,ENTECN("O")=$P(Y,U,2)
;
S DIC=6929,DIC(0)="AQEM",DIC("A")="With this TECHNICIAN: "
D ^DIC K DIC G:Y'>0 RTEX S ENTEC("N")=+Y,ENTECN("N")=$P(Y,U,2)
;
S DIR(0)="S^0:ONE RESPONSIBLE SHOP;1:ALL RESPONSIBLE SHOPS"
S DIR("A")="For PM schedules by",DIR("B")="ALL"
D ^DIR K DIR G:$D(DIRUT) RTEX S ENSHKEY("ALL")=Y
;
I 'ENSHKEY("ALL") D I ENSHKEY'>0 G RTEX
. S DIC=6922,DIC(0)="AQEM" D ^DIC K DIC S ENSHKEY=+Y,ENSHOP=$P(Y,U,2)
;
S DIR(0)="Y",DIR("A")="Do you want to individually edit each entry"
S DIR("B")="NO"
S DIR("?",1)="If YES is entered here, the system will pause after each entry"
S DIR("?",2)="for which TECHNICIAN "_ENTECN("O")_" has been changed"
S DIR("?",3)="and allow you to edit the TECHNICIAN field."
S DIR("?",4)=" "
S DIR("?")="Enter YES or NO"
D ^DIR K DIR G:$D(DTOUT) RTEX S ENEDTEC=Y
;
W !!,"All occurrences of TECHNICIAN in both the EQUIPMENT CATEGORY and"
W !,"EQUIPMENT INV. preventive maintenance schedules will be changed"
W !,"from ",ENTECN("O")," to ",ENTECN("N"),"."
W !,"This change will be made for "
I ENSHKEY("ALL") W "the PM schedules of ALL responsible shops."
E W "only the PM schedules of the ",ENSHOP," shop."
I ENEDTEC W !,"You will be able to individually edit the TECHNICAN."
W ! S DIR(0)="Y",DIR("A")="OK to Proceed"
D ^DIR K DIR G:'Y!$D(DIRUT) RTEX
;
RTDO S END=0
W !!,"Updating EQUIPMENT CATEGORY file"
I ENEDTEC S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S END=1 G RTEX
S (ENC,ENT)=0
S ENDA=0 F S ENDA=$O(^ENG(6911,ENDA)) Q:'ENDA D Q:END
. S ENI=0 F S ENI=$O(^ENG(6911,ENDA,4,ENI)) Q:'ENI D Q:END
. . S ENT=ENT+1
. . I 'ENEDTEC W:'(ENT#50) "."
. . S ENY=$G(^ENG(6911,ENDA,4,ENI,0))
. . S ENRS=$P(ENY,U)
. . I 'ENSHKEY("ALL"),ENRS'=ENSHKEY Q
. . I $P(ENY,U,2)'=ENTEC("O") Q
. . ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
. . S $P(^ENG(6911,ENDA,4,ENI,0),U,2)=ENTEC("N")
. . S ENC=ENC+1
. . I ENEDTEC D
. . . S ENDTYP=ENDA,ENNOHLD=1 D DDT^ENEQPMP3
. . . W !!,"For the ",$P($G(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
. . . S DIE="^ENG(6911,"_ENDA_",4,",DA(1)=ENDA,DA=ENI,DR="1"
. . . D ^DIE K DA S:$D(Y) END=1
W !," ",ENC,$S(ENC=1:" entry was",1:" entries were")," changed."
G:END RTEX
;
W !!,"Updating EQUIPMENT INV. file"
I ENEDTEC S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S END=1 G RTEX
S (ENC,ENT)=0
I 'ENSHKEY("ALL") S ENRS=ENSHKEY D RTSHOP
I ENSHKEY("ALL") S ENRS=0 F S ENRS=$O(^ENG(6914,"AB",ENRS)) Q:'ENRS D RTSHOP Q:END
W !," ",ENC,$S(ENC=1:" entry was",1:" entries were")," changed."
;
RTEX ; reassign tech exit
K DA,DIC,DIE,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
K ENC,END,ENDA,ENDTYP,ENDVTYP,ENEDTEC,ENI,ENNOHLD,ENRS
K ENSHKEY,ENSHOP,ENT,ENTEC,ENTECN,ENX,ENY
Q
;
RTSHOP ; update all entries for responsible shop ENRS
S ENDA=0 F S ENDA=$O(^ENG(6914,"AB",ENRS,ENDA)) Q:'ENDA D Q:END
. S ENT=ENT+1
. I 'ENEDTEC W:'(ENT#50) "."
. S ENI=$O(^ENG(6914,"AB",ENRS,ENDA,0))
. S ENY=$G(^ENG(6914,ENDA,4,ENI,0))
. I $P(ENY,U,2)'=ENTEC("O") Q
. ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
. S $P(^ENG(6914,ENDA,4,ENI,0),U,2)=ENTEC("N")
. S ENC=ENC+1
. I ENEDTEC D
. . S DA=ENDA,ENNOHLD=1 D DINV^ENEQPMP3
. . W !!,"For the ",$P($G(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
. . S DIE="^ENG(6914,"_ENDA_",4,",DA(1)=ENDA,DA=ENI,DR="1"
. . D ^DIE K DA S:$D(Y) END=1
Q
;
;ENEQPMP1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQPMP1 6713 printed Oct 16, 2024@17:53:32 Page 2
ENEQPMP1 ;(WIRMFO)/DH/SAB-Maintain PMI Parameters ;7.29.97
+1 ;;7.0;ENGINEERING;**35,43**;Aug 17, 1993
PMSD ; Display device PM schedule
+1 NEW DIC,DIE,DA,DR,X,I,J,I1,TAG,K
+2 WRITE @IOF,!!
SET DIC(0)="AEQM"
SET (DIC,DIE)="^ENG(6914,"
DO ^DIC
if Y'>0
GOTO EXIT
SET DA=+Y
DO DINV^ENEQPMP3
if '$DATA(ENXP)
GOTO PMSD
GOTO EXIT
+3 ;
DTD ; Display Equipment Category PM data
+1 NEW DIC,DIE,DA,DR,X,I,J,I1,TAG,K
+2 SET DIC(0)="AEQM"
DO DTL
if ENDTYP'>0
GOTO EXIT
DO DDT^ENEQPMP3
WRITE @IOF
+3 QUIT
+4 ;
DTE ; Edit Equipment Category PM data
+1 IF '$DATA(^XUSEC("ENEDPM"))
WRITE !!,"Sorry, you need Security Key 'ENEDPM'."
DO HLD
GOTO EXIT
+2 NEW DIC,DIE,DA,DR,I,J,X,I1,TAG,K
+3 SET DIC(0)="AEQML"
SET DLAYGO=6911
DO DTL
KILL DLAYGO
if ENDTYP'>0
GOTO EXIT
+4 LOCK +^ENG(6911,ENDTYP):1
IF '$TEST
WRITE !!,*7,"Someone else is editing this record."
GOTO EXIT
+5 SET DA=ENDTYP
SET DR="[ENEQPMP]"
DTE1 DO DDT^ENEQPMP3
DO ^DIE
+1 LOCK -^ENG(6911,ENDTYP)
+2 if '$DATA(DA)
GOTO DTE
DTE2 WRITE !,"Are you finished with this Equipment Category"
SET %=1
DO YN^DICN
if %=2
GOTO DTE1
if %<0
GOTO DTE
IF %=0
WRITE !,"Please enter 'YES' or 'NO'."
GOTO DTE2
+1 SET ENDVTYP=$PIECE($GET(^ENG(6911,ENDTYP,0)),U)
DTE3 IF $ORDER(^ENG(6911,ENDTYP,4,0))
WRITE !,"Do you wish to assign this PM schedule to ALL existing equipment records",!,"in the category of "_ENDVTYP
+1 IF '$TEST
WRITE !,"Do you want to delete existing PM schedules (if any) from equipment records",!,"in the category of "_ENDVTYP
+2 SET %=2
DO YN^DICN
SET TAG=$SELECT(%=1:"DTE5",%=2:"DTE",1:"DTE4")
GOTO @TAG
DTE4 DO DTEH
GOTO DTE3
DTE5 WRITE !,"Do you wish to confirm each transaction"
SET %=2
DO YN^DICN
if %<1
GOTO DTEH1
SET ENCONF=$SELECT(%=1:1,1:0)
+1 FOR DA=0:0
SET DA=$ORDER(^ENG(6914,"G",ENDTYP,DA))
if DA'>0
QUIT
WRITE !,DA
if $DATA(^ENG(6914,DA,3))
WRITE ?10,$PIECE(^(3),U,6)
DO DTE51
+2 DO HLD
GOTO DTE
DTE51 IF 'ENCONF
DO PMSE3^ENEQPMP
QUIT
+1 WRITE " OK"
SET %=1
DO YN^DICN
if %=1
DO PMSE3^ENEQPMP
+2 QUIT
+3 ;
DTL WRITE @IOF,!!
SET (DIC,DIE)="^ENG(6911,"
DO ^DIC
SET ENDTYP=+Y
+1 QUIT
+2 ;
DTEH WRITE !!,"'YES' will cause the system to immediately find every equipment record of",!,"type "_ENDVTYP_" and assign each of them the PM schedule just entered."
+1 WRITE !,"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."
+2 WRITE !,"Once this process has begun, it should not be interrupted."
+3 QUIT
DTEH1 WRITE !!,"You should enter 'YES' if you want to apply the revised schedule to some",!,ENDVTYP,"'s but not others."
+1 WRITE !,"Enter 'NO' if you want the revised schedule applied to all equipment of",!,"type ",ENDVTYP,"."
+2 GOTO DTE5
SKPCK ;SKP MNTHS = ENA ;Called by FileMan Input X-form
+1 SET ENA=X
SET ENB=$PIECE(ENA,"-",2)
SET ENA=$PIECE(ENA,"-",1)
+2 IF ENA'="JUN"
IF ENA'="SEP"
IF ENA'="MAY"
IF ENA'="OCT"
IF ENA'="APR"
IF ENA'="AUG"
IF ENA'="JUL"
IF ENA'="NOV"
IF ENA'="MAR"
IF ENA'="DEC"
IF ENA'="FEB"
IF ENA'="JAN"
SET ENA="ERR"
+3 IF ENB'="JUN"
IF ENB'="SEP"
IF ENB'="MAY"
IF ENB'="OCT"
IF ENB'="APR"
IF ENB'="AUG"
IF ENB'="JUL"
IF ENB'="NOV"
IF ENB'="MAR"
IF ENB'="DEC"
IF ENB'="FEB"
IF ENB'="JAN"
SET ENA="ERR"
+4 IF ENA="ERR"!(ENB="ERR")
DO EN^DDIOL("You seem to have an invalid entry for 'SKIP MONTHS'. Valid abbreviations are")
DO EN^DDIOL("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV, and DEC. Please re-edit.")
+5 QUIT
HLD IF $EXTRACT(IOST,1,2)="C-"
READ !,"Press <RETURN> to continue...",X:DTIME
+1 QUIT
EXIT KILL ENDTYP,ENDVTYP,ENA,ENB,ENCRIT,ENXP,ENC,ENCONF,ENX
+1 QUIT
+2 ;
RT ;Reassign a Technicians PMI Responsibilities
+1 ;
RTASK ; ask user
+1 WRITE !
+2 SET DIC=6929
SET DIC(0)="AQEM"
SET DIC("A")="Replace this TECHNICIAN: "
+3 DO ^DIC
KILL DIC
if Y'>0
GOTO RTEX
SET ENTEC("O")=+Y
SET ENTECN("O")=$PIECE(Y,U,2)
+4 ;
+5 SET DIC=6929
SET DIC(0)="AQEM"
SET DIC("A")="With this TECHNICIAN: "
+6 DO ^DIC
KILL DIC
if Y'>0
GOTO RTEX
SET ENTEC("N")=+Y
SET ENTECN("N")=$PIECE(Y,U,2)
+7 ;
+8 SET DIR(0)="S^0:ONE RESPONSIBLE SHOP;1:ALL RESPONSIBLE SHOPS"
+9 SET DIR("A")="For PM schedules by"
SET DIR("B")="ALL"
+10 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO RTEX
SET ENSHKEY("ALL")=Y
+11 ;
+12 IF 'ENSHKEY("ALL")
Begin DoDot:1
+13 SET DIC=6922
SET DIC(0)="AQEM"
DO ^DIC
KILL DIC
SET ENSHKEY=+Y
SET ENSHOP=$PIECE(Y,U,2)
End DoDot:1
IF ENSHKEY'>0
GOTO RTEX
+14 ;
+15 SET DIR(0)="Y"
SET DIR("A")="Do you want to individually edit each entry"
+16 SET DIR("B")="NO"
+17 SET DIR("?",1)="If YES is entered here, the system will pause after each entry"
+18 SET DIR("?",2)="for which TECHNICIAN "_ENTECN("O")_" has been changed"
+19 SET DIR("?",3)="and allow you to edit the TECHNICIAN field."
+20 SET DIR("?",4)=" "
+21 SET DIR("?")="Enter YES or NO"
+22 DO ^DIR
KILL DIR
if $DATA(DTOUT)
GOTO RTEX
SET ENEDTEC=Y
+23 ;
+24 WRITE !!,"All occurrences of TECHNICIAN in both the EQUIPMENT CATEGORY and"
+25 WRITE !,"EQUIPMENT INV. preventive maintenance schedules will be changed"
+26 WRITE !,"from ",ENTECN("O")," to ",ENTECN("N"),"."
+27 WRITE !,"This change will be made for "
+28 IF ENSHKEY("ALL")
WRITE "the PM schedules of ALL responsible shops."
+29 IF '$TEST
WRITE "only the PM schedules of the ",ENSHOP," shop."
+30 IF ENEDTEC
WRITE !,"You will be able to individually edit the TECHNICAN."
+31 WRITE !
SET DIR(0)="Y"
SET DIR("A")="OK to Proceed"
+32 DO ^DIR
KILL DIR
if 'Y!$DATA(DIRUT)
GOTO RTEX
+33 ;
RTDO SET END=0
+1 WRITE !!,"Updating EQUIPMENT CATEGORY file"
+2 IF ENEDTEC
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET END=1
GOTO RTEX
+3 SET (ENC,ENT)=0
+4 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6911,ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+5 SET ENI=0
FOR
SET ENI=$ORDER(^ENG(6911,ENDA,4,ENI))
if 'ENI
QUIT
Begin DoDot:2
+6 SET ENT=ENT+1
+7 IF 'ENEDTEC
if '(ENT#50)
WRITE "."
+8 SET ENY=$GET(^ENG(6911,ENDA,4,ENI,0))
+9 SET ENRS=$PIECE(ENY,U)
+10 IF 'ENSHKEY("ALL")
IF ENRS'=ENSHKEY
QUIT
+11 IF $PIECE(ENY,U,2)'=ENTEC("O")
QUIT
+12 ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
+13 SET $PIECE(^ENG(6911,ENDA,4,ENI,0),U,2)=ENTEC("N")
+14 SET ENC=ENC+1
+15 IF ENEDTEC
Begin DoDot:3
+16 SET ENDTYP=ENDA
SET ENNOHLD=1
DO DDT^ENEQPMP3
+17 WRITE !!,"For the ",$PIECE($GET(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
+18 SET DIE="^ENG(6911,"_ENDA_",4,"
SET DA(1)=ENDA
SET DA=ENI
SET DR="1"
+19 DO ^DIE
KILL DA
if $DATA(Y)
SET END=1
End DoDot:3
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+20 WRITE !," ",ENC,$SELECT(ENC=1:" entry was",1:" entries were")," changed."
+21 if END
GOTO RTEX
+22 ;
+23 WRITE !!,"Updating EQUIPMENT INV. file"
+24 IF ENEDTEC
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET END=1
GOTO RTEX
+25 SET (ENC,ENT)=0
+26 IF 'ENSHKEY("ALL")
SET ENRS=ENSHKEY
DO RTSHOP
+27 IF ENSHKEY("ALL")
SET ENRS=0
FOR
SET ENRS=$ORDER(^ENG(6914,"AB",ENRS))
if 'ENRS
QUIT
DO RTSHOP
if END
QUIT
+28 WRITE !," ",ENC,$SELECT(ENC=1:" entry was",1:" entries were")," changed."
+29 ;
RTEX ; reassign tech exit
+1 KILL DA,DIC,DIE,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
+2 KILL ENC,END,ENDA,ENDTYP,ENDVTYP,ENEDTEC,ENI,ENNOHLD,ENRS
+3 KILL ENSHKEY,ENSHOP,ENT,ENTEC,ENTECN,ENX,ENY
+4 QUIT
+5 ;
RTSHOP ; update all entries for responsible shop ENRS
+1 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6914,"AB",ENRS,ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+2 SET ENT=ENT+1
+3 IF 'ENEDTEC
if '(ENT#50)
WRITE "."
+4 SET ENI=$ORDER(^ENG(6914,"AB",ENRS,ENDA,0))
+5 SET ENY=$GET(^ENG(6914,ENDA,4,ENI,0))
+6 IF $PIECE(ENY,U,2)'=ENTEC("O")
QUIT
+7 ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
+8 SET $PIECE(^ENG(6914,ENDA,4,ENI,0),U,2)=ENTEC("N")
+9 SET ENC=ENC+1
+10 IF ENEDTEC
Begin DoDot:2
+11 SET DA=ENDA
SET ENNOHLD=1
DO DINV^ENEQPMP3
+12 WRITE !!,"For the ",$PIECE($GET(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
+13 SET DIE="^ENG(6914,"_ENDA_",4,"
SET DA(1)=ENDA
SET DA=ENI
SET DR="1"
+14 DO ^DIE
KILL DA
if $DATA(Y)
SET END=1
End DoDot:2
End DoDot:1
if END
QUIT
+15 QUIT
+16 ;
+17 ;ENEQPMP1
