RTT ;Convertie zone 041 naar 04 [ 09/16/96  11:10 AM ]
 ;
 Set Q="K" Do ^cA604
 Write @F11,@F1
 For  Do  Quit:Old="-"
 .Read !!,"Oud nummer ? ",Old
 .Quit:Old="-"
 .Set (Old,New)=$$UPTRIMAN^vhRtn1(Old)
 .If $E(Old,1,3)="041" Do
 ..Set $E(Old,3,5)=$$CONV04($E(Old,4,5))
 ..Set New=$E(Old,1,2)_"/"_$E(Old,3,5)_"."_$E(Old,6,7)_"."_$E(Old,8,9)
 .If $E(Old,1,3)="091" Do
 ..Set $E(Old,3,6)=$$CONV09($E(Old,4,7))
 ..Set New=$E(Old,1,2)_"/"_$E(Old,3,5)_"."_$E(Old,6,7)_"."_$E(Old,8,9)
 .Write ?30,"Nieuw nummer : ",New
 Quit
 ;
KLANTEN 
 Set Q="K" Do ^cA604
 Write !!!,"*** Conversie klanten ***",!!!
 Set (KC,C)=0
 For  Set KC=$O(^KKL(KC)) Quit:KC=""  Write !!,KC Set T=0 Do TELNR(KC,113),TELNR(KC,114),TELNR(KC,224) If T Set C=C+1
 Quit
 ;
TELNR(KC,Ref) 
 New Node,Piece,K,R
 Set Node=Ref\100-1,Piece=Ref#100
 Set K=$P(^KKL(KC,Node),D,Piece)
 If $E(K,1,3)'="041" Quit
 Set T=1
 Write !,Node,?2,Piece,?5,K
 ;Convertie
 Set $E(K,1,13)=$TR($E(K,1,13)," ","")
 Set X=$E(K,13,99),K=$E(K,1,12)
 If $L(X),$E(X)'=" " Set X=" "_X
 Set K=$$UPTRIMAN^vhRtn1(K)
 Quit:$L(K)'=9
 Set $E(K,3,5)=$$CONV04($E(K,4,5))
 Set K=$E(K,1,2)_"/"_$E(K,3,5)_"."_$E(K,6,7)_"."_$E(K,8,9)_X
 Write !,?5,K
 Read R
 Set $P(^KKL(KC,Node),D,Piece)=K
 Quit
 ;
CONV04(R) 
 If R<30 Quit 2_R
 If R<31 Quit 3_R
 If R<36 Quit 2_R
 If R<39 Quit 3_R
 If R<41 Quit 2_R
 If R<46 Quit 3_R
 If R<49 Quit 2_R
 If R<50 Quit 3_R
 If R<51 Quit 2_R
 If R<52 Quit 3_R
 If R<55 Quit 2_R
 If R<56 Quit 3_R
 If R>88 Quit 2_R
 If R>86 Quit 3_R
 If R>85 Quit 2_R
 If R>78 Quit 3_R
 If R>77 Quit 2_R
 If R>75 Quit 3_R
 If R>74 Quit 2_R
 If R>73 Quit 3_R
 If R>72 Quit 2_R
 If R>64 Quit 3_R
 If R>62 Quit 2_R
 If R>59 Quit 3_R
 If R>58 Quit 2_R
 If R>57 Quit 3_R
 If R>56 Quit 2_R
 Write *7
 Quit 1_R
 ;
CONV09(R) 
 New S
 Set S=$E(R,4),R=$E(R,1,3)
 If R'<200,R'>245 Quit 2_R
 If R=246 Quit 2666
 If R'<247,R'>324 Quit 2_R
 If R'<325,R'>329 Quit 210_$E(R,3)
 If R'<330,R'>359 Quit 2_R
 If R=360 Quit 2160
 If R'<361,R'>367 Quit 2_R
 If R'<368,R'>369 Quit 216_$E(R,3)
 If R'<370,R'>379 Quit 2_R
 If R=380 Quit 2180
 If R'<381,R'>385 Quit 2_R
 If R'<386,R'>389 Quit 218_$E(R,3)
 If R'<390,R'>409 Quit 2_R
 If R'<410,R'>419 Do  Quit R
 .; Uitzondering (1)
 .If R_S=4159 S R=2407 Quit
 .Set R=2_R
 If R=420 Quit 3420
 If R=421 Quit 3451
 If R'<422,R'>424 Quit 347_$E(R,3)
 If R'<428,R'>439 Quit 3_R
 If R=440 Quit 3440
 If R'<441,R'>443 Quit 341_$E(R,3)
 If R'<444,R'>496 Quit 3_R
 If R'<497,R'>499 Quit 340_$E(R,3)
 If R'<500,R'>505 Do  Quit R
 .; Uitzondering (2)
 .If R_S'<5054,R_S'>5055 Set R=2557 Quit
 .Set R=2_R
 If R=506 Do  Quit R
 .; Uitzondering (3)
 .If R_S'<5060,R_S'>5063 Set R=2556 Quit
 .Set R=2556
 If R'<507,R'>519 Quit 2_R
 If R=520 Quit 2720
 If R'<521,R'>527 Quit 2_R
 If R'<528,R'>529 Quit 272_$E(R,3)
 If R'<530,R'>542 Quit 2_R
 If R'<543,R'>549 Quit 257_$E(R,3)
 If R'<550,R'>559 Quit 3_R
 If R'<560,R'>563 Quit 354_$E(R,3)
 If R'<564,R'>567 Quit 353_$E(R,3)
 If R'<568,R'>569 Quit 3_R
 If R'<570,R'>572 Quit 358_$E(R,3)
 If R'<573,R'>579 Quit 3_R
 If R'<580,R'>595 Quit 2_R
 If R'<596,R'>599 Do  Quit R
 .; Uitzondering (3)
 .If R_S'<5967,R_S'>5969 Set R=2556 Quit
 .Set R=255_$E(R,3)
 If R'<600,R'>614 Quit 3_R
 If R'<615,R'>619 Quit 364_$E(R,3)
 If R'<620,R'>666 Quit 3_R
 If R'<667,R'>669 Quit 365_$E(R,3)
 If R'<670,R'>710 Quit 3_R
 If R'<711,R'>713 Quit 321_$E(R,3)
 If R'<714,R'>755 Quit 3_R
 If R'<756,R'>759 Quit 325_$E(R,3)
 If R'<760,R'>805 Quit 3_R
 If R'<806,R'>809 Quit 381_$E(R,3)
 If R'<810,R'>817 Quit 2_R
 If R'<818,R'>819 Quit 280_$E(R,3)
 If R'<820,R'>829 Quit 2_R
 If R'<830,R'>849 Quit 3_R
 If R'<851,R'>853 Quit 382_$E(R,3)
 If R'<854,R'>879 Quit 3_R
 If R'<880,R'>884 Quit 338_$E(R,3)
 If R'<885,R'>899 Quit 3_R
 If R'<910,R'>949 Quit 2_R
 If R'<955,R'>959 Quit 341_$E(R,3)
 If R'<960,R'>969 Quit 333_$E(R,3)
 If R'<970,R'>979 Quit 3_R
 If R'<980,R'>999 Quit 2_R
 Write *7
 Quit 1_R