ATKPROD ; Afstand-toegang voor klanten [ 05/31/2002   9:17 AM ]
 ;
PRIJS(R,Aantal) 
 New I
 If $D(Aantal) Do
 .If $O(R("P",""))=""!'Aantal Set R=$P(R("P"),D)
 .Else  Do
 ..Set I=""
 ..For  Set I=$O(R("P",I),-1) Quit:I=""  Quit:Aantal'<$P(R("P",I),D)
 ..Set R="" Set:I'="" R=$P(R("P",I),D,2)_D_$P(R("P",I),D)
 Else  Do
 .If $O(R("P",""))="" Set R=$$EXTNUM^vhDTyp($P(R("P"),D),0,"T.",2)
 .Else  Do
 ..Set (R,I)=""
 ..For  Set I=$O(R("P",I)) Quit:I=""  Set R=R_$$EXTNUM^vhDTyp($P(R("P",I),D,2),0,"T.",2)_"/"_$P(R("P",I),D)_"   -   "
 ..Set $E(R,$L(R)-6,$L(R))=""
 Quit R
 ;
RPLPR 
 New I,K,R,PRNr,Rubr,Rec,Colom,Count,TTab,TTabName,zb
 Set PRNr=$$GETPROD()
 Quit:'PRNr
 If '$G(^HULP(%J,"RPLPR",PRNr)) Do JOBRPLPR
 If $G(^HULP(%J,"RPLPR",PRNr)) Do
 .New RPLPR
 .Quit:'$D(DL(1))
 .Set TTabName=DL(1)
 .Merge TTab=@DL(1)
 .Set @DL(1)@(7)=@DL(1)@(6),@DL(1)@(4)=1
 .Do WL^PROC
 .Do
 ..New DL
 ..Kill ^HULP(%J,"RPLPR",0)
 ..Set:$D(^HULP(%J,"NEWKLREF",PRNr)) ^HULP(%J,"RPLPR",PRNr,"R")=$P(^HULP(%J,"NEWKLREF",PRNr),D,2)
 ..Do LDINIT^ATK(Input,Taal)
 ..Merge R=^HULP(%J,"RPLPR",PRNr)
 ..Set Rubr="",(Colom,Count)=0
 ..For  Set Rubr=$O(^POP("ATKPROD","D",Rubr)) Quit:Rubr=""  Do
 ...Set R=^POP("ATKPROD","D",Rubr),I=$P(R,D),K=$P(R,D,3,6)
 ...If $L($P(R,D,3)),@$P(R,D,3) Quit
 ...Set R=$$GETTXT^ATK("ATKPROD",Rubr,Taal)
 ...If Rubr="PRIJS",$D(R("P")) Set R=R_" ("_$P(R("P"),D,2)_"/"_$P(R("P"),D,3)_")"
 ...Set:$L(R)>Colom Colom=$L(R)
 ...Set Rubr(I)=R_D_K
 ..Set I=""
 ..For  Set I=$O(Rubr(I)) Quit:I=""  Do
 ...Set K=""
 ...Xecute:$L($P(Rubr(I),D,4)) "Set K="_$P(Rubr(I),D,4)
 ...Xecute:$L($P(Rubr(I),D,5)) "Set K="_$P(Rubr(I),D,5)
 ...Set R=$P(Rubr(I),D),$E(R,Colom+2)=$S($L(R):":",1:" ")_" "_K
 ...If Count+$P(Rubr(I),D,3)>Count For Count=Count+1:1:Count+$P(Rubr(I),D,3) Set ^HULP(%J,"RPLPR",0,Count)=""
 ...Set Count=Count+1,^HULP(%J,"RPLPR",0,Count)=R
RPLPR1 ..Do WL^PROC
 ..Do
 ...New DL
 ...Do MENU^ATKMENU(1)
 ..Set DL(3)=-STimeOut
 ..Do SL^ATK
 ..Kill DL(3)
 ..If $G(zb)="",$G(R)="" Set R="-"
 ..Set Input=R
 ..If Input'="-",Input'="?" Set Input=$$ITRANSL^ATKMENU(Input,Taal)
 ..If Input="?" Do MENU^ATKMENU() Set DL(2)=sRT Goto RPLPR1:Input="?"
 ..Kill ^HULP(%J,"RPLPR",0)
 .Merge @DL(1)=TTab
 .Do ADD^vhScherm(TTab(3)-1,24)
 Quit
 ;
