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 Oct 16, 2024@17:57:23 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
