ENEQMED2 ;WISC/SAB-Multiple Equipment Edit, continued ;9/24/97
;;7.0;ENGINEERING;**35,39,45**;Aug 17, 1993
UPD ; update equipment
S DIR(0)="Y",DIR("A")="OK to update the "_ENC("SEL")_" selected items"
D ^DIR K DIR G:$D(DIRUT)!'Y EXIT
;
S ENDA=0 F S ENDA=$O(^TMP($J,"ENSEL",ENDA)) Q:'ENDA D
. ; lock individual item when not locking as batch; skip if unable
. I 'ENLOCK("BATCH") L +^ENG(6914,ENDA):1 I '$T D Q
. . S ^TMP($J,"ENLCK",ENDA)="" ; put skipped equipment on list
. S ENFLD=0 F S ENFLD=$O(^TMP($J,"ENFLD",ENFLD)) Q:'ENFLD D
. . S ENFLDN=$$GET1^DID(6914,ENFLD,"","LABEL")
. . S ENVALI=$P(^TMP($J,"ENFLD",ENFLD),U)
. . I ENFLD=30 D Q ; pm data
. . . ; delete old PM data (if any)
. . . S ENDAPM=0 F S ENDAPM=$O(^ENG(6914,ENDA,4,ENDAPM)) Q:'ENDAPM D
. . . . K DA S DA(1)=ENDA,DA=ENDAPM,DIK="^ENG(6914,"_ENDA_",4,"
. . . . D ^DIK K DIK
. . . ; move new PM data via %RCR
. . . S ENDAT=$G(^TMP($J,"ENFLD",30)) Q:'ENDAT
. . . S %X="^ENG(6914,"_ENDAT_",4,",%Y="^ENG(6914,"_ENDA_",4,"
. . . D %XY^%RCR
. . . ; reindex PM data
. . . S ENDAPM=0 F S ENDAPM=$O(^ENG(6914,ENDA,ENDAPM)) Q:'ENDAPM D
. . . . K DA S DA(1)=ENDA,DA=ENDAPM,DIK="^ENG(6914,"_ENDA_",4,"
. . . . D IX1^DIK K DIK
. . I ENFLD=40 D Q ; comments
. . . D WP^DIE(6914,ENDA_",",40,"A","^TMP($J,""ENCOM"")","ENERR()")
. . I ENFLD=70 D Q ; spex
. . . D WP^DIE(6914,ENDA_",",70,"A","^TMP($J,""ENSPEX"")","ENERR()")
. . I ENVALI']"" S ENVALI=$P($G(^TMP($J,"ENFLD",ENFLD,ENDA)),U)
. . I ENVALI']"" Q
. . I ENFLD=2,ENVALI=ENDA Q ; can't be it's own parent
. . S DA=ENDA,DIE=6914,DR=ENFLD_$S(ENVALI]"":"////^S X=ENVALI",1:"")
. . D ^DIE K DIE
. ; did both life expectency and CSN get updated?
. I $D(^TMP($J,"ENFLD",15)),$D(^TMP($J,"ENFLD",18)) D
. . ; must redo life expectancy because CSN trigger overwrote
. . S ENVALI=$P(^TMP($J,"ENFLD",15),U)
. . I ENVALI']"" Q
. . S DA=ENDA,DIE=6914,DR="15////^S X=ENVALI"
. . D ^DIE K DIE
. ; unlock individual item when not locking as batch
. I 'ENLOCK("BATCH") L -^ENG(6914,ENDA)
. W "."
I $D(^TMP($J,"ENLCK")) D
. W $C(7),!!,"Warning: Some of the selected equipment could not be"
. W !,"updated because it was being being edited by another process."
. W !,"These equipment items will need to be edited to make the"
. W !,"desired changes. Print the report for more information.",!
. S DIR("B")="YES"
S DIR(0)="Y",DIR("A")="Would you like a list of modified equipment"
D ^DIR K DIR G:$D(DIRUT)!'Y EXIT
D EN^ENEQMED3
EXIT ;
; delete dummy record created for PM data (if any)
I $G(ENDAT)>90000000000 D
. ; delete responsible shops to clean up AB x-ref
. S ENDAPM=0 F S ENDAPM=$O(^ENG(6914,ENDAT,4,ENDAPM)) Q:'ENDAPM D
. . K DA S DA(1)=ENDAT,DA=ENDAPM,DIK="^ENG(6914,"_ENDAT_",4,"
. . D ^DIK K DIK
. ; delete renamining data (wasn't created via FileMan so don't use now)
. K ^ENG(6914,ENDAT)
. L -^ENG(6914,ENDAT)
; unlock selected equipment (if any)
I $G(ENLOCK("BATCH")) D
. S ENDA=0
. F S ENDA=$O(^TMP($J,"ENSEL",ENDA)) Q:'ENDA L -^ENG(6914,ENDA)
; clean up variables
K ^TMP($J)
K %X,%Y,DA,DIC,DIQ,DIWESUB,DR,DUOUT,DTOUT,DIRUT,DIROUT,X,Y
K ENA,ENASK,ENC,ENCAT,ENCATI,ENDA,ENDAPM,ENDAT,ENDX,ENEDNX
K ENFA,ENFLD,ENFLDN,ENGOT,ENI,ENL,ENLOCK,ENMAN,ENMANI
K ENMOD,ENNX,ENPO,ENVALE,ENVALI,ENX,ENXP
Q
;ENEQMED2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQMED2 3371 printed Nov 22, 2024@17:02:41 Page 2
ENEQMED2 ;WISC/SAB-Multiple Equipment Edit, continued ;9/24/97
+1 ;;7.0;ENGINEERING;**35,39,45**;Aug 17, 1993
UPD ; update equipment
+1 SET DIR(0)="Y"
SET DIR("A")="OK to update the "_ENC("SEL")_" selected items"
+2 DO ^DIR
KILL DIR
if $DATA(DIRUT)!'Y
GOTO EXIT
+3 ;
+4 SET ENDA=0
FOR
SET ENDA=$ORDER(^TMP($JOB,"ENSEL",ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+5 ; lock individual item when not locking as batch; skip if unable
+6 IF 'ENLOCK("BATCH")
LOCK +^ENG(6914,ENDA):1
IF '$TEST
Begin DoDot:2
+7 ; put skipped equipment on list
SET ^TMP($JOB,"ENLCK",ENDA)=""
End DoDot:2
QUIT
+8 SET ENFLD=0
FOR
SET ENFLD=$ORDER(^TMP($JOB,"ENFLD",ENFLD))
if 'ENFLD
QUIT
Begin DoDot:2
+9 SET ENFLDN=$$GET1^DID(6914,ENFLD,"","LABEL")
+10 SET ENVALI=$PIECE(^TMP($JOB,"ENFLD",ENFLD),U)
+11 ; pm data
IF ENFLD=30
Begin DoDot:3
+12 ; delete old PM data (if any)
+13 SET ENDAPM=0
FOR
SET ENDAPM=$ORDER(^ENG(6914,ENDA,4,ENDAPM))
if 'ENDAPM
QUIT
Begin DoDot:4
+14 KILL DA
SET DA(1)=ENDA
SET DA=ENDAPM
SET DIK="^ENG(6914,"_ENDA_",4,"
+15 DO ^DIK
KILL DIK
End DoDot:4
+16 ; move new PM data via %RCR
+17 SET ENDAT=$GET(^TMP($JOB,"ENFLD",30))
if 'ENDAT
QUIT
+18 SET %X="^ENG(6914,"_ENDAT_",4,"
SET %Y="^ENG(6914,"_ENDA_",4,"
+19 DO %XY^%RCR
+20 ; reindex PM data
+21 SET ENDAPM=0
FOR
SET ENDAPM=$ORDER(^ENG(6914,ENDA,ENDAPM))
if 'ENDAPM
QUIT
Begin DoDot:4
+22 KILL DA
SET DA(1)=ENDA
SET DA=ENDAPM
SET DIK="^ENG(6914,"_ENDA_",4,"
+23 DO IX1^DIK
KILL DIK
End DoDot:4
End DoDot:3
QUIT
+24 ; comments
IF ENFLD=40
Begin DoDot:3
+25 DO WP^DIE(6914,ENDA_",",40,"A","^TMP($J,""ENCOM"")","ENERR()")
End DoDot:3
QUIT
+26 ; spex
IF ENFLD=70
Begin DoDot:3
+27 DO WP^DIE(6914,ENDA_",",70,"A","^TMP($J,""ENSPEX"")","ENERR()")
End DoDot:3
QUIT
+28 IF ENVALI']""
SET ENVALI=$PIECE($GET(^TMP($JOB,"ENFLD",ENFLD,ENDA)),U)
+29 IF ENVALI']""
QUIT
+30 ; can't be it's own parent
IF ENFLD=2
IF ENVALI=ENDA
QUIT
+31 SET DA=ENDA
SET DIE=6914
SET DR=ENFLD_$SELECT(ENVALI]"":"////^S X=ENVALI",1:"")
+32 DO ^DIE
KILL DIE
End DoDot:2
+33 ; did both life expectency and CSN get updated?
+34 IF $DATA(^TMP($JOB,"ENFLD",15))
IF $DATA(^TMP($JOB,"ENFLD",18))
Begin DoDot:2
+35 ; must redo life expectancy because CSN trigger overwrote
+36 SET ENVALI=$PIECE(^TMP($JOB,"ENFLD",15),U)
+37 IF ENVALI']""
QUIT
+38 SET DA=ENDA
SET DIE=6914
SET DR="15////^S X=ENVALI"
+39 DO ^DIE
KILL DIE
End DoDot:2
+40 ; unlock individual item when not locking as batch
+41 IF 'ENLOCK("BATCH")
LOCK -^ENG(6914,ENDA)
+42 WRITE "."
End DoDot:1
+43 IF $DATA(^TMP($JOB,"ENLCK"))
Begin DoDot:1
+44 WRITE $CHAR(7),!!,"Warning: Some of the selected equipment could not be"
+45 WRITE !,"updated because it was being being edited by another process."
+46 WRITE !,"These equipment items will need to be edited to make the"
+47 WRITE !,"desired changes. Print the report for more information.",!
+48 SET DIR("B")="YES"
End DoDot:1
+49 SET DIR(0)="Y"
SET DIR("A")="Would you like a list of modified equipment"
+50 DO ^DIR
KILL DIR
if $DATA(DIRUT)!'Y
GOTO EXIT
+51 DO EN^ENEQMED3
EXIT ;
+1 ; delete dummy record created for PM data (if any)
+2 IF $GET(ENDAT)>90000000000
Begin DoDot:1
+3 ; delete responsible shops to clean up AB x-ref
+4 SET ENDAPM=0
FOR
SET ENDAPM=$ORDER(^ENG(6914,ENDAT,4,ENDAPM))
if 'ENDAPM
QUIT
Begin DoDot:2
+5 KILL DA
SET DA(1)=ENDAT
SET DA=ENDAPM
SET DIK="^ENG(6914,"_ENDAT_",4,"
+6 DO ^DIK
KILL DIK
End DoDot:2
+7 ; delete renamining data (wasn't created via FileMan so don't use now)
+8 KILL ^ENG(6914,ENDAT)
+9 LOCK -^ENG(6914,ENDAT)
End DoDot:1
+10 ; unlock selected equipment (if any)
+11 IF $GET(ENLOCK("BATCH"))
Begin DoDot:1
+12 SET ENDA=0
+13 FOR
SET ENDA=$ORDER(^TMP($JOB,"ENSEL",ENDA))
if 'ENDA
QUIT
LOCK -^ENG(6914,ENDA)
End DoDot:1
+14 ; clean up variables
+15 KILL ^TMP($JOB)
+16 KILL %X,%Y,DA,DIC,DIQ,DIWESUB,DR,DUOUT,DTOUT,DIRUT,DIROUT,X,Y
+17 KILL ENA,ENASK,ENC,ENCAT,ENCATI,ENDA,ENDAPM,ENDAT,ENDX,ENEDNX
+18 KILL ENFA,ENFLD,ENFLDN,ENGOT,ENI,ENL,ENLOCK,ENMAN,ENMANI
+19 KILL ENMOD,ENNX,ENPO,ENVALE,ENVALI,ENX,ENXP
+20 QUIT
+21 ;ENEQMED2
