source: FOIAVistA/trunk/r/ENGINEERING-EN/ENX3IPS.m@ 802

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

initial load of FOIAVistA 6/30/08 version

File size: 1.5 KB
Line 
1ENX3IPS ;WIRMFO/DH-POST-INIT ;2.23.98
2 ;;7.0;ENGINEERING;**48**;Aug 17, 1993
3 ;
4 I $$PATCH^XPDUTL("EN*7.0*48") D BMES^XPDUTL("Post-initialization has already been done.") Q ;No need to do this more than once!
5 N DA,NEWID
6 D BMES^XPDUTL("Converting equipment maintenance histories")
7 S DA=0 F S DA=$O(^ENG(6914,DA)) Q:'DA S DA(1)=0 F S DA(1)=$O(^ENG(6914,DA,6,DA(1))) Q:'DA(1) D
8 . W:'(DA#20) "."
9 . I $E(^ENG(6914,DA,6,DA(1),0))=0 D Q
10 . . S ENRN=(9999999-(3_$E(^ENG(6914,DA,6,DA(1),0),1,6)))*10
11 . . S ^ENG(6914,DA,6,ENRN,0)=3_^ENG(6914,DA,6,DA(1),0)
12 . . K ^ENG(6914,DA,6,DA(1)) ;no x-refs
13 . S ^ENG(6914,DA,6,DA(1),0)=2_^ENG(6914,DA,6,DA(1),0)
14 ;
15 D BMES^XPDUTL("Converting Accident Report LOCAL ENGINEERING #s ...")
16 S DIE="^ENG(""FSA"",",DA=0 F S DA=$O(^ENG("FSA",DA)) Q:'DA D
17 . W:'(DA#20) "."
18 . S NEWID="19"_$P($G(^ENG("FSA",DA,0)),U)
19 . I NEWID?8N S DR=".01///^S X=NEWID" D ^DIE
20 ; now increment length of LOCAL ENGINEERING #
21 S DA(1)=$O(^ENG(6910.9,"B","ENFSA1",0)) Q:'DA(1)
22 S DA=$O(^ENG(6910.9,DA(1),1,"B","LOCAL ENGINEERING #(R)",0)) Q:'DA
23 S DIE="^ENG(6910.9,"_DA(1)_",1,",DR=".03///^S X=8" D ^DIE
24 ;
25BERS D BMES^XPDUTL("Converting BERS Survey File (#6916)")
26 N NEWID,FY
27 S DIE="^ENGS(6916,",DA=0 F S DA=$O(^ENGS(6916,DA)) Q:'DA D
28 . Q:$P(^ENGS(6916,DA,0),U)["-"
29 . S NEWID="19"_$E($P(^ENGS(6916,DA,0),U),1,2)_"-"_$E($P(^(0),U),3,5)
30 . S DR=".01///^S X=NEWID" D ^DIE
31 . S FY=$P(^ENGS(6916,DA,0),U,4) I FY?2N S DR="4///^S X=""19""_FY" D ^DIE
32 . W "."
33 Q
34 ;ENX3IPS
Note: See TracBrowser for help on using the repository browser.