- ENX3IPS ;WIRMFO/DH-POST-INIT ;2.23.98
- ;;7.0;ENGINEERING;**48**;Aug 17, 1993
- ;
- 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!
- N DA,NEWID
- D BMES^XPDUTL("Converting equipment maintenance histories")
- 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
- . W:'(DA#20) "."
- . I $E(^ENG(6914,DA,6,DA(1),0))=0 D Q
- . . S ENRN=(9999999-(3_$E(^ENG(6914,DA,6,DA(1),0),1,6)))*10
- . . S ^ENG(6914,DA,6,ENRN,0)=3_^ENG(6914,DA,6,DA(1),0)
- . . K ^ENG(6914,DA,6,DA(1)) ;no x-refs
- . S ^ENG(6914,DA,6,DA(1),0)=2_^ENG(6914,DA,6,DA(1),0)
- ;
- D BMES^XPDUTL("Converting Accident Report LOCAL ENGINEERING #s ...")
- S DIE="^ENG(""FSA"",",DA=0 F S DA=$O(^ENG("FSA",DA)) Q:'DA D
- . W:'(DA#20) "."
- . S NEWID="19"_$P($G(^ENG("FSA",DA,0)),U)
- . I NEWID?8N S DR=".01///^S X=NEWID" D ^DIE
- ; now increment length of LOCAL ENGINEERING #
- S DA(1)=$O(^ENG(6910.9,"B","ENFSA1",0)) Q:'DA(1)
- S DA=$O(^ENG(6910.9,DA(1),1,"B","LOCAL ENGINEERING #(R)",0)) Q:'DA
- S DIE="^ENG(6910.9,"_DA(1)_",1,",DR=".03///^S X=8" D ^DIE
- ;
- BERS D BMES^XPDUTL("Converting BERS Survey File (#6916)")
- N NEWID,FY
- S DIE="^ENGS(6916,",DA=0 F S DA=$O(^ENGS(6916,DA)) Q:'DA D
- . Q:$P(^ENGS(6916,DA,0),U)["-"
- . S NEWID="19"_$E($P(^ENGS(6916,DA,0),U),1,2)_"-"_$E($P(^(0),U),3,5)
- . S DR=".01///^S X=NEWID" D ^DIE
- . S FY=$P(^ENGS(6916,DA,0),U,4) I FY?2N S DR="4///^S X=""19""_FY" D ^DIE
- . W "."
- Q
- ;ENX3IPS
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENX3IPS 1522 printed Mar 13, 2025@21:01:15 Page 2
- ENX3IPS ;WIRMFO/DH-POST-INIT ;2.23.98
- +1 ;;7.0;ENGINEERING;**48**;Aug 17, 1993
- +2 ;
- +3 ;No need to do this more than once!
- IF $$PATCH^XPDUTL("EN*7.0*48")
- DO BMES^XPDUTL("Post-initialization has already been done.")
- QUIT
- +4 NEW DA,NEWID
- +5 DO BMES^XPDUTL("Converting equipment maintenance histories")
- +6 SET DA=0
- FOR
- SET DA=$ORDER(^ENG(6914,DA))
- if 'DA
- QUIT
- SET DA(1)=0
- FOR
- SET DA(1)=$ORDER(^ENG(6914,DA,6,DA(1)))
- if 'DA(1)
- QUIT
- Begin DoDot:1
- +7 if '(DA#20)
- WRITE "."
- +8 IF $EXTRACT(^ENG(6914,DA,6,DA(1),0))=0
- Begin DoDot:2
- +9 SET ENRN=(9999999-(3_$EXTRACT(^ENG(6914,DA,6,DA(1),0),1,6)))*10
- +10 SET ^ENG(6914,DA,6,ENRN,0)=3_^ENG(6914,DA,6,DA(1),0)
- +11 ;no x-refs
- KILL ^ENG(6914,DA,6,DA(1))
- End DoDot:2
- QUIT
- +12 SET ^ENG(6914,DA,6,DA(1),0)=2_^ENG(6914,DA,6,DA(1),0)
- End DoDot:1
- +13 ;
- +14 DO BMES^XPDUTL("Converting Accident Report LOCAL ENGINEERING #s ...")
- +15 SET DIE="^ENG(""FSA"","
- SET DA=0
- FOR
- SET DA=$ORDER(^ENG("FSA",DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +16 if '(DA#20)
- WRITE "."
- +17 SET NEWID="19"_$PIECE($GET(^ENG("FSA",DA,0)),U)
- +18 IF NEWID?8N
- SET DR=".01///^S X=NEWID"
- DO ^DIE
- End DoDot:1
- +19 ; now increment length of LOCAL ENGINEERING #
- +20 SET DA(1)=$ORDER(^ENG(6910.9,"B","ENFSA1",0))
- if 'DA(1)
- QUIT
- +21 SET DA=$ORDER(^ENG(6910.9,DA(1),1,"B","LOCAL ENGINEERING #(R)",0))
- if 'DA
- QUIT
- +22 SET DIE="^ENG(6910.9,"_DA(1)_",1,"
- SET DR=".03///^S X=8"
- DO ^DIE
- +23 ;
- BERS DO BMES^XPDUTL("Converting BERS Survey File (#6916)")
- +1 NEW NEWID,FY
- +2 SET DIE="^ENGS(6916,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ENGS(6916,DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +3 if $PIECE(^ENGS(6916,DA,0),U)["-"
- QUIT
- +4 SET NEWID="19"_$EXTRACT($PIECE(^ENGS(6916,DA,0),U),1,2)_"-"_$EXTRACT($PIECE(^(0),U),3,5)
- +5 SET DR=".01///^S X=NEWID"
- DO ^DIE
- +6 SET FY=$PIECE(^ENGS(6916,DA,0),U,4)
- IF FY?2N
- SET DR="4///^S X=""19""_FY"
- DO ^DIE
- +7 WRITE "."
- End DoDot:1
- +8 QUIT
- +9 ;ENX3IPS
