- 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 Mar 13, 2025@20:57:12 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
