ENEQPMR5 ;(WASH ISC)/DH-Single PMI's ;2.26.98
;;7.0;ENGINEERING;**14,35,48**;Aug 17, 1993
SDPM4 I ENDEL'="N" D Q:DA'>0 G SDPM41 ;pm work order not to be retained
. K DD,DO S DIC="^ENG(6920,",DIC(0)="LX",X=ENPMWO
. D FILE^DICN S DA=+Y
; retain pm work order
F I=1:1 S J=$S($L(I)=1:"00"_I,$L(I)=2:"0"_I,1:I),ENPMWO(0)=ENPMWO_"-"_J I '$D(^ENG(6920,"B",ENPMWO(0))),'$D(^ENG(6920,"H",ENPMWO(0))) Q
L +^ENG(6920,"B")
F Q:'$D(^ENG(6920,"B",ENPMWO(0))) S J=$P(ENPMWO(0),"-",3)+1,J=$S($L(J)=1:"00"_J,$L(J)=2:"0"_J,1:J),ENPMWO(0)=$P(ENPMWO(0),"-",1,2)_"-"_J
K DD,DO S DIC="^ENG(6920,",DIC(0)="LX",X=ENPMWO(0) D FILE^DICN S DA=+Y
L -^ENG(6920,"B") Q:DA'>0
;
SDPM41 S DIE="^ENG(6920,",DR=".05///^S X=$S($D(ENPMWO(0)):ENPMWO(0),1:ENPMWO);1///^S X=DT;9///^S X=ENSHKEY;10///^S X=DT;18///^S X=ENDA;39///^S X=""OFF-SCHEDULE PMI""" D ^DIE
S ^ENG(6920,DA,8,0)="^6920.035^1^1",DIE="^ENG(6920,DA(1),8,",(ENOLDDA,DA(1))=DA,DA=1,DR=".01///^S X=""PREVENTIVE MAINTENANCE""" D ^DIE K DA,DR S DIE="^ENG(6920,",DA=ENOLDDA K ENOLDDA
;
SDPM42 S DR=$S($D(^DIE("B","ENZPMCLOSE")):"[ENZPMCLOSE]",1:"[ENPMCLOSE]") D ^DIE Q:'$D(DA) ;pm work order deleted within ^DIE
;
SDPM43 I $P($G(^ENG(6920,DA,5)),U,2)="" D G:%=1 SDPM42 G:%'=2 SDPM43
. W !,*7,"You need to enter a DATE COMPLETE in order to post this PM work order. My",!,"guess is that you should re-edit to either enter a DATE COMPLETE or to delete"
. W !,"the work order ('@' in response to first prompt).",!,"Am I right" S %=1 D YN^DICN
;
SDPM44 I $P($G(^ENG(6920,DA,5)),U,2)]"",$E(^ENG(6920,DA,0),1,3)="PM-" D
. D PMHRS^ENEQPMR4,PMINV^ENEQPMR4 S ENCLOSE=$P(^ENG(6920,DA,5),U,2)
. I ENDEL="Y" S DIK="^ENG(6920," D ^DIK K DIK
Q:'$G(ENCLOSE)!(ENPM'="M") ;return control to ENEQPMR4
;
SDPM5 ; should user change the STARTING MONTH (or maybe YEAR)
Q:'$D(ENDA) ;nothing to look at
S ENRS=$O(^ENG(6914,ENDA,4,"B",ENSHKEY,0))
Q:'ENRS ;shop doesn't normally do pm
K ENA S I=0 F S I=$O(^ENG(6914,ENDA,4,ENRS,2,I)) Q:'I S ENA($P(^(I,0),U))=$P(^(0),U,6) ;build frequency array
Q:$D(ENA("M")) ;no need to change STARTING MONTH if MONTHLY on file
F I="TA","BA" I $D(ENA(I)),ENA(I)="" K ENA(I)
S ENPMYR("C")=ENPMYR,ENSTMN=$S($D(^ENG(6914,ENDA,4,ENRS,1)):^(1),1:1),I=0 S:ENSTMN="" ENSTMN=1
SDPM51 K ENHZ S ENNXMN=1+(ENPMMN#12) S:ENPMMN=12 ENPMYR("C")=ENPMYR("C")+1
F D Q:$G(ENHZ(0))!((ENNXMN=ENPMMN)&('$D(ENA("TA")))&('$D(ENA("BA")))) Q:ENPMYR("C")>(ENPMYR+4)
. I $D(ENA("TA")),'((ENPMYR("C")-ENA("TA"))#3),ENNXMN=ENSTMN S ENHZ(0)=1,ENHZ="TRI-ANNUAL" Q
. I $D(ENA("BA")),'((ENPMYR("C")-ENA("BA"))#2),ENNXMN=ENSTMN S ENHZ(0)=1,ENHZ="BI-ANNUAL" Q
. I $D(ENA("A")),ENNXMN=ENSTMN S ENHZ(0)=1,ENHZ="ANNUAL" Q
. I $D(ENA("S")),'((ENNXMN-ENSTMN)#6) S ENHZ(0)=1,ENNXMN(0)=$S(ENPMMN>ENNXMN:ENNXMN+12,1:ENNXMN) I (ENNXMN(0)-ENPMMN)<6 S ENHZ="SEMI-ANNUAL" Q
. I $D(ENA("Q")),'((ENNXMN-ENSTMN)#3) S ENHZ(0)=1,ENNXMN(0)=$S(ENPMMN>ENNXMN:ENNXMN+12,1:ENNXMN) I (ENNXMN(0)-ENPMMN)<3 S ENHZ="QUARTERLY" Q
. I $D(ENA("BM")),'((ENNXMN-ENSTMN)#2) S ENHZ(0)=1,ENNXMN(0)=$S(ENPMMN>ENNXMN:ENNXMN+12,1:ENNXMN) I (ENNXMN(0)-ENPMMN)<2 S ENHZ="BI-MONTHLY" Q
. S ENNXMN=1+(ENNXMN#12) S:ENNXMN=1 ENPMYR("C")=ENPMYR("C")+1
;
Q:$G(ENHZ)="" Q:(ENHZ="ANNUAL"&(ENNXMN=ENPMMN)) ; return to ENEQPMR4, STARTING DATE is probably OK
I $D(^ENG(6914,ENDA,6)) D Q:ENHZ="DONE" ;strange result (exception)
. ; check for posting of a future PM (will set ENHZ)
. S:$L(ENNXMN)=1 ENNXMN="0"_ENNXMN S ENPMWO("P")="PM-"_ENSHABR_$E(ENPMYR("C")-1700,2,3)_ENNXMN_"M"
. S I=0 F S I=$O(^ENG(6914,ENDA,6,I)) Q:'I!(ENHZ="DONE") I $P(^(I,0),U,2)[ENPMWO("P") S ENHZ="DONE"
;
S ENPMN=$P($G(^ENG(6914,ENDA,3)),U,6)
W !!,"Equipment entry # "_ENDA W:ENPMN]"" " (PM# ",ENPMN,") " W " is in the scheduled PMI program of the",!,ENSHOP_" shop."
W !,"The next scheduled event is a" W:ENHZ="ANNUAL" "n" W " "_ENHZ_" PMI in ",$P("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",ENNXMN),", "_ENPMYR("C")_"."
SDPM71 W !!,"Would you like to change the PM schedule (at least the STARTING MONTH)",!,"for this device at this time"
S %=2 D YN^DICN I %=1 S DIE="^ENG(6914,",DA=ENDA,ENXP=1,ENOLSHOP=ENSHOP D XNPMSE^ENEQPMP S ENSHOP=ENOLSHOP K ENOLSHOP Q ; return to ENEQPMR4
I %=0 W !,"You may wish to change the STARTING MONTH so that you don't perform",!,"one PMI on the heels of another. It's your call." G SDPM71
;
Q ; return to ENEQPMR4
;ENEQPMR5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQPMR5 4423 printed Dec 13, 2024@01:52:50 Page 2
ENEQPMR5 ;(WASH ISC)/DH-Single PMI's ;2.26.98
+1 ;;7.0;ENGINEERING;**14,35,48**;Aug 17, 1993
SDPM4 ;pm work order not to be retained
IF ENDEL'="N"
Begin DoDot:1
+1 KILL DD,DO
SET DIC="^ENG(6920,"
SET DIC(0)="LX"
SET X=ENPMWO
+2 DO FILE^DICN
SET DA=+Y
End DoDot:1
if DA'>0
QUIT
GOTO SDPM41
+3 ; retain pm work order
+4 FOR I=1:1
SET J=$SELECT($LENGTH(I)=1:"00"_I,$LENGTH(I)=2:"0"_I,1:I)
SET ENPMWO(0)=ENPMWO_"-"_J
IF '$DATA(^ENG(6920,"B",ENPMWO(0)))
IF '$DATA(^ENG(6920,"H",ENPMWO(0)))
QUIT
+5 LOCK +^ENG(6920,"B")
+6 FOR
if '$DATA(^ENG(6920,"B",ENPMWO(0)))
QUIT
SET J=$PIECE(ENPMWO(0),"-",3)+1
SET J=$SELECT($LENGTH(J)=1:"00"_J,$LENGTH(J)=2:"0"_J,1:J)
SET ENPMWO(0)=$PIECE(ENPMWO(0),"-",1,2)_"-"_J
+7 KILL DD,DO
SET DIC="^ENG(6920,"
SET DIC(0)="LX"
SET X=ENPMWO(0)
DO FILE^DICN
SET DA=+Y
+8 LOCK -^ENG(6920,"B")
if DA'>0
QUIT
+9 ;
SDPM41 SET DIE="^ENG(6920,"
SET DR=".05///^S X=$S($D(ENPMWO(0)):ENPMWO(0),1:ENPMWO);1///^S X=DT;9///^S X=ENSHKEY;10///^S X=DT;18///^S X=ENDA;39///^S X=""OFF-SCHEDULE PMI"""
DO ^DIE
+1 SET ^ENG(6920,DA,8,0)="^6920.035^1^1"
SET DIE="^ENG(6920,DA(1),8,"
SET (ENOLDDA,DA(1))=DA
SET DA=1
SET DR=".01///^S X=""PREVENTIVE MAINTENANCE"""
DO ^DIE
KILL DA,DR
SET DIE="^ENG(6920,"
SET DA=ENOLDDA
KILL ENOLDDA
+2 ;
SDPM42 ;pm work order deleted within ^DIE
SET DR=$SELECT($DATA(^DIE("B","ENZPMCLOSE")):"[ENZPMCLOSE]",1:"[ENPMCLOSE]")
DO ^DIE
if '$DATA(DA)
QUIT
+1 ;
SDPM43 IF $PIECE($GET(^ENG(6920,DA,5)),U,2)=""
Begin DoDot:1
+1 WRITE !,*7,"You need to enter a DATE COMPLETE in order to post this PM work order. My",!,"guess is that you should re-edit to either enter a DATE COMPLETE or to delete"
+2 WRITE !,"the work order ('@' in response to first prompt).",!,"Am I right"
SET %=1
DO YN^DICN
End DoDot:1
if %=1
GOTO SDPM42
if %'=2
GOTO SDPM43
+3 ;
SDPM44 IF $PIECE($GET(^ENG(6920,DA,5)),U,2)]""
IF $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
Begin DoDot:1
+1 DO PMHRS^ENEQPMR4
DO PMINV^ENEQPMR4
SET ENCLOSE=$PIECE(^ENG(6920,DA,5),U,2)
+2 IF ENDEL="Y"
SET DIK="^ENG(6920,"
DO ^DIK
KILL DIK
End DoDot:1
+3 ;return control to ENEQPMR4
if '$GET(ENCLOSE)!(ENPM'="M")
QUIT
+4 ;
SDPM5 ; should user change the STARTING MONTH (or maybe YEAR)
+1 ;nothing to look at
if '$DATA(ENDA)
QUIT
+2 SET ENRS=$ORDER(^ENG(6914,ENDA,4,"B",ENSHKEY,0))
+3 ;shop doesn't normally do pm
if 'ENRS
QUIT
+4 ;build frequency array
KILL ENA
SET I=0
FOR
SET I=$ORDER(^ENG(6914,ENDA,4,ENRS,2,I))
if 'I
QUIT
SET ENA($PIECE(^(I,0),U))=$PIECE(^(0),U,6)
+5 ;no need to change STARTING MONTH if MONTHLY on file
if $DATA(ENA("M"))
QUIT
+6 FOR I="TA","BA"
IF $DATA(ENA(I))
IF ENA(I)=""
KILL ENA(I)
+7 SET ENPMYR("C")=ENPMYR
SET ENSTMN=$SELECT($DATA(^ENG(6914,ENDA,4,ENRS,1)):^(1),1:1)
SET I=0
if ENSTMN=""
SET ENSTMN=1
SDPM51 KILL ENHZ
SET ENNXMN=1+(ENPMMN#12)
if ENPMMN=12
SET ENPMYR("C")=ENPMYR("C")+1
+1 FOR
Begin DoDot:1
+2 IF $DATA(ENA("TA"))
IF '((ENPMYR("C")-ENA("TA"))#3)
IF ENNXMN=ENSTMN
SET ENHZ(0)=1
SET ENHZ="TRI-ANNUAL"
QUIT
+3 IF $DATA(ENA("BA"))
IF '((ENPMYR("C")-ENA("BA"))#2)
IF ENNXMN=ENSTMN
SET ENHZ(0)=1
SET ENHZ="BI-ANNUAL"
QUIT
+4 IF $DATA(ENA("A"))
IF ENNXMN=ENSTMN
SET ENHZ(0)=1
SET ENHZ="ANNUAL"
QUIT
+5 IF $DATA(ENA("S"))
IF '((ENNXMN-ENSTMN)#6)
SET ENHZ(0)=1
SET ENNXMN(0)=$SELECT(ENPMMN>ENNXMN:ENNXMN+12,1:ENNXMN)
IF (ENNXMN(0)-ENPMMN)<6
SET ENHZ="SEMI-ANNUAL"
QUIT
+6 IF $DATA(ENA("Q"))
IF '((ENNXMN-ENSTMN)#3)
SET ENHZ(0)=1
SET ENNXMN(0)=$SELECT(ENPMMN>ENNXMN:ENNXMN+12,1:ENNXMN)
IF (ENNXMN(0)-ENPMMN)<3
SET ENHZ="QUARTERLY"
QUIT
+7 IF $DATA(ENA("BM"))
IF '((ENNXMN-ENSTMN)#2)
SET ENHZ(0)=1
SET ENNXMN(0)=$SELECT(ENPMMN>ENNXMN:ENNXMN+12,1:ENNXMN)
IF (ENNXMN(0)-ENPMMN)<2
SET ENHZ="BI-MONTHLY"
QUIT
+8 SET ENNXMN=1+(ENNXMN#12)
if ENNXMN=1
SET ENPMYR("C")=ENPMYR("C")+1
End DoDot:1
if $GET(ENHZ(0))!((ENNXMN=ENPMMN)&('$DATA(ENA("TA")))&('$DATA(ENA("BA"))))
QUIT
if ENPMYR("C")>(ENPMYR+4)
QUIT
+9 ;
+10 ; return to ENEQPMR4, STARTING DATE is probably OK
if $GET(ENHZ)=""
QUIT
if (ENHZ="ANNUAL"&(ENNXMN=ENPMMN))
QUIT
+11 ;strange result (exception)
IF $DATA(^ENG(6914,ENDA,6))
Begin DoDot:1
+12 ; check for posting of a future PM (will set ENHZ)
+13 if $LENGTH(ENNXMN)=1
SET ENNXMN="0"_ENNXMN
SET ENPMWO("P")="PM-"_ENSHABR_$EXTRACT(ENPMYR("C")-1700,2,3)_ENNXMN_"M"
+14 SET I=0
FOR
SET I=$ORDER(^ENG(6914,ENDA,6,I))
if 'I!(ENHZ="DONE")
QUIT
IF $PIECE(^(I,0),U,2)[ENPMWO("P")
SET ENHZ="DONE"
End DoDot:1
if ENHZ="DONE"
QUIT
+15 ;
+16 SET ENPMN=$PIECE($GET(^ENG(6914,ENDA,3)),U,6)
+17 WRITE !!,"Equipment entry # "_ENDA
if ENPMN]""
WRITE " (PM# ",ENPMN,") "
WRITE " is in the scheduled PMI program of the",!,ENSHOP_" shop."
+18 WRITE !,"The next scheduled event is a"
if ENHZ="ANNUAL"
WRITE "n"
WRITE " "_ENHZ_" PMI in ",$PIECE("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",ENNXMN),", "_ENPMYR("C")_"."
SDPM71 WRITE !!,"Would you like to change the PM schedule (at least the STARTING MONTH)",!,"for this device at this time"
+1 ; return to ENEQPMR4
SET %=2
DO YN^DICN
IF %=1
SET DIE="^ENG(6914,"
SET DA=ENDA
SET ENXP=1
SET ENOLSHOP=ENSHOP
DO XNPMSE^ENEQPMP
SET ENSHOP=ENOLSHOP
KILL ENOLSHOP
QUIT
+2 IF %=0
WRITE !,"You may wish to change the STARTING MONTH so that you don't perform",!,"one PMI on the heels of another. It's your call."
GOTO SDPM71
+3 ;
+4 ; return to ENEQPMR4
QUIT
+5 ;ENEQPMR5
