KATALOOG ;Exporteren van produktgegevens voor kataloog [ 01/09/2003  8:30 AM ]
 Do 
 .New Taal,Begin
 .Do INIT^vhTERMINA
 Set Taal=$G(Taal,"N")
KATAL2 Set %J=$$%J^vhRtn1
 Set Begin=$$ASK^vhINP("Beginletters kataloog definitie :",8,$G(Begin),"*[]= NIEUW")
 Quit:Begin=""
 If Begin="*" Do  Quit:Key'?1A1.E
 .Set Key=$$ASK^vhINP("Nieuwe kataloog definitie :",8,"","Max. 8 karakters, PageMakerDocNm.Produktnaam","Bv. 'SD.VFR' geeft schuifdeuren voorfront")
 Else  Do  Quit:Key'?1A1.E
 .Set Key=Begin
 .Kill Y
 .Set Y=0,X=1
 .For  Set Key=$O(^KATALOOG(Key)) Quit:$E(Key,1,$L(Begin))'=Begin  Do
 ..Set Y=Y+1,Y(Y)=Key
 .Set Key=""
 .Quit:'Y
 .Set Y(0)=Y,Y="15\\Selecteer via spatiebalk"
 .Write @F11,@F1
 .Do ^POP
 .If X Set Key=Y(X)
 
 Do INIT
 Do REFRESH
 For  Do  Quit:Input="-"!(Input=".")
 .Set Input=$$SCROLL^vhLIST(.LD)
 .IF Input="SPEC"!(Input="COM") Do CALLSPEC^vhMenu("5;79","KATALOOG")
 .If Input="LN" Do LNIEUW
 .If Input="LW" Do LWIJZIG
 .If Input="LP" Do LSEKW
 .If Input="LI" Do LINSERT
 .If Input="LV" Do LDELETE
 .If Input="L<" Do LSWAP(-1)
 .If Input="L>" Do LSWAP(+1)
 .If Input="LK" Do LTITEL
 .IF Input="PRINT" Do PRINT
 .IF Input="PRINT2" Do MACT
 .IF Input="M" Do SWTRANS
 .IF Input="T" Do SWTAAL
 .If Input="K" Do INPKATA
 .If Input="W" Do WIS
 .If Input="EXPORT" Do EXPOINT
 Do SAVE:Input="-"
 Do CLEAN
 Quit
 
FRANS If '$D(Q) Do INIT^vhTERMINA
 Set Taal="F"
 Goto KATAL2
 
INIT Kill ^HULP(%J)
 Do SIZE^vhTERMINA(132)
 Merge ^HULP(%J)=^KATALOOG(Key)
 Do CHECKW
 Set TRMode=$P($G(^KATALOOG(Key)),D)
 Set Kataloog=$P($G(^KATALOOG(Key)),D,2)
 Do INIT^vhLIST("KATALOOG","PRODUKT",.LD)
 Quit
 
CHECK Set Del=0
 For I=1:1 Quit:'$D(^HULP(%J,I))  Do 
 .Set PRNr=$P(^HULP(%J,I),D)
 .If PRNr Do
 ..Quit:$D(^KPR(PRNr))
 ..Write !,"Verwijder produkt "_PRNr_" "_$P($G(^KPRO(PRNr,0)),D)
 ..Set Del=1
 ..Do LDELETE^vhLISTE(I,$O(^HULP(%J,""),-1),$NA(^HULP(%J)))
 ..Set I=I-1
 .Else  Do
 ..Set Rec=$P(^HULP(%J,I),D,3)
 ..If Rec=""  Write !,"Subtitel niet in frans :",$P(^HULP(%J,I),D,2) Set Del=1
 Quit
CHECKW Do CHECK
 Read:Del !!,"<Enter> om verder te gaan",Del
 Quit
 
SAVE Kill ^HULP(%J,"PRINT")
 Kill ^KATALOOG(Key)
 Quit:$D(^HULP(%J))'>1
 Merge ^KATALOOG(Key)=^HULP(%J)
 Set $P(^KATALOOG(Key),D)=TRMode
 Set $P(^KATALOOG(Key),D,2)=Kataloog
 Quit
 