JOBRPLPR 
 New R
 Job RPLPR^ATKJOB(%J,PRNr,KLNr)::LTimeOut
 If $T Set Time=$P($H,",",2) Do
 .For  Quit:$P($H,",",2)-Time>LTimeOut!$G(^HULP(%J,"RPLPR",PRNr))
 .If $P($H,",",2)-Time>LTimeOut Goto TIMEOUT^ATK
 Set R=$$PAKREF(PRNr) Set:$L(R) ^HULP(%J,"RPLPR",PRNr,"R")=R
 Quit
 ;
ISPROD() 
 Quit ''$$GETPROD()
 ;
GETPROD() 
 New R,PRNr
 If $D(DL(1)),@DL(1)@(6) Do
 .Set R=$G(@(@DL(1)@(1)_@DL(1)@(6)_")"))
 .Quit:R=""
 .Set:"\OORDER\CORDER\AORDER\TORDER\BON\"[(D_DL(1)_D) PRNr=$P(R,D,42)
 .Set:"\VERKAN\MOEDERB\OFFERTE\"[(D_DL(1)_D) PRNr=$P(R,D,15)
 .Set:DL(1)="KLREF" PRNr=$P(R,D)
 Quit $G(PRNr)
 ;
GETNAME(Piece) 
 New R,Name
 Set Piece=$G(Piece)
 If Piece'=1,Piece'=2 Set Piece=""
 If $D(DL(1)),@DL(1)@(6) Do
 .Set R=$G(@(@DL(1)@(1)_@DL(1)@(6)_")"))
 .Quit:R=""
 .Set:"\OORDER\CORDER\AORDER\TORDER\BON\"[(D_DL(1)_D) Name=$P(R,D,45)
 .Set:"\VERKAN\MOEDERB\OFFERTE\"[(D_DL(1)_D) Name=$P(R,D,2)
 .Set:DL(1)="KLREF" Name=$P(R,D,3)_"<>"_$P(R,D,2)
 .Set:Piece Name=$P(Name,"<>",Piece)
 Quit $G(Name)
 ;
PUTNAME(NewName,Piece) 
 New R,Name
 Set Piece=$G(Piece)
 If Piece'=1,Piece'=2 Set Piece=""
 If $D(DL(1)),@DL(1)@(6) Do
 .Set R=$G(@(@DL(1)@(1)_@DL(1)@(6)_")"))
 .Quit:R=""
 .Set:"\OORDER\CORDER\AORDER\TORDER\BON\"[(D_DL(1)_D) Name=$P(R,D,45)
 .Set:"\VERKAN\MOEDERB\OFFERTE\"[(D_DL(1)_D) Name=$P(R,D,2)
 .Set:DL(1)="KLREF" Name=$P(R,D,3)_"<>"_$P(R,D,2)
 .If Piece Set $P(Name,"<>",Piece)=NewName
 .Else  Set Name=NewName
 .Set:"\OORDER\CORDER\AORDER\TORDER\BON\"[(D_DL(1)_D) $P(R,D,45)=Name
 .Set:"\VERKAN\MOEDERB\OFFERTE\"[(D_DL(1)_D) $P(R,D,2)=Name
 .Set:DL(1)="KLREF" $P(R,D,2)=$P(Name,"<>",2),$P(R,D,3)=$P(Name,"<>")
 .Set @(@DL(1)@(1)_@DL(1)@(6)_")")=R
 Quit
 ;
MODNAME() 
 New PRNr,Name,Modify,Next,Quit,PakNr
 Set PRNr=$$GETPROD()
 If PRNr Do
 .Set PakNr=$O(^HULP(%J,"KLREF","PRNR",PRNr,"")),Quit=$O(^HULP(%J,"KLREF","PRNR",PRNr,PakNr))'=""
 .Quit:Quit
 .Set PRNr=""
 .If PakNr For  Set PRNr=$O(^HULP(%J,"KLREF","PAKNR",PakNr,PRNr)) Quit:PRNr=""  Do  Quit:Quit
 ..Do
 ...New PakNr
 ...Set PakNr=$O(^HULP(%J,"KLREF","PRNR",PRNr,"")),Quit=$O(^HULP(%J,"KLREF","PRNR",PRNr,PakNr))'=""
 .Quit:Quit
 .If DL(1)="KLREF" Do  Quit:$G(Quit)
 ..Set R=$G(@(@DL(1)@(1)_@DL(1)@(6)_")")),PakNr=$P(R,D,5)
 ..Quit:'PakNr
 ..Set PRNr=$O(^HULP(%J,"KLREF","PAKNR",PakNr,"")),Quit=$O(^HULP(%J,"KLREF","PAKNR",PakNr,PRNr))'=""
 .Set Name=$$GETNAME(2),Modify=Name'[" & "
 Quit $G(Modify)
 ;
