- ENEQPMP ;(WASH ISC)/JED/DH-Establish PMI Parameters ;4.1.98
- ;;7.0;ENGINEERING;**35,52**;Aug 17, 1993
- ;
- HDR W @IOF,!!,"PREVENTIVE MAINTENANCE PARAMETERS",!,"Version ",^ENG("VERSION") Q
- PMSE ;DEVICE PM EDIT
- I '$D(^XUSEC("ENEDPM",DUZ)) W !!,"Sorry, you need Security Key 'ENEDPM'." D HLD Q
- W @IOF,!! S DIC(0)="AEQM",(DIC,DIE)="^ENG(6914," D ^DIC G:Y'>0 EXIT S DA=+Y
- XNPMSE Q:'$D(DA) I $P($G(^ENG(6914,DA,4,0)),U,4)>0 W !,"Would you like to see the existing PM schedule for this device" S %=1 D YN^DICN G:%=0 XNPMSE I %=1 D DINV^ENEQPMP3 Q:$G(ENX)="^" G PMSE2
- I $P($G(^ENG(6914,DA,1)),U)]"" G PMSE1
- I $G(ENXP)=2 G PMSE1
- W !,"There is no EQUIPMENT CATEGORY on file for this item. Would you",!,"like to enter one now" S %=1 D YN^DICN G:%=2 PMSE2 Q:%<1 S DR="6" D ^DIE I '$D(^ENG(6914,DA,1)) S ^ENG(6914,DA,1)=""
- PMSE1 I $P($G(^ENG(6914,DA,1)),U)="" G PMSE2
- S ENDTYP=$P($G(^ENG(6914,DA,1)),U),ENDVTYP=$P($G(^ENG(6911,ENDTYP,0)),U) W !,"Equipment Category is: ",ENDVTYP I '$D(^ENG(6911,ENDTYP,4)) W !,"There is no defined PM schedule for this category." G PMSE2
- I $D(^ENG(6911,ENDTYP,4)) W !,"Would you like to see the standard PM schedule for this Equipment Category" S %=1 D YN^DICN G:%=-1 EXIT G:%=0 PMSE1 D:%=1 DDT^ENEQPMP3
- PMSE10 I $D(^ENG(6911,ENDTYP,4)) W !,"Should this item be given the standard PM schedule for devices",!,"of category ",ENDVTYP S %=1 D YN^DICN G:%=2 PMSE2 I %=0 D PMSEH1 G PMSE10
- I %'>0 G EXIT
- D PMSE3 S I=0 F S I=$O(^ENG(6914,DA,4,I)) Q:I'>0 I '$D(^(I,1)) S J=0 F S J=$O(^ENG(6914,DA,4,I,2,J)) Q:J'>0 S ENA=$P(^(J,0),U) I ENA'="M",ENA'["W" D PMSESM Q
- G:'$D(ENXP) PMSE G EXIT
- PMSESM S ENSH=$P(^ENG(6914,DA,4,I,0),U),ENSHOP=$P(^DIC(6922,ENSH,0),U) W !!,"PM Schedule for ",ENSHOP," Shop may need a STARTING MONTH."
- S DIE="^ENG(6914,"_DA_",4,",DA=1,DR="2" D ^DIE
- Q
- ;
- PMSE2 S DR="[ENEQPMP]" D ^DIE G:'$D(ENXP) PMSE
- G EXIT
- ;
- PMSE3 N ENX,DIE,DR
- S I=0 F S I=$O(^ENG(6914,DA,4,I)) Q:I'>0 I $D(^ENG(6914,DA,4,I,0)),$D(^(1)) S ENB=$P(^ENG(6914,DA,4,I,0),U),ENB(ENB)=^ENG(6914,DA,4,I,1)
- K ^ENG(6914,DA,4) S %X="^ENG(6911,ENDTYP,4,",%Y="^ENG(6914,DA,4," D %XY^%RCR K %X,%Y
- S I=0 F S I=$O(^ENG(6914,"AB",I)) Q:I'>0 K ^ENG(6914,"AB",I,DA)
- S I=0 F S I=$O(^ENG(6914,DA,4,I)) Q:I'>0 S ENA=$P(^ENG(6914,DA,4,I,0),U,1),^ENG(6914,"AB",ENA,DA,I)=""
- I $D(^ENG(6914,DA,4,0)) S $P(^(0),U,2)="6914.04P" F I=0:0 S I=$O(^ENG(6914,DA,4,I)) Q:I'>0 S $P(^ENG(6914,DA,4,I,2,0),U,2)="6914.43SA"
- I $D(ENB)\10 F I=0:0 S I=$O(ENB(I)) Q:I'>0 S J=$O(^ENG(6914,DA,4,"B",I,0)) I J>0 S:'$D(^ENG(6914,DA,4,J,1)) ^(1)=ENB(I) Q:'$D(^(1)) I ^(1)']"" S ^(1)=ENB(I)
- S ENX=$P(^ENG(6911,ENDTYP,0),U,3) I ENX]"" D
- . S DIE="^ENG(6914,"
- . S DR="27///^S X=ENX" D ^DIE
- K ENB Q
- ;
- PMSEH1 W !,"'YES' will cause the system to automatically assign the standard PM schedule.",!,"'NO' will enable you to enter a special schedule for this device." Q
- HLD I $E(IOST,1,2)="C-" R !,"Press <RETURN> to continue...",ENX:DTIME
- Q
- EXIT Q:$G(ENXP)=2 G EXIT^ENEQPMP1
- ;ENEQPMP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQPMP 3012 printed Feb 18, 2025@23:19:06 Page 2
- ENEQPMP ;(WASH ISC)/JED/DH-Establish PMI Parameters ;4.1.98
- +1 ;;7.0;ENGINEERING;**35,52**;Aug 17, 1993
- +2 ;
- HDR WRITE @IOF,!!,"PREVENTIVE MAINTENANCE PARAMETERS",!,"Version ",^ENG("VERSION")
- QUIT
- PMSE ;DEVICE PM EDIT
- +1 IF '$DATA(^XUSEC("ENEDPM",DUZ))
- WRITE !!,"Sorry, you need Security Key 'ENEDPM'."
- DO HLD
- QUIT
- +2 WRITE @IOF,!!
- SET DIC(0)="AEQM"
- SET (DIC,DIE)="^ENG(6914,"
- DO ^DIC
- if Y'>0
- GOTO EXIT
- SET DA=+Y
- XNPMSE if '$DATA(DA)
- QUIT
- IF $PIECE($GET(^ENG(6914,DA,4,0)),U,4)>0
- WRITE !,"Would you like to see the existing PM schedule for this device"
- SET %=1
- DO YN^DICN
- if %=0
- GOTO XNPMSE
- IF %=1
- DO DINV^ENEQPMP3
- if $GET(ENX)="^"
- QUIT
- GOTO PMSE2
- +1 IF $PIECE($GET(^ENG(6914,DA,1)),U)]""
- GOTO PMSE1
- +2 IF $GET(ENXP)=2
- GOTO PMSE1
- +3 WRITE !,"There is no EQUIPMENT CATEGORY on file for this item. Would you",!,"like to enter one now"
- SET %=1
- DO YN^DICN
- if %=2
- GOTO PMSE2
- if %<1
- QUIT
- SET DR="6"
- DO ^DIE
- IF '$DATA(^ENG(6914,DA,1))
- SET ^ENG(6914,DA,1)=""
- PMSE1 IF $PIECE($GET(^ENG(6914,DA,1)),U)=""
- GOTO PMSE2
- +1 SET ENDTYP=$PIECE($GET(^ENG(6914,DA,1)),U)
- SET ENDVTYP=$PIECE($GET(^ENG(6911,ENDTYP,0)),U)
- WRITE !,"Equipment Category is: ",ENDVTYP
- IF '$DATA(^ENG(6911,ENDTYP,4))
- WRITE !,"There is no defined PM schedule for this category."
- GOTO PMSE2
- +2 IF $DATA(^ENG(6911,ENDTYP,4))
- WRITE !,"Would you like to see the standard PM schedule for this Equipment Category"
- SET %=1
- DO YN^DICN
- if %=-1
- GOTO EXIT
- if %=0
- GOTO PMSE1
- if %=1
- DO DDT^ENEQPMP3
- PMSE10 IF $DATA(^ENG(6911,ENDTYP,4))
- WRITE !,"Should this item be given the standard PM schedule for devices",!,"of category ",ENDVTYP
- SET %=1
- DO YN^DICN
- if %=2
- GOTO PMSE2
- IF %=0
- DO PMSEH1
- GOTO PMSE10
- +1 IF %'>0
- GOTO EXIT
- +2 DO PMSE3
- SET I=0
- FOR
- SET I=$ORDER(^ENG(6914,DA,4,I))
- if I'>0
- QUIT
- IF '$DATA(^(I,1))
- SET J=0
- FOR
- SET J=$ORDER(^ENG(6914,DA,4,I,2,J))
- if J'>0
- QUIT
- SET ENA=$PIECE(^(J,0),U)
- IF ENA'="M"
- IF ENA'["W"
- DO PMSESM
- QUIT
- +3 if '$DATA(ENXP)
- GOTO PMSE
- GOTO EXIT
- PMSESM SET ENSH=$PIECE(^ENG(6914,DA,4,I,0),U)
- SET ENSHOP=$PIECE(^DIC(6922,ENSH,0),U)
- WRITE !!,"PM Schedule for ",ENSHOP," Shop may need a STARTING MONTH."
- +1 SET DIE="^ENG(6914,"_DA_",4,"
- SET DA=1
- SET DR="2"
- DO ^DIE
- +2 QUIT
- +3 ;
- PMSE2 SET DR="[ENEQPMP]"
- DO ^DIE
- if '$DATA(ENXP)
- GOTO PMSE
- +1 GOTO EXIT
- +2 ;
- PMSE3 NEW ENX,DIE,DR
- +1 SET I=0
- FOR
- SET I=$ORDER(^ENG(6914,DA,4,I))
- if I'>0
- QUIT
- IF $DATA(^ENG(6914,DA,4,I,0))
- IF $DATA(^(1))
- SET ENB=$PIECE(^ENG(6914,DA,4,I,0),U)
- SET ENB(ENB)=^ENG(6914,DA,4,I,1)
- +2 KILL ^ENG(6914,DA,4)
- SET %X="^ENG(6911,ENDTYP,4,"
- SET %Y="^ENG(6914,DA,4,"
- DO %XY^%RCR
- KILL %X,%Y
- +3 SET I=0
- FOR
- SET I=$ORDER(^ENG(6914,"AB",I))
- if I'>0
- QUIT
- KILL ^ENG(6914,"AB",I,DA)
- +4 SET I=0
- FOR
- SET I=$ORDER(^ENG(6914,DA,4,I))
- if I'>0
- QUIT
- SET ENA=$PIECE(^ENG(6914,DA,4,I,0),U,1)
- SET ^ENG(6914,"AB",ENA,DA,I)=""
- +5 IF $DATA(^ENG(6914,DA,4,0))
- SET $PIECE(^(0),U,2)="6914.04P"
- FOR I=0:0
- SET I=$ORDER(^ENG(6914,DA,4,I))
- if I'>0
- QUIT
- SET $PIECE(^ENG(6914,DA,4,I,2,0),U,2)="6914.43SA"
- +6 IF $DATA(ENB)\10
- FOR I=0:0
- SET I=$ORDER(ENB(I))
- if I'>0
- QUIT
- SET J=$ORDER(^ENG(6914,DA,4,"B",I,0))
- IF J>0
- if '$DATA(^ENG(6914,DA,4,J,1))
- SET ^(1)=ENB(I)
- if '$DATA(^(1))
- QUIT
- IF ^(1)']""
- SET ^(1)=ENB(I)
- +7 SET ENX=$PIECE(^ENG(6911,ENDTYP,0),U,3)
- IF ENX]""
- Begin DoDot:1
- +8 SET DIE="^ENG(6914,"
- +9 SET DR="27///^S X=ENX"
- DO ^DIE
- End DoDot:1
- +10 KILL ENB
- QUIT
- +11 ;
- PMSEH1 WRITE !,"'YES' will cause the system to automatically assign the standard PM schedule.",!,"'NO' will enable you to enter a special schedule for this device."
- QUIT
- HLD IF $EXTRACT(IOST,1,2)="C-"
- READ !,"Press <RETURN> to continue...",ENX:DTIME
- +1 QUIT
- EXIT if $GET(ENXP)=2
- QUIT
- GOTO EXIT^ENEQPMP1
- +1 ;ENEQPMP