CLEAN Kill ^HULP(%J)
 Do SIZE^vhTERMINA(80)
 Quit
 
REFRESH Write @F11,@F1
 Write @FMTI," KATALOOG selectie/transfert"_" - "_QN_" ",@FMTi
 Write !,"Sleutel       : ",Key
 Write !,"Transfertmode : ",$S(TRMode:"FotoLijst",1:"Bestelgegevens")
 Write ?46,"Taal : ",$S(Taal="N":"Nederlands",1:"Frans")
 Write ?90,"Kataloog : ",Kataloog
 Do WRITE^vhLIST(.LD)
 Quit
 
INPKATA Set Kataloog=$$ASK^vhINP("Kataloog : ",20,Kataloog,"VAN HOECKE Kataloog ref.,Formaat : Y-X ","waar Y staat voor katern en X voor bladzijde")
 Do REFRESH
 Quit
 
KPRKATA ; Overbrengen van de kataloog blz. naar het produkten bestand KPR 
 Set Key=""
 For  Set Key=$O(^KATALOOG(Key)) Quit:Key=""  Do
 .Quit:Key="BLUMIND"  ; Uitzondering 
 .Set Blz=$P($G(^KATALOOG(Key)),D,2) 
 .Set LNr=""
 .For  Set LNr=$O(^KATALOOG(Key,LNr)) Quit:LNr=""  Do
 ..Set PRNr=$P(^KATALOOG(Key,LNr),D)
 ..Quit:PRNr'?4.7N
 ..Quit:'$D(^KPR(PRNr))
 ..Set Rec=^KPR(PRNr,3)
 ..Quit:$P(Rec,D,1)'=""
 ..Set $P(Rec,D,1)=Blz
 ..Set $P(Rec,D,2)="VH96"
 ..Write !,$P(^KPR(PRNr,0),D,1)," ",$P(Rec,D,1,2)
 ..Set ^KPR(PRNr,3)=Rec
 Quit
 
SWTAAL Set Taal=$S(Taal="N":"F",1:"N")
 Do REFRESH
 Quit
SWTRANS Set TRMode=$S(TRMode="":"1",1:"")
 Do REFRESH
 Quit
 
LSEKW For  Do LNIEUW Quit:'PRNr
 Quit
 
LNIEUW Do STORE^vhTERMINA()
 Set PRNr=$$SELECT^PRODUKT6()
 Do REFRESH^vhTERMINA()
 Quit:'PRNr
 Do NIEUW^vhLISTE(.LD,PRNr_D_1)
 Quit
 
LINSERT Do STORE^vhTERMINA()
 Set PRNr=$$SELECT^PRODUKT6()
 Do REFRESH^vhTERMINA()
 Quit:'PRNr
 Do INSERT^vhLISTE(.LD,PRNr,-1)
 Quit
 
WIS Set R=$$ASK^vhINP("Bent u zeker dat u de volgnummers wenst te wissen",1,"","W=Wissen")
 Quit:R'="W"&(R'="w")
 For Lijn=1:1:$O(^HULP(%J,""),-1) Do
 .Set Rec=^HULP(%J,Lijn)
 .Quit:$P(Rec,D)=""
 .Set $P(Rec,D,2)=""
 .Set ^HULP(%J,Lijn)=Rec
 Do REFRESH
 Quit
 
 
LWIJZIG Set Lijn=LD("SELECT")
 Quit:'Lijn
 Do STORE^vhTERMINA()
 Set Rec=^HULP(%J,Lijn)
 If $P(Rec,D) Do
 .Set $P(Rec,D,2)=$$ASK^vhINP("Produkt volgnr ophoging : ",2,$P(Rec,D,2),"0 of 1")
 Else  Do
 .Set $P(Rec,D,2)=$$ASK^vhINP("Titel Nederlands : ",50,$P(Rec,D,2))
 .Set:$P(Rec,D,3)=""&($P(Rec,D,2)="Toebehoor") $P(Rec,D,3)="Accessoires"
 .Set:$P(Rec,D,3)=""&($P(Rec,D,2)="Toebehoren") $P(Rec,D,3)="Accessoires"
 .Set $P(Rec,D,3)=$$ASK^vhINP("Titel Frans : ",50,$P(Rec,D,3))
 .Set:$P(Rec,D,2)="" Rec=""
 Do REFRESH^vhTERMINA()
 If Rec="" Goto LDELETE
 Set ^HULP(%J,Lijn)=Rec
 Do LINE^vhLIST(.LD,Lijn)
 Quit
 
