PRVERTA ;Produkt langtekst vertaling Ned -> Frans [ 11/06/2001  3:49 PM ]
 D ^cA604,INIT^vhTERMINA
 S KHS=$$SELECT^KLASS(1)
 S KHS=$$GETSORT^KLASS(+KHS)
 Set (KGS,KSS,KT)=""
 F  S KGS=$O(^KPH(KHS,KGS)) Quit:KGS=""  Do
 .F  S KSS=$O(^KPH(KHS,KGS,KSS)) Quit:KSS=""  Do
 ..F  S KT=$O(^KPH(KHS,KGS,KSS,"  ",KT)) Quit:KT=""  Do
 ...Set PRNr=^(KT)
 ...Set TNed=$P(^KPR(PRNr,0),D,2)_", "_$P(^KPR(PRNr,0),D,11)
 ...Set TFrans=$P(^KPR(PRNr,1),D,22)_", "_$P(^KPR(PRNr,3),D,21)
 ...Do STORE(TNed,TFrans)
 Q
BURBI D ^cA604,INIT^vhTERMINA
 ;k ^PRVERTA
 Set K=""        
 F  Set K=$O(^BURBID("T",K)) Quit:K=""  Do
 .S Rec=^(K)
 .S TN=$P(Rec,D,2),TF=$P(Rec,D,3)
 .S Key=$$UPTRIMAN^vhRtn1(TN)
 .Quit:Key=""!(TF="")
 .S ^PRVERTA(Key)=$$LOCASE^vhRtn1(TN_D_TF)
 Q
SPOTS D ^cA604,INIT^vhTERMINA
 k ^PRVERTA
 Set KHS="01CH ",(KGS,KSS,KT)=""
 F  S KGS=$O(^KPH(KHS,KGS)) Quit:KGS=""  Do
 .F  S KSS=$O(^KPH(KHS,KGS,KSS)) Quit:KSS=""  Do
 ..F  S KT=$O(^KPH(KHS,KGS,KSS,"  ",KT)) Quit:KT=""  Do
 ...Set PRNr=^(KT)
 ...Set TNed=$P(^KPR(PRNr,0),D,2)_", "_$P(^KPR(PRNr,0),D,11)
 ...Set TFrans=$P(^KPR(PRNr,1),D,22)_", "_$P(^KPR(PRNr,3),D,21)
 ...Do STORE(TNed,TFrans)
 Q
 
VERTAAL(TNed) 
 Set TFrans=""
 For I=1:1:$L(TNed,",") Do
 .Set T=$P(TNed,",",I)
 .For  Quit:$E(T)'=" "  Set $E(T)=""
 .For  Quit:$E(T,$L(T))'=" "  Set $E(T,$L(T))=""
 .Set Key=$$UPTRIMAN^vhRtn1(T)
 .Quit:'$L(Key)
 .If '$D(^PRVERTA(Key)) Do
 ..Set TF=$$ASKL^vhINP($ZN,"VERTALING")
 ..Set:TF="-" TF=T
 ..If $L(TF) Do 
 ...For  Quit:$E(TF)'=" "  Set $E(TF)=""
 ...Set ^PRVERTA(Key)=T_D_TF
 .Set:$D(^PRVERTA(Key)) TFrans=TFrans_", "_$P(^PRVERTA(Key),D,2)
 Quit $$UPCASE^vhRtn1($E(TFrans,3))_$E(TFrans,4,999)
 
STORE(TNed,TFrans) 
 New I,TN,TF,Key,K
 For I=1:1:$L($P(TNed,",")) Do
 .Set TN=$P(TNed,",",I)
 .For  Quit:$E(TN)'=" "  Set $E(TN)=""
 .For  Quit:$E(TN,$L(TN))'=" "  Set $E(TN,$L(TN))=""
 .Set TF=$P(TFrans,",",I)
 .For  Quit:$E(TF)'=" "  Set $E(TF)=""
 .For  Quit:$E(TF,$L(TF))'=" "  Set $E(TF,$L(TF))=""
 .Set Key=$$UPTRIMAN^vhRtn1(TN)
 .Quit:Key=""!(TF="")
 .Quit:(Key=$$UPTRIMAN^vhRtn1(TF))&'$D(^PRVERTA(Key))
 .Quit:$G(^PRVERTA(Key))=(TN_D_TF)  ; Bestaat reeds
 .Set X=$$KEYL^vhINP($ZN,"STORE")
 .Quit:X'="J"
 .Set ^PRVERTA(Key)=TN_D_TF
 Quit
 
INPSTOR(Deel) 
 Quit:"-,."[K&$L(K)
 Set:Deel=1 TFrans=K,T2=$P(B(4),D,21)
 Set:Deel=2 TFrans=$P(B(2),D,22),T2=K
 Set:$L(T2) TFrans=TFrans_", "_T2
 Set TNed=$P(B(1),D,2),T2=$P(B(1),D,11)
 Set:$L(T2) TNed=TNed_", "_T2
 Do STORE(TNed,TFrans)
 Quit
 
INPVERT(Deel) 
 Quit:"-,."[K&$L(K)
 Set:Deel=1 TNed=K,T2=$P(B(1),D,11)
 Set:Deel=2 TNed=$P(B(1),D,2),T2=K
 Set:$L(T2) TNed=TNed_", "_T2
 Set TFrans=$$VERTAAL(TNed)
 Set T1=$E(TFrans,1,26),T2=""
 If $L(TFrans)>26 Do
 .Set Pos=$L(T1,",")-1
 .If 'Pos Set T2=$E(TFrans,27,99)
 .Else  Set T1=$P(TFrans,",",1,Pos),T2=$P(TFrans,",",Pos+1,99)
 .For  Quit:$E(T2)'=" "&($E(T2)'=",")  Set $E(T2)=""
 Set $P(B(2),D,22)=T1
 Set $P(B(4),D,21)=$E(T2,1,45)
 Do REFRESH(A(105))
 Do REFRESH(A(106))
 Quit
 
REFRESH(Rec) ; Hertekenen van het produkt scherm 1
 Set FP=$P(Rec,U,5)*100+$P(Rec,U,6)
 Write @F,$J("",$P(Rec,U,9))
 Write @F,$P(B($P(Rec,U,16)\100),D,$P(Rec,U,16)#100)
 Quit