source: FOIAVistA/trunk/r/ENGINEERING-EN/ENEQMED2.m@ 876

Last change on this file since 876 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1ENEQMED2 ;WISC/SAB-Multiple Equipment Edit, continued ;9/24/97
2 ;;7.0;ENGINEERING;**35,39,45**;Aug 17, 1993
3UPD ; update equipment
4 S DIR(0)="Y",DIR("A")="OK to update the "_ENC("SEL")_" selected items"
5 D ^DIR K DIR G:$D(DIRUT)!'Y EXIT
6 ;
7 S ENDA=0 F S ENDA=$O(^TMP($J,"ENSEL",ENDA)) Q:'ENDA D
8 . ; lock individual item when not locking as batch; skip if unable
9 . I 'ENLOCK("BATCH") L +^ENG(6914,ENDA):1 I '$T D Q
10 . . S ^TMP($J,"ENLCK",ENDA)="" ; put skipped equipment on list
11 . S ENFLD=0 F S ENFLD=$O(^TMP($J,"ENFLD",ENFLD)) Q:'ENFLD D
12 . . S ENFLDN=$$GET1^DID(6914,ENFLD,"","LABEL")
13 . . S ENVALI=$P(^TMP($J,"ENFLD",ENFLD),U)
14 . . I ENFLD=30 D Q ; pm data
15 . . . ; delete old PM data (if any)
16 . . . S ENDAPM=0 F S ENDAPM=$O(^ENG(6914,ENDA,4,ENDAPM)) Q:'ENDAPM D
17 . . . . K DA S DA(1)=ENDA,DA=ENDAPM,DIK="^ENG(6914,"_ENDA_",4,"
18 . . . . D ^DIK K DIK
19 . . . ; move new PM data via %RCR
20 . . . S ENDAT=$G(^TMP($J,"ENFLD",30)) Q:'ENDAT
21 . . . S %X="^ENG(6914,"_ENDAT_",4,",%Y="^ENG(6914,"_ENDA_",4,"
22 . . . D %XY^%RCR
23 . . . ; reindex PM data
24 . . . S ENDAPM=0 F S ENDAPM=$O(^ENG(6914,ENDA,ENDAPM)) Q:'ENDAPM D
25 . . . . K DA S DA(1)=ENDA,DA=ENDAPM,DIK="^ENG(6914,"_ENDA_",4,"
26 . . . . D IX1^DIK K DIK
27 . . I ENFLD=40 D Q ; comments
28 . . . D WP^DIE(6914,ENDA_",",40,"A","^TMP($J,""ENCOM"")","ENERR()")
29 . . I ENFLD=70 D Q ; spex
30 . . . D WP^DIE(6914,ENDA_",",70,"A","^TMP($J,""ENSPEX"")","ENERR()")
31 . . I ENVALI']"" S ENVALI=$P($G(^TMP($J,"ENFLD",ENFLD,ENDA)),U)
32 . . I ENVALI']"" Q
33 . . I ENFLD=2,ENVALI=ENDA Q ; can't be it's own parent
34 . . S DA=ENDA,DIE=6914,DR=ENFLD_$S(ENVALI]"":"////^S X=ENVALI",1:"")
35 . . D ^DIE K DIE
36 . ; did both life expectency and CSN get updated?
37 . I $D(^TMP($J,"ENFLD",15)),$D(^TMP($J,"ENFLD",18)) D
38 . . ; must redo life expectancy because CSN trigger overwrote
39 . . S ENVALI=$P(^TMP($J,"ENFLD",15),U)
40 . . I ENVALI']"" Q
41 . . S DA=ENDA,DIE=6914,DR="15////^S X=ENVALI"
42 . . D ^DIE K DIE
43 . ; unlock individual item when not locking as batch
44 . I 'ENLOCK("BATCH") L -^ENG(6914,ENDA)
45 . W "."
46 I $D(^TMP($J,"ENLCK")) D
47 . W $C(7),!!,"Warning: Some of the selected equipment could not be"
48 . W !,"updated because it was being being edited by another process."
49 . W !,"These equipment items will need to be edited to make the"
50 . W !,"desired changes. Print the report for more information.",!
51 . S DIR("B")="YES"
52 S DIR(0)="Y",DIR("A")="Would you like a list of modified equipment"
53 D ^DIR K DIR G:$D(DIRUT)!'Y EXIT
54 D EN^ENEQMED3
55EXIT ;
56 ; delete dummy record created for PM data (if any)
57 I $G(ENDAT)>90000000000 D
58 . ; delete responsible shops to clean up AB x-ref
59 . S ENDAPM=0 F S ENDAPM=$O(^ENG(6914,ENDAT,4,ENDAPM)) Q:'ENDAPM D
60 . . K DA S DA(1)=ENDAT,DA=ENDAPM,DIK="^ENG(6914,"_ENDAT_",4,"
61 . . D ^DIK K DIK
62 . ; delete renamining data (wasn't created via FileMan so don't use now)
63 . K ^ENG(6914,ENDAT)
64 . L -^ENG(6914,ENDAT)
65 ; unlock selected equipment (if any)
66 I $G(ENLOCK("BATCH")) D
67 . S ENDA=0
68 . F S ENDA=$O(^TMP($J,"ENSEL",ENDA)) Q:'ENDA L -^ENG(6914,ENDA)
69 ; clean up variables
70 K ^TMP($J)
71 K %X,%Y,DA,DIC,DIQ,DIWESUB,DR,DUOUT,DTOUT,DIRUT,DIROUT,X,Y
72 K ENA,ENASK,ENC,ENCAT,ENCATI,ENDA,ENDAPM,ENDAT,ENDX,ENEDNX
73 K ENFA,ENFLD,ENFLDN,ENGOT,ENI,ENL,ENLOCK,ENMAN,ENMANI
74 K ENMOD,ENNX,ENPO,ENVALE,ENVALI,ENX,ENXP
75 Q
76 ;ENEQMED2
Note: See TracBrowser for help on using the repository browser.