LTITEL Do STORE^vhTERMINA()
 Set TitelN=$$ASK^vhINP("Titel Nederlands : ",50,"")
 Set TitelF=$$ASK^vhINP("Titel Frans : ",50,"")
 Do REFRESH^vhTERMINA()
 Quit:'$L(TitelN)
 Do INSERT^vhLISTE(.LD,D_TitelN_D_TitelF,-1)
 Do LINE^vhLIST(.LD,LD("SELECT"))
 Quit
 
LDELETE Do DELETE^vhLISTE(.LD)
 Quit
 
LSWAP(Dir) Do SWAP^vhLISTE(.LD,Dir)
 Quit
 
MBH(PRNr) 
 New Rec,MBH
 Set Rec=^KPR(PRNr,$O(^KPR(PRNr,"J")))
 Set MBH=$P(Rec,D,6)
 If $P(^KPR(PRNr,1),D,20) Do  ; Stock
 .If $P(Rec,D,13) Set MBH=1 Quit
 .If $P(Rec,D,14) Set MBH=$P(Rec,D,14) Quit
 .If $P(Rec,D,15) Set MBH=$P(Rec,D,15) Quit
 .If $P(Rec,D,16) Set MBH=$P(Rec,D,16) Quit
 Quit MBH
 
TRIM(X) For  Quit:$E(X)'=" "  Set $E(X)=""
 For  Quit:$E(X,$L(X))'=" "  Set $E(X,$L(X))=""
 Quit X
 
PRINT Do TRANS
 Do INIT^PROC("KATALOOGP","PD")
 Do PRINT^OUTPUT(.PD,"S")
 Kill ^HULP(%J,"PRINT")
 Do SIZE^vhTERMINA(80)
 Do SIZE^vhTERMINA(132)
 Do REFRESH
 Quit
 
MACT Do STORE^vhTERMINA()
 Do TRANS
 Do FILE(Key)
 Do REFRESH^vhTERMINA()
 Quit
 
EXPOINT Do SAVE
 Do SIZE^vhTERMINA(80)
 Do EXPORT 
 Read !,"Druk op de <ENTER>-toets om verder te gaan",K
 Do SIZE^vhTERMINA(132)
 Do REFRESH
 Quit
  
EXPORT New %J,Key,Device,Begin
 Do INIT^vhTERMINA
 Set %J=$$%J^vhRtn1()
 Set Taal=$G(Taal,"N")
 ;Do STORE^vhTERMINA()
 Set Begin=$$ASK^vhINP("Beginletters van de sleutel ",10,"")
 Quit:Begin=""
 Write @F11,@F1,"Exporteren van de gegevens beginnend met ",Begin,!
 Set Key=Begin
 For  Set Key=$O(^KATALOOG(Key)) Quit:$E(Key,1,$L(Begin))'=Begin  Do
 .For Taal="N","F" Do
 ..Kill ^HULP(%J)
 ..Merge ^HULP(%J)=^KATALOOG(Key)
 ..Do CHECK
 ..Set TRMode=$P($G(^HULP(%J)),D)
 ..Do TRANS
 ..Do FILE(Key)
 ;Do REFRESH^vhTERMINA()
 Quit
 
FILE(Key) 
 New FVAN,FNAAR,Dev
 Do VANNAAR^vhTERMINA("M")
 New File,Max
 Set File=$E($TR(Key,".","_"),1,8)_".t"_$S(Taal="F":"fr",1:"xt")
 Set Dev=$$OPEN^vhDEV($$DIRUSER^vhDEV,File,"W")
 IF $ZC=1 Do TXT^vhINP("File "_File_" niet te openen") Quit:$ZC=1
 U Dev
 Set Max=$O(^HULP(%J,"PRINT",""),-1)
 For I=1:1:Max Do
 .Write $TR(^HULP(%J,"PRINT",I),FVAN,FNAAR)
 .Write:I'=Max !
 C Dev
 Write !,"File "_File_" weggeschreven"
 Quit
 