VERPAK(Value) 
 Set Value=$P(Value,D,3)_D_$P(Value,D,2)_D_$P(Value,D)
 Set:'$P(Value,D,3) $P(Value,D,2,3)=$P(Value,D,2)
 Set:'$P(Value,D,2) $P(Value,D,1,2)=$P(Value,D)
 Set:$E(Value)=D Value=$E(Value,2,99) Set:$E(Value,$L(Value))=D Value=$E(Value,1,$L(Value)-1)
 Quit $TR(Value,D,"/")
 ;
FMTKLREF(Value) 
 For  Quit:Value'[D  Set Value=$P(Value,D)_" & "_$P(Value,D,2,99)
 Quit $$GETTXT^ATK("ATKPROD","KLREFK",Taal)_": "_Value
 ;
OMSCHR(Type) 
 New Value
 If Type=1 Do
 .Set Value=$P(R($P("0#1#2#2","#",$F("NFDE",Taal)-1)),D,$P("2#22#1#2","#",$F("NFDE",Taal)-1))
 .Set Value=Value_$J("",45-$L(Value)-$L($P(R("K"),D,$F("NFDE",Taal)-1)))_$P(R("K"),D,$F("NFDE",Taal)-1)
 If Type=2 Set Value=$P(R($P("0#3#3#3","#",$F("NFDE",Taal)-1)),D,$P("11#21#22#23","#",$F("NFDE",Taal)-1))
 If Type=3 Set Value=$G(R("R")) Set:$L(Value) Value=$$FMTKLREF(Value)
 Quit Value
 ;
SELECT(Taal) 
 New PRNr,Pr,DL,PRSEL,KLNr,KlRef,Prompt,Comment1,Comment2,zb
 Do ADD^vhScherm(21,24)
 Set KLNr=$P(^HULP(%J,"KLINIT",0),D),KlRef=$G(^HULP(%J,"KLINIT","R"))
 Set Prompt=$$GETTXT^ATK("ATKPROD","PRODUKT",Taal)_" : "
 Set Comment1=$$GETTXT^ATK("ATKPROD","BEGINL",Taal)
 Set:KlRef Comment1=Comment1_" "_$$GETTXT^ATK("ATKPROD","KLREFL",Taal)_" "_$$GETTXT^ATK("ATKPROD","OF",Taal)
 Set Comment1=Comment1_$$GETTXT^ATK("ATKPROD","DE",Taal)_" "_$$GETTXT^ATK("ATKPROD","VHREF",Taal)
 Set Comment2=$$GETTXT^ATK("ATKPROD","EXIT",Taal)
 Set PRNr=""
SEL2 Kill ^HULP(%J,"PRSEL")
 Set Pr=$$ASK^vhINP(Prompt,25,"",Comment1,Comment2,"","",ITimeOut)
 Set:$G(zb)=-1 Pr="-",zb=""
 Goto SEL2:Pr=""!zb
 Quit:Pr="-"!(Pr=".") Pr
 Set Pr=$$UPTRIMAN^vhRtn1(Pr)
 Do INIT^PROC("ATKPROD","PRSEL")
 Set PRSEL(8)=$$GETTXT^ATK("ATKPROD","SELECT",Taal)
 Job PRSELECT^ATKJOB(%J,Pr,KLNr,Taal)::LTimeOut
 If $T Set Time=$P($H,",",2) Do
 .For  Hang HangTime Quit:$P($H,",",2)-Time>LTimeOut!($O(^HULP(%J,"PRSEL",""),-1)>PRSEL(4))!$G(^HULP(%J,"PRSEL"))
 ..If $P($H,",",2)-Time>LTimeOut Goto TIMEOUT^ATK
 If $O(^HULP(%J,"PRSEL",1))="" Set PRNr=$P($G(^HULP(%J,"PRSEL",1)),D)
 Goto EXIT:PRNr
 Do WL^PROC
 For  Do  Quit:R="-"!(R="ENTER")
 .Set DL(3)=-ITimeOut
 .Do SL^ATK
 .Kill DL(3)
 .If $G(zb)="",$G(R)="" Set R="-"
 If $D(^HULP(%J,"PRSEL")) For  Quit:$G(^HULP(%J,"PRSEL"))
 Set:R="ENTER" PRNr=$P($G(^HULP(%J,"PRSEL",PRSEL(6))),D)
 If 'PRNr,$E(PRNr)'="P" Goto SEL2
