- 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 Feb 18, 2025@23:19:14 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