TRANS Kill ^HULP(%J,"PRINT")
 Set Cnt=0
 Set Max=$O(^HULP(%J,""),-1)
 Do:'TRMode TITEL
 Set VolgNr=0
 For I=1:1:Max Do
 .Set PRNr=$P(^HULP(%J,I),D) Do
 .If PRNr Do
 ..Set VolgNr=VolgNr+$P(^HULP(%J,I),D,2)
 ..Set KortTekst=$P(^KPR(PRNr,0),D,1)
 ..Set Ltekst1=$P(^KPR(PRNr,0),D,2)
 ..Set Ltekst2=$P(^KPR(PRNr,0),D,11)
 ..Set:Taal="F" Ltekst1=$P(^KPR(PRNr,1),D,22)
 ..Set:Taal="F" Ltekst2=$P(^KPR(PRNr,3),D,21)
 ..Set:Ltekst2="" Ltekst2=" "
 ..Set Kleur=$E(KortTekst,22,25)
 ..Set KleurOms=$P($G(^KCOL(Kleur_" ",Taal)),D,1)
 ..Set MBH=$$MBH(PRNr)
 ..If 'TRMode Do
 ...Set Cnt=Cnt+1
 ...Set Rec="<Produkt Lijn1>"_$S(VolgNr:VolgNr,1:"")_$C(9)_$$TRIM($E(KortTekst,1,11))_$C(9)_$$TRIM($E(KortTekst,12,21))_$C(9)_$$TRIM($E(KortTekst,22,25))
 ...Set Rec=Rec_$C(9)_Ltekst1_$C(9)_KleurOms_$C(9)_MBH
 ...Set ^HULP(%J,"PRINT",Cnt)=Rec
 ...Set Cnt=Cnt+1
 ...Set ^HULP(%J,"PRINT",Cnt)="<Produkt Lijn2>"_Ltekst2
 ..Else  Do  ; GREEP of REL
 ...Set Cnt=Cnt+1
 ...Set Rec="<Produkt Foto1>"_$$TRIM($E(KortTekst,1,11))_$C(9)_$$TRIM($E(KortTekst,12,21))_$C(9)_$$TRIM($E(KortTekst,22,25))
 ...Set ^HULP(%J,"PRINT",Cnt)=Rec
 ...Set Cnt=Cnt+1
 ...Set ^HULP(%J,"PRINT",Cnt)="<Produkt Foto2>"_Ltekst1_$C(9)_KleurOms
 ...Set Cnt=Cnt+1
 ...Set ^HULP(%J,"PRINT",Cnt)="<Produkt Foto2>"_Ltekst2
 .Else  Do  ; Titel
 ..Set:Taal="N" Rec="<Produkt SubTitel>"_$P(^HULP(%J,I),D,2)
 ..If Taal="F" Do
 ...Set Rec=$P(^HULP(%J,I),D,3)
 ...Set:Rec="" Rec="??? "_$P(^HULP(%J,I),D,2)_" ???"
 ...Set Rec="<Produkt SubTitel>"_Rec
 ..Set Cnt=Cnt+1
 ..Set ^HULP(%J,"PRINT",Cnt)=Rec
 Quit
 
TITEL Set Cnt=Cnt+1
 Set:Taal="N" ^HULP(%J,"PRINT",Cnt)="<Produkt Titel>"_"Product"_$C(9)_"Beschrijving"_$C(9)_"Min. Bestel-"_$C(9,9,9)_"hoeveelheid"
 Set:Taal="F" ^HULP(%J,"PRINT",Cnt)="<Produkt Titel>"_"Produit"_$C(9)_"Description"_$C(9)_"Qté. min."_$C(9,9,9)_" "
 Quit
 