EXIT Kill ^HULP(%J,"PRSEL")
 Quit PRNr
 ;
KLREF 
 New R
 Quit:$G(DL(1))="KLREF"
 Do LDINIT^ATK(Input,Taal)
 If $D(^HULP(%J,"KLREF")) Do
 .Do MERGNAME(1)
 .Do SCRNTYP^ATK(Input,Taal)
 .Do ADD^vhScherm(KLREF(3)-1,24)
 Quit
 ;
PRNAME(Name) 
 Quit $P(Name,"<>",$S(LvhKlRef<2:1,$L($P(Name,"<>",2)):2,1:1))
 ;
PRATTRIB(Piece) 
 New Name
 Set Name=$P(FL(3),D,Piece)
 Quit $S(LvhKlRef<2:0,$P(Name,"<>")=$$PRNAME(Name):1,1:0)
 ;
RUBRIEK(Rubr,Value) 
 Set Rubr=$$GETTXT^ATK("ATKPROD",Rubr,Taal)
 Set Value=Rubr_$J("",Colom-$L(Rubr)+1)_$S($L(Rubr):":",1:" ")_" "_Value
 Quit Value
 ;
SINIT 
 New I,R
 For I=1:1 Quit:'$D(sScrnDef(I))  Do
 .Quit:$P(sScrnDef(I),"`",4)["H"
 .Set R=$P(sScrnDef(I),"`",15) Set:$L(R) R=$$GETTXT^ATK("ATKPROD",R,Taal)
 .Set:$L(R)>$G(Colom) Colom=$L(R)
 Quit
 ;
WISSEL() 
 New Test,Ref
 If $G(LvhKlRef) Do
 .Set Ref=$G(Tabel,$G(DL(1)))
 .If "\O\C\A\T\"[(D_$E(Ref)_D),$E(Ref,2,$L(Ref))="ORDER" Set Ref="ORDER"
 .If "\ORDER\BON\VERKAN\MOEDERB\OFFERTE\"[(D_Ref_D) Set Test=1
 Quit $G(Test)
 ;
OWNREF 
 New I,K,R,%SC,PRNr,Name,VHRef,KlRef,OldKlRef,InKlRef,PakNr,Prompt
 Set PRNr=$$GETPROD()
 Quit:'PRNr
 If '$$MODNAME() Do  Quit
 .Set Prompt=$$GETTXT^ATK("ATKPROD","KLREFNOM",Taal)_"   "_$$GETTXT^ATK("ATKPROD","OK",Taal)
 .Do TXT^vhINP(Prompt,"",ITimeOut,1)
 Set R=$$GETNAME(),VHRef=$P(R,"<>"),(KlRef,OldKlRef)=$P(R,"<>",2)
 Set InKlRef=$P($G(^HULP(%J,"NEWKLREF",PRNr)),D)
 Do DISPLAY^vhScherm("ATKKLREF"),FIELD^vhScherm("ATKKLREF","KLREF"),ADD^vhScherm(18,24)
 If %SC,KlRef'=OldKlRef Do
 .Set:KlRef="" KlRef=InKlRef
 .If $L(OldKlRef) Do
 ..Set PakNr=$G(^HULP(%J,"KLREF","INDEX",$$UPTRIMAN^vhRtn1(OldKlRef)))
 ..Kill ^HULP(%J,"KLREF","INDEX",$$UPTRIMAN^vhRtn1(OldKlRef))
 .Set:$L(KlRef) ^HULP(%J,"KLREF","INDEX",$$UPTRIMAN^vhRtn1(KlRef))=$G(PakNr)
 .Set R=$G(^HULP(%J,"NEWKLREF",PRNr)),$P(R,D,2)=KlRef Set:$P(R,D)=""&$G(PakNr) $P(R,D)=OldKlRef
 .If KlRef=InKlRef Do
 ..Kill ^HULP(%J,"NEWKLREF",PRNr)
 ..Quit:'$D(^HULP(%J,"RPLPR",PRNr))
 ..Kill ^HULP(%J,"RPLPR",PRNr,"R")
 ..Set:$L(InKlRef) ^HULP(%J,"RPLPR",PRNr,"R")=InKlRef
 .Else  Set ^HULP(%J,"NEWKLREF",PRNr)=R
 .If DL(1)="KLREF",KlRef="" Do
 ..Do DELETE^PROC3
 .Else  Do PUTNAME(KlRef,2)
 .If $L(KlRef),Menu'["\W\" Set Menu=Menu_"W\"
 .If $L(KlRef),Menu'["\R\" Set Menu=Menu_"R\"
 .If LvhKlRef'=2 Do
 ..Set Input=$$LDINPUT^ATK(DL(1)),DL(1)="" Set:Input'="R" LvhKlRef=2
 .Else  If @DL(1)@(3)+@DL(1)@(6)-@DL(1)@(7)<sRT Do EL^PROC
 Quit
 ;
CHKREF() 
 New Error,PakNr,LijnNr
 If X="",$D(^HULP(%J,"KLREF","PRNR",PRNr)),InKlRef="" Do
 .Set PakNr=$O(^HULP(%J,"KLREF","PRNR",PRNr,""))
 .Quit:'PakNr
 .Set LijnNr=^HULP(%J,"KLREF","PRNR",PRNr,PakNr)
 .Quit:'LijnNr
 .Set Error=" Mag niet leeg zijn"
 If $L(X),X'=KlRef,$D(^HULP(%J,"KLREF","INDEX",$$UPTRIMAN^vhRtn1(X))) Do
 .Set Error=" "_$$GETTXT^ATK("ATKPROD","KLREFB",Taal)_"  "_$$GETTXT^ATK("ATKPROD","OK",Taal)
 Quit $G(Error)
 ;
MERGNAME(All) 
 New R,PRNr,Name,VHRef,Temp,Next,Quit,Index
 Set All=$G(All),Temp=@DL(1)@(6)
 If $D(DL(1)) Do
 .Set:$E(@DL(1)@(1),$L(@DL(1)@(1)))'="," @DL(1)@(1)=@DL(1)@(1)_","
 .For @DL(1)@(6)=1:1 Quit:'$D(@(@DL(1)@(1)_@DL(1)@(6)_")"))  Do
 ..Set PRNr=$$GETPROD()
 ..Quit:'PRNr
 ..If 'All,'$D(^HULP(%J,"NEWKLREF",PRNr)) Quit
 ..Kill Name
 ..If $D(^HULP(%J,"NEWKLREF",PRNr)) Set Name=$P(^HULP(%J,"NEWKLREF",PRNr),D,2)
 ..Else  If DL(1)'="KLREF" Set Name=$$PAKREF(PRNr,1)
 ..Do:$D(Name) PUTNAME(Name,2)
 .If DL(1)="KLREF" Do
 ..Kill ^HULP(%J,"NEWKLREF","SORT")
 ..Set PRNr=0
 ..For  Set PRNr=$O(^HULP(%J,"NEWKLREF",PRNr)) Quit:'PRNr  Do
 ...Set R=^HULP(%J,"NEWKLREF",PRNr),Index=$$UPTRIMAN^vhRtn1($P(R,D,2))
 ...Set ^HULP(%J,"NEWKLREF","SORT",Index)=PRNr
 ..Set Index=""
 ..For  Set Index=$O(^HULP(%J,"NEWKLREF","SORT",Index)) Quit:Index=""  Do
 ...Set PRNr=^HULP(%J,"NEWKLREF","SORT",Index),Quit=0
 ...For Next=1:1 Quit:'$D(^HULP(%J,"KLREF",Next))  Do  Quit:Quit
 ....Set R=^HULP(%J,"KLREF",Next),Quit=PRNr=$P(R,D)
 ...Quit:Quit
 ...Set Name=$P(^HULP(%J,"NEWKLREF",PRNr),D,2)
 ...If '$G(^HULP(%J,"RPLPR",PRNr)) Do JOBRPLPR
 ...Set VHRef=$P($G(^HULP(%J,"RPLPR",PRNr,0)),D)
 ...Set ^HULP(%J,"KLREF")=Next,^HULP(%J,"KLREF",Next)=PRNr_D_Name_D_VHRef_"\1\"
 ..Kill ^HULP(%J,"NEWKLREF","SORT")
 ..For KLREF(6)=1:1 Quit:'$D(^HULP(%J,"KLREF",KLREF(6)))  Do
 ...Set R=^HULP(%J,"KLREF",KLREF(6)),PRNr=$P(R,D)
 ...Quit:$P(R,D,5)  Quit:$D(^HULP(%J,"NEWKLREF",PRNr))
 ...Do LDELETE^PROC3(KLREF(6),KLREF(9),KLREF(1))
 ...Set KLREF(6)=KLREF(6)-1,KLREF(9)=KLREF(9)-1
 ..If $D(KLREF(9)),KLREF(6)>KLREF(9) Set KLREF(6)=KLREF(9)
 ..If KLREF(7)>KLREF(6) Set KLREF(7)=KLREF(6)
 ..Set:'KLREF(6) KLREF(6)=1
 Set @DL(1)@(6)=Temp
 Quit
 ;
ASKTRANS 
 New C,R,Prompt,Comment
 Quit:'$D(^HULP(%J,"NEWKLREF"))
 Set C("J")=$$GETTXT^ATK("ATKPROD","JA",Taal),C("N")=$$GETTXT^ATK("ATKPROD","NEEN",Taal)
 Set Prompt=$$GETTXT^ATK("ATKPROD","KLREFT1",Taal)_$$GETTXT^ATK("ATKPROD","KLREFT2",Taal)_" : "
 Set Comment=" "_$E(C("J"))_" = "_C("J")_"   "_$E(C("N"))_" = "_C("N")
 For  Set R=$$KEY^vhINP(Prompt,Comment,"",2,ITimeOut,"U") Quit:R=$E(C("J"))!(R=$E(C("N")))!(zb=-1)
 Set FP=2301
 Write @F,@F1
 Set Prompt=""""_$$GETTXT^ATK("ATKPROD","KLREFTT",Taal)_" "
 If R'=$E(C("J")) Do
 .Kill ^HULP(%J,"NEWKLREF")
 .Set Prompt=Prompt_" "",@FMTK,"""_$$GETTXT^ATK("ATKPROD","KLREFTTN",Taal)_""",@FMTk,@FMTI,"" "
 Else  Set Prompt=Prompt_$$GETTXT^ATK("ATKPROD","KLREFTTD",Taal)
 Set Prompt=Prompt_"   "_$$GETTXT^ATK("ATKPROD","OK",Taal)_"""",FP=2201
 Write @F,@F1
 Do TXT^vhINP(Prompt,"",ITimeOut,1)
 Quit
 ;
PAKREF(PRNr,ExtFmt) 
 New R,PakNr,PakNaam,OldNaam,NewNaam
 Set R="",PakNr=""
 For  Set PakNr=$O(^HULP(%J,"KLREF","PRNR",PRNr,PakNr)) Quit:'PakNr  Do
 .Set LineNr=^HULP(%J,"KLREF","PRNR",PRNr,PakNr),PakNaam=$P(^HULP(%J,"KLREF",LineNr),D,2)
 .If PakNaam="" Do
 ..New PRNr
 ..Set PRNr=""
 ..For  Set PRNr=$O(^HULP(%J,"KLREF","PAKNR",PakNr,PRNr)) Quit:PRNr=""  Do  Quit:$L(PakNaam)
 ...Set LineNr=^HULP(%J,"KLREF","PAKNR",PakNr,PRNr),PakNaam=$P(^HULP(%J,"KLREF",LineNr),D,2)
 .Set:$L(R) R=R_D Set R=R_PakNaam
 If $D(^HULP(%J,"NEWKLREF",PRNr)) Do
 .Set OldNaam=$P(^HULP(%J,"NEWKLREF",PRNr),D),NewNaam=$P(^HULP(%J,"NEWKLREF",PRNr),D,2)
 .If $L(OldNaam),(D_R_D)[(D_OldNaam_D) Do  Quit
 ..Set R=D_R_D,OldNaam=D_OldNaam_D,NewNaam=D_NewNaam_D
 ..Set R=$P(R,OldNaam)_NewNaam_$P(R,OldNaam,2)
 ..Set $E(R)="",$E(R,$L(R))=""
 .Set:$L(R) R=R_D Set R=R_NewNaam
 If $G(ExtFmt) For  Quit:R'[D  Set R=$P(R,D)_" & "_$P(R,D,2,99)
 Quit R
 ;