BLUMIMP D ^cA604
 Kill ^KATALOOG("BLUMIND")
 Set Cnt=0
 Write !,"IMPORT transfert",!
 Set Exit=0
 For  Do  Quit:Exit
 .READ K:30 ELSE  Set Exit=1 Quit
 .Quit:K=""
 .Set Cnt=Cnt+1
 .Set ^KATALOOG("BLUMIND",Cnt)=$TR(K,$C(9),"\")
 Quit
 
BLUMSAVE D ^cA604
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set PRNr=0
 Write !,"Opbouw index"
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Set:$D(^KPR(PRNr,"J5005")) ^HULP(%J,$$UPTRIMAN^vhRtn1($P(^KPR(PRNr,0),D)))=PRNr
 Write !,"Transfert blumgegevens naar KPR",!
 s Test=0
 For Cnt=1:1:$O(^KATALOOG("BLUMIND",""),-1) Do  ;q:Test
 .Set Prod=$P(^KATALOOG("BLUMIND",Cnt),D,1)
 .Set Ref=$P(^KATALOOG("BLUMIND",Cnt),D,2)
 .Set (Nxt,KT)=$$UPTRIMAN^vhRtn1(Prod)
 .Set:Nxt?1.N Nxt=Nxt_" "
 .Quit:Nxt=""
 .For  Set Nxt=$O(^HULP(%J,Nxt)) Quit:$E(Nxt,1,$L(KT))'=KT  Do
 ..Set PRNr=^HULP(%J,Nxt)
 ..Write !,Prod," -> ",$P(^KPR(PRNr,0),D)," : ",Ref
 ..Set $P(^KPR(PRNr,3),D,1)=Ref
 ..Set $P(^KPR(PRNr,3),D,2)="BLUM96"
 ..s Test=1
 Kill ^HULP(%J)
 Quit
 
BLUMEXP K  d INIT^vhTERMINA
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 U 0:(::::4096)
 Set PRNr=0,Cnt=0
 Write !,"Opbouw hulpbestand"
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do:$D(^KPR(PRNr,"J5005"))
 .Quit:"09"'[$E($P(^KPR(PRNr,2),D,25))  ; Alleen 0 & 9 produkten
 .Quit:'$P(^KPR(PRNr,1),D,20)  ; Alleen stockprodukten
 .Set Kort=$$UPTRIMAN^vhRtn1($P(^KPR(PRNr,0),D))
 .Set KortTekst=$P(^KPR(PRNr,0),D)
 .Set MBH=$$MBH(PRNr)
 .Set Rec=$$TRIM($E(KortTekst,1,11))_$C(9)_$$TRIM($E(KortTekst,12,21))_$C(9)_$$TRIM($E(KortTekst,22,25))
 .Set Ref=""
 .Set:$P(^KPR(PRNr,3),D,2)="BLUM96" Ref=$P(^KPR(PRNr,3),D,1)
 .Set Rec=Rec_$C(9)_MBH_$C(9)_Ref
 .Set Cnt=Cnt+1
 .Set ^HULP(%J,"PRINT",Kort)=Rec
 Write !,"Transfert blumindex ",Cnt," produkten",!
 Do INIT^PROC("KATALOOGP","PD")
 Use 0:(::::4096)
 Do PRINT^OUTPUT(.PD,"TS")
 Kill ^HULP(%J,"PRINT")
 Quit
 
VERT d ^cA604
 Set I="BLUMIND"
 For  Set I=$O(^KATALOOG(I)) Quit:I=""  Do
 .Set L=""
 .For  Set L=$O(^KATALOOG(I,L)) Quit:L=""  Do
 ..Set Rec=^KATALOOG(I,L) 
 ..Quit:$P(Rec,D)  ;Produkt
 ..Set Ned=$P(Rec,D,2)
 ..Set Frans=$P(Rec,D,3)
 ..Set PL=$O(^KATALOOG(I,L))
 ..Set (PRNr,KortTekst,LangN,LangF)=""
 ..Set:PL PRNr=$P(^KATALOOG(I,PL),D)
 ..Set:PRNr KortTekst=$P(^KPR(PRNr,0),D),LangN=$P(^KPR(PRNr,0),D,2)_","_$P(^KPR(PRNr,0),D,11)
 ..Set:PRNr KortTekst=$P(^KPR(PRNr,0),D),LangF=$P(^KPR(PRNr,1),D,22)_","_$P(^KPR(PRNr,3),D,21)
 ..Write @F11,@F1
 ..Set FP=2001 Write @F,"  ",Ned
 ..Set Frans=$$ASK^vhINP("V ",50,Frans,"  "_LangN,"  "_LangF)
 ..Quit:$L(Frans)<2
 ..Set $P(^KATALOOG(I,L),D,3)=Frans
 Quit
 
CDROM Do ^cA604
 Use 0:(::::4096)
 Set (H,G,S,KortT)=""
 READ !,"TRANSFERT CONVERSIE (Pc,Mac of leeg)",TMode
 READ !,"TAAL (N of F)",Taal
 Read !,"TRANSFERT",k
 Do VANNAAR^vhTERMINA(TMode)
 Set Titel="ProduktNaam\IdentNummer\Verpakking\Per Stuk\Omschrijving 1\Omschrijving 2\Kleur\Katern\Bladzijde"
 Set:Taal="F" Titel="Désignation\Code d'article\Emballage\Par pièce\Description 1\Description 2\Couleur\Chapitre\Page"
 Write !,$TR(Titel,"\"_FVAN,$C(9)_FNAAR)
 Set KatBL="INSERTA;CLIP;MODUL;ALPHA;TANDEMBOX;INTRABOX;TANDEMBOX;TANDEM;Standard;Verbind;PockDoor;Verarb;VerMasch;Nachschl"
 Set KatVH="Stalrug;GL;LA;EL;SD;CY;VB;SB;ZZ"
 For  Set H=$O(^KPH(H)) Q:H=""  Do
 .Quit:H["D"
 .For  Set G=$O(^KPH(H,G)) Q:G=""  Do
 ..For  Set S=$O(^KPH(H,G,S)) Q:S=""  Do
 ...For  Set KortT=$O(^KPH(H,G,S,"  ",KortT)) Q:KortT=""  Do
 ....Set PRNr=^(KortT)
 ....Quit:'$P(^KPR(PRNr,1),D,20)
 ....Set Korttxt=$P(^KPR(PRNr,0),D,1)
 ....Set IdentNr=$P(^KPR(PRNr,2),D,25)
 ....Quit:$E(IdentNr)'=0&($E(IdentNr)'=9)
 ....Set Blz=$TR($P(^KPR(PRNr,3),D,1),"-",".")
 ....Set Kat=$P(^KPR(PRNr,3),D,2)
 ....Set KatNr=$P(Blz,".")
 ....Set IsKatB=$E(Kat)="B"
 ....Set:$L(Kat) Kat=$S(IsKatB:"BLUM:",1:"VH:")_$P($S(IsKatB:KatBL,1:KatVH),";",KatNr)
 ....Set LTN1=$TR($P(^KPR(PRNr,0),D,2),FVAN,FNAAR)
 ....Set LTN2=$TR($P(^KPR(PRNr,0),D,11),FVAN,FNAAR)
 ....Set LTF1=$TR($P(^KPR(PRNr,1),D,22),FVAN,FNAAR)
 ....Set LTF2=$TR($P(^KPR(PRNr,3),D,21),FVAN,FNAAR)
 ....Set Kleur=$E(Korttxt,22,25)
 ....Set (KleurN,KleurF)=""
 ....Set:$L(Kleur) KleurN=$TR($P($G(^KCOL(Kleur_" ","N")),D),FVAN,FNAAR)
 ....Set:$L(Kleur) KleurF=$TR($P($G(^KCOL(Kleur_" ","F")),D),FVAN,FNAAR)
 ....Set Key=$O(^KPR(PRNr,"J"))
 ....Set PerSt=$P(^KPR(PRNr,Key),D,13)
 ....Set PakG=$P(^KPR(PRNr,Key),D,16)
 ....Set PakN=$P(^KPR(PRNr,Key),D,15)
 ....Set PakK=$P(^KPR(PRNr,Key),D,14)
 ....Set Pak=PakG_$S(PakN:";"_PakN,1:"")_$S(PakK:";"_PakK,1:"")
 ....Write !,Korttxt,$C(9),IdentNr,$C(9),Pak,$C(9),$S(PerSt=1:"*",1:"")
 ....Write:Taal="N" $C(9),LTN1,$C(9),LTN2,$C(9),KleurN
 ....Write:Taal'="N" $C(9),LTF1,$C(9),LTF2,$C(9),KleurF
 ....Write $C(9),Kat,$C(9),Blz
 Write "~~~~"
 Quit