KLACHT ; Klachtenbehandeling [ 11/07/2003  1:02 PM ]
 ;
 Quit
 ;
ConvertOmschrijving
 New KlachtId
 Write !,"^KlachtD",!
 Set KlachtId=""
 For  Set KlachtId=$O(^KlachtD(KlachtId)) Quit:KlachtId=""  Do
 . If $O(^KlachtD(KlachtId,"O","")) Write !,KlachtId
 . Set R=^KlachtD(KlachtId,"O")
 . Kill ^KlachtD(KlachtId,"O")
 . Set ^KlachtD(KlachtId,"O",1)=R
 Write !,"^KlachtCD",!
 Set KlachtId=""
 For  Set KlachtId=$O(^KlachtCD(KlachtId)) Quit:KlachtId=""  Do
 . Set CopyId=""
 . For  Set CopyId=$O(^KlachtCD(KlachtId,CopyId)) Quit:CopyId=""  Do
 ..  If $O(^KlachtCD(KlachtId,CopyId,"O","")) Write !,KlachtId," - ",CopyId
 ..  Set R=^KlachtCD(KlachtId,CopyId,"O")
 ..  Kill ^KlachtCD(KlachtId,CopyId,"O")
 ..  Set ^KlachtCD(KlachtId,CopyId,"O",1)=R 
 Quit
 ;
VERWERK 
 New R,KlachtId,Derde
 For  Do  If 'KlachtId,KlachtId'="*" Quit
 .Do DISPLAY^vhScherm("KLACHT")
 .Kill RegPar
 .Set R=$$SELECT^KLACHTS(),KlachtId=$P(R,D),Derde=$P(R,D,2,3)
 .If KlachtId="*","KL"[$P(Derde,D),$P(Derde,D,2) Do
 ..Set R=$S($P(Derde,D)="L":"LEVER",1:"KLANT")_"($P(Derde,D,2))"
 ..Do @R
 .Else  Do
 ..Set RegPar("OPROEP")="MENU"
 ..If KlachtId Do EDIT(KlachtId) Quit
 ..If KlachtId="*" Do NIEUW()
 .Set:'$D(^KlachtD) KlachtId="-"
 Quit
 ;
LEVER(LEVNr,KlachtId) 
 New RegPar
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("KLACHT")
 Set:'$G(LEVNr) LEVNr=$$SELECT^LEVER()
 Do:LEVNr
 .Set KlachtId=$G(KlachtId,"*")
 .If KlachtId,'$D(^KlachtI("L",LEVNr,KlachtId)) Set KlachtId=""
 .If 'KlachtId,KlachtId'="*" Set KlachtId=$P($$SELECT^KLACHTS("L",LEVNr),D)
 .If 'KlachtId,KlachtId'="*" Quit
 .Set RegPar("OPROEP")="LEVER"
 .If 'KlachtId Do
 ..Set RegPar("LEVNR")=LEVNr,RegPar("DEFAULT","VERANTW")="RegPar(""LEVNR"")"
 ..Do NIEUW(.RegPar)
 .Else  Do EDIT(KlachtId)
 Do REFRESH^vhTERMINA()
 Quit
 ;
KLANT(KLNr,KlachtId) 
 New RegPar
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("KLACHT")
 Set:'$G(KLNr) KLNr=$$SELECT^KLANT6()
 Do:KLNr
 .Set KlachtId=$G(KlachtId,"*")
 .If KlachtId,'$D(^KlachtI("K",KLNr,KlachtId)) Set KlachtId=""
 .If 'KlachtId,KlachtId'="*" Set KlachtId=$P($$SELECT^KLACHTS("K",KLNr),D)
 .If 'KlachtId,KlachtId'="*" Quit
 .Set RegPar("OPROEP")="KLANT"
 .If 'KlachtId Do
 ..Set RegPar("KLNR")=KLNr,RegPar("DEFAULT","VERANTW")="RegPar(""KLNR"")"
 ..Do NIEUW(.RegPar)
 .Else  Do EDIT(KlachtId)
 Do REFRESH^vhTERMINA()
 Quit
 ;
TOE(LEVNr,TOENr,TLNr) 
 New zb,R,RegPar,Lever,PRNr,CB
 Set LEVNr=$G(LEVNr),TOENr=$G(TOENr),TLNr=$G(TLNr)
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("KLACHT")
 If 'TOENr Set:LEVNr Lever("L")=LEVNr Set TOENr=$$SELECT^FLOW("KTO","KTO1",1,,.Lever)
 If TOENr,$D(^KTO1(TOENr)) Do
 .Set RegPar("OPROEP")="TOE"
 .Set LEVNr=$P(^KTO1(TOENr),D),RegPar("LEVNR")=LEVNr
 .Do:TLNr
 ..Set R=$G(^KTO(LEVNr,TOENr,TLNr)),PRNr=$P(R,D,2)
 ..Quit:'PRNr
 ..Set R(1)="1`Leverancier : "_$P(^KLE(^KL1(LEVNr),0),D,2),R(2)="2`Toelevering : "_TOENr
 ..Set R(3)="3`Produkt     : "_$P(^KPR(PRNr,0),D)
 ..Set R=$$WILD^vhPOPUP("C;C","-1OM","Incident betreffende",.R,"1;2;3",.CB)
 ..Quit:zb="CANC"
 .Quit:$G(zb)="CANC"
 .Do NIEUW(.RegPar)
 Do REFRESH^vhTERMINA()
 Quit
 ;
RCP(RCPNr) 
 New RegPar,LEVNr
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("KLACHT")
 Set:'$G(RCPNr) RCPNr=$$SELECT^EWRCP()
 Do:RCPNr
 .Set RegPar("OPROEP")="RCP"
 .Set LEVNr=$P(^RCP("D",RCPNr),D,2),RegPar("LEVNR")=LEVNr
 .Do NIEUW(.RegPar)
 Do REFRESH^vhTERMINA()
 Quit
 ;
ORD(KLNr,ORDNr,OLNr) 
 New I,R,RegPar,Klant,KlachtId,Beperk
 Set KLNr=$G(KLNr),ORDNr=$G(ORDNr),OLNr=$G(OLNr)
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("KLACHT")
 If 'ORDNr Set:KLNr Klant("K")=KLNr Set ORDNr=$$SELECT^FLOW("KOD","KO1",1,,.Klant)
 If ORDNr,$D(^KO1(ORDNr,"F")) Do
 .Set KLNr=$P(^KO1(ORDNr,"F"),D),Beperk("KLNr")=KLNr,KlachtId=$$KLACHTID("O",ORDNr,1,.Beperk)
 .If 'KlachtId,KlachtId'="*" Quit
 .Set RegPar("OPROEP")="ORD"
 .If 'KlachtId Do
 ..Set R=$$ORDDATA^KLACHT2(KLNr,ORDNr,OLNr)
 ..Quit:R=""
 ..Set RegPar("KLNR")=KLNr
 ..For I=1:1:$L(R,";") Do
 ...If $P($P(R,";",I),"#")="W" Set RegPar("WAARDE")=$P($P(R,";",I),"#",2)
 ...Else  Set RegPar("RZTELEM",$O(RegPar("RZTELEM",""),-1)+1)=$P(R,";",I)
 ..Set KlachtId=$P($$SELECT^KLACHTS("K",KLNr,"RB"),D)
 ..If 'KlachtId,KlachtId'="*" Quit
 ..If KlachtId Do EDIT(KlachtId,,.RegPar) Quit
 ..Do NIEUW(.RegPar)
 .Else  Do EDIT(KlachtId)
 Do REFRESH^vhTERMINA()
 Quit
 ;
BON(KLNr,BONNr,BLNr) 
 New I,R,RegPar,Klant,KlachtId,Beperk
 Set KLNr=$G(KLNr),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("KLACHT")
 If 'BONNr Set:KLNr Klant("K")=KLNr Set BONNr=$$SELECT^FLOW("KUL","KU1",1,,.Klant)
 If BONNr,$D(^KU1(BONNr,"F")) Do
 .Set KLNr=$P(^KU1(BONNr,"F"),D),Beperk("KLNr")=KLNr,KlachtId=$$KLACHTID("B",BONNr,1,.Beperk)
 .If 'KlachtId,KlachtId'="*" Quit
 .Set RegPar("OPROEP")="BON"
 .If 'KlachtId Do
 ..Set R=$$BONDATA^KLACHT2(KLNr,BONNr,BLNr)
 ..Quit:R=""
 ..Set RegPar("KLNR")=KLNr
 ..For I=1:1:$L(R,";") Do
 ...If $P($P(R,";",I),"#")="W" Set RegPar("WAARDE")=$P($P(R,";",I),"#",2)
 ...Else  Set RegPar("BTRELEM",$O(RegPar("BTRELEM",""),-1)+1)=$P(R,";",I)
 ..Set KlachtId=$P($$SELECT^KLACHTS("K",KLNr,"RB"),D)
 ..If 'KlachtId,KlachtId'="*" Quit
 ..If KlachtId Do EDIT(KlachtId,,.RegPar) Quit
 ..Do NIEUW(.RegPar)
 .Else  Do EDIT(KlachtId)
 Do REFRESH^vhTERMINA()
 Quit
 ;
FAKT(FaktTyp,FANr,BONNr,BLNr) 
 New I,R,RegPar,KLNr,KlachtId
 Set FaktTyp=$G(FaktTyp),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("KLACHT")
 Do:$G(FANr)
 .Set KLNr=$P($G(@("^KFA"_FaktTyp_"(""F"",FANr,0,0)")),D),KlachtId=$$KLACHTID("F",FANr,1)
 .If 'KlachtId,KlachtId'="*" Quit
 .Set RegPar("OPROEP")="FAKT"
 .If 'KlachtId Do
 ..Set R=$$FAKTDATA^KLACHT2(KLNr,FaktTyp,FANr,BONNr,BLNr)
 ..Quit:R=""
 ..Set RegPar("KLNR")=KLNr
 ..For I=1:1:$L(R,";") Do
 ...Quit:$P(R,";",I)=""
 ...If $P($P(R,";",I),"#")="W" Set RegPar("WAARDE")=$P($P(R,";",I),"#",2)
 ...Else  Set RegPar("BTRELEM",$O(RegPar("BTRELEM",""),-1)+1)=$P(R,";",I)
 ..Set KlachtId=$P($$SELECT^KLACHTS("K",KLNr,"RB"),D)
 ..If 'KlachtId,KlachtId'="*" Quit
 ..If KlachtId Do EDIT(KlachtId,,.RegPar) Quit
 ..Do NIEUW(.RegPar)
 .Else  Do EDIT(KlachtId)
 Do REFRESH^vhTERMINA()
 Quit
 ;
PROD(PRNr) 
 New RegPar,LEVNr
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("KLACHT")
 Set:'$G(PRNr) PRNr=$$SELECT^PRODUKT6()
 Do:PRNr
 .Set RegPar("OPROEP")="PROD"
 .Set LEVNr=$P(^($O(^KPR(PRNr,"J"))),D),RegPar("LEVNR")=LEVNr
 .Do NIEUW(.RegPar)
 Do REFRESH^vhTERMINA()
 Quit
 ;
KRED(KLNr,ORDNr,Dummy,Nieuw) 
 New R,RegPar,Klant,PRNr,KlachtId,OLNr,Reden,Type,Groep,Taal,Quit
 Set KLNr=$G(KLNr),ORDNr=$G(ORDNr),Dummy=$G(Dummy),Nieuw=$G(Nieuw)
 Do STORE^vhTERMINA()
 Do:'Dummy
 .Do DISPLAY^vhScherm("KLACHT")
 .If 'ORDNr Set:KLNr Klant("K")=KLNr Set ORDNr=$$SELECT^FLOW("KOD","KO1",1,,.Klant)
 If ORDNr,$D(^KO1(ORDNr,"F")) Do
 .Set RegPar("OPROEP")="KRED"
 .Set KLNr=$P(^KO1(ORDNr,"F"),D),KlachtId=""
 .Do:Nieuw=""
 ..Set KlachtId="",Quit=0
 ..For  Set KlachtId=$O(^KlachtI("O",ORDNr,KlachtId)) Quit:KlachtId=""  Do  Quit:Quit
 ...Set R=$G(^KlachtD(KlachtId))
 ...If $P(R,D)="K",$P(R,D,2)=KLNr Set Quit=1
 .Do KREDPAR(ORDNr,.RegPar)
 .Set:'KlachtId RegPar("KLNR")=KLNr,RegPar("KRED")=1
 .If Dummy Do DUMMYSTM(.RegPar) Quit
 .Set OLNr=100,Reden=""
 .For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do  Quit:$L($P(Reden," - ",2))
 ..Set R=^KOD(KLNr,"F",ORDNr,OLNr)
 ..Quit:$P($P(R,D,17),"#")'="KF11"  Quit:$P(R,D,5)'[" - "
 ..Set Reden=$P(R,D,5)
 .If 'KlachtId,$L(Reden) Do
 ..Set Type=""
 ..For  Set Type=$O(^RES("FLOWORD","PI","KREDIETNOTA","D",Type)) Quit:Type=""  Do  Quit:$L(Taal)
 ...Set Taal=""
 ...For  Set Taal=$O(^RES("FLOWORD","PI","KREDIETNOTA","D",Type,Taal)) Quit:Taal=""  Do  Quit:R=Reden
 ....Set R=^RES("FLOWORD","PI","KREDIETNOTA","D",Type,Taal)
 ..Quit:Type=""
 ..Set R=^RES("FLOWORD","PI","KREDIETNOTA","D",Type),Reden=$P($P(R,"`",2)," - ",2)
 ..Set Type=""
 ..For  Set Type=$O(^RES("KLACHT","PI","TYPE","D",Type)) Quit:Type=""  Do  Quit:$P(R,"`",2)=Reden
 ...Set R=^RES("KLACHT","PI","TYPE","D",Type)
 ..Quit:Type=""
 ..Set Groep=$P(R,"`",3),RegPar("TYPE")=Type,RegPar("GROEP")=Groep
 .If 'KlachtId Do NIEUW(.RegPar) Quit
 .Do:'Dummy EDIT(KlachtId)
 Do REFRESH^vhTERMINA()
 Quit
 ;
KREDPAR(ORDNr,RegPar) 
 New I,J,R,PRNr,OLNr,Omschr,FANr,Type,Value
 If ORDNr,$D(^KO1(ORDNr,"F")) Do
 .Set KLNr=$P(^KO1(ORDNr,"F"),D)
 .Set OLNr=100,FANr=""
 .For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do  Quit:FANr
 ..Set R=^KOD(KLNr,"F",ORDNr,OLNr),Omschr=$P(R,D,5)
 ..Set:Omschr["Cfr. factuur" FANr=$TR($P(Omschr," ",3),".","")
 ..Set:Omschr["Cfr. facture" FANr=$TR($P(Omschr," ",3),".","")
 ..Set:Omschr["Cfr. rechnung" FANr=$TR($P(Omschr," ",3),".","")
 .Do:FANr
 ..Set I=""
 ..For  Set I=$O(RegPar("BTRELEM",I)) Quit:I=""  Quit:RegPar("BTRELEM",I)="F#"_FANr
 ..Quit:I'=""
 ..Set RegPar("BTRELEM",$O(RegPar("BTRELEM",""),-1)+1)="F#"_FANr
 .Set R=$$ORDDATA^KLACHT2(KLNr,ORDNr,"AutoSel")
 .For I=1:1:$L(R,";") Do
 ..Set Type=$P($P(R,";",I),"#"),Value=$P($P(R,";",I),"#",2)
 ..If Type="W" Set RegPar("WAARDE")=$G(RegPar("WAARDE"))+Value Quit
 ..Set J=""
 ..For  Set J=$O(RegPar("BTRELEM",J)) Quit:J=""  Quit:RegPar("BTRELEM",J)=Type_"#"_Value
 ..Quit:J'=""
 ..For  Set J=$O(RegPar("RZTELEM",J)) Quit:J=""  Quit:RegPar("RZTELEM",J)=Type_"#"_Value
 ..Quit:J'=""
 ..Else  If Type="O" Do
 ...Set RegPar("RZTELEM",$O(RegPar("RZTELEM",""),-1)+1)=$P(R,";",I)
 ..Else  Do
 ...Set RegPar("BTRELEM",$O(RegPar("BTRELEM",""),-1)+1)=$P(R,";",I)
 Quit
 ;
PROF(KLNr,ORDNr,Dummy,Nieuw) 
 New I,R,RegPar,Klant,KlachtId,Behandel,Quit
 Set KLNr=$G(KLNr),ORDNr=$G(ORDNr),Dummy=$G(Dummy),Nieuw=$G(Nieuw)
 Do STORE^vhTERMINA()
 Do:'Dummy
 .Do DISPLAY^vhScherm("KLACHT")
 .If 'ORDNr Set:KLNr Klant("K")=KLNr Set ORDNr=$$SELECT^FLOW("KOD","KO1",1,,.Klant)
 If ORDNr,$D(^KO1(ORDNr,"F")) Do
 .Set RegPar("OPROEP")="PROF"
 .Set KLNr=$P(^KO1(ORDNr,"F"),D),KlachtId=""
 .Do:Nieuw=""
 ..Set KlachtId="",Quit=0
 ..For  Set KlachtId=$O(^KlachtI("O",ORDNr,KlachtId)) Quit:KlachtId=""  Do  Quit:Quit
 ...Set R=$G(^KlachtD(KlachtId))
 ...If $P(R,D)="K",$P(R,D,2)=KLNr Set Quit=1
 .If 'KlachtId Do
 ..Set RegPar("KLNR")=KLNr,RegPar("PROF")=1
 ..If Dummy Do DUMMYSTM(.RegPar) Quit
 ..Set R=$$ORDDATA^KLACHT2(KLNr,ORDNr,"AutoSel")
 ..Quit:R=""
 ..Set RegPar("KLNR")=KLNr
 ..For I=1:1:$L(R,";") Do
 ...If $P($P(R,";",I),"#")="W" Set RegPar("WAARDE")=$P($P(R,";",I),"#",2)
 ...Else  Set RegPar("RZTELEM",$O(RegPar("RZTELEM",""),-1)+1)=$P(R,";",I)
 ..Set Behandel=1
 ..Do NIEUW(.RegPar)
 .Else  Do:'Dummy EDIT(KlachtId)
 Do REFRESH^vhTERMINA()
 Quit
 ;
DUMMY(RegPar) 
 ;
 Quit  ; Dummy-klacht buiten gebruik gesteld
 ;
 New %SC,sFL,KlachtId
 If '$G(CUserId) New CUserId Set CUserId=$$CUSERID()
 Set RegPar("DUMMY")=1,RegPar("ONDERW")="Dummy"
 Set RegPar("OMSCHR",1)="Dummy"
 Set RegPar("IPREG")=$G(RegPar("IPREG"),CUserId),RegPar("IPBEH")=$G(RegPar("IPBEH"),0)
 Do INIT^KLACHT3,SAVE(.sFL)
 Quit
 ;
DUMMYSTM(RegPar) 
 If '$G(CUserId) New CUserId Set CUserId=$$CUSERID()
 Set RegPar("IPREG")=CUserId,RegPar("IPBEH")=$$USERID^vhUSER("STM")
 Do DUMMY(.RegPar)
 Quit
 ;
 ; Call back voor groeplink met type
CBGLINK(Select) 
 Quit ";"_$P(Select,"`",3)_";;"[(";"_$P(sFL(1),"\",4)_";")
 ;
 ; Call back voor elementtype
CBELTYP(Select) 
 Quit ";"_$P(Select,"`",3)_";"[(";"_$P(sFL(1),"\")_";")
 ;
 ; RegPar bevat default waarden als .RegPar doorgegeven
NIEUW(RegPar) 
 New %SC,sFL,KlachtId,BTRELEM,RZTELEM
 If '$G(CUserId) New CUserId Set CUserId=$$CUSERID()
 If CUserId Do
 .Do NIEUW^vhScherm("KLACHTR",,,,,,3)
 .If '%SC Do
 ..If '$G(RegPar("KRED")),'$G(RegPar("PROF"))
 ..Else  Do DUMMYSTM(.RegPar)
 .Else  Do SAVE(.sFL)
 .Do:";"_$P(sFL(1),D,20)_";"[";TN;"
 ..New R,ORDNr,RechtZet,RZTyp
 ..Set RechtZet=""
 ..For  Set RechtZet=$O(sFL("R",RechtZet)) Quit:RechtZet=""  Do
 ...Set R=sFL("R",RechtZet),RZTyp=$P(R,"#"),ORDNr=$P(R,"#",2)
 ...Quit:RZTyp'="O"  Quit:'ORDNr
 ...Quit:'$P($G(^KO1(ORDNr,"F")),D)  ; Order onbekend
 ...Quit:$P($G(^KO1(ORDNr,"F")),D,2)  ; Order reeds op bon
 ...Do CheckTerugname^FLOWORD5(ORDNr)
 Quit
 ;
EDIT(KlachtId,Behandel,RegPar,EditContact,ModAllFields) 
 New %SC,%TC,R,sFL
 Set Behandel=$G(Behandel),RegPar("RegPar")=$D(RegPar)
 If '$G(CUserId) New CUserId Set CUserId=$$CUSERID()
 If CUserId Do
 .Set R=^KlachtD(KlachtId)
 .If '$G(EditContact),$P(R,D,26),$P(R,D,27),'$G(ModAllFields) Set R=$$RAADPL(KlachtId) Quit
 .Do ADD^vhLock("^KlachtD(KlachtId)")
 .If %TC Do
 ..If '$G(EditContact),$P(R,D,23),$P(R,D,24) Set Behandel=1
 ..If $G(EditContact) Do
 ...Do NIEUW^vhScherm("KLACHTR",,,,,,3,"A")
 ..Else  Do EDIT^vhScherm("KLACHTR",,,,,,3)
 ..If %SC Do
 ...Do:Behandel
 ....Set R=^KlachtD(KlachtId)
 ....Quit:$P(R,D,23,24)'=D
 ....If '$D(sFL("R")) Do
 .....Set R=sFL(1)
 .....If $P(R,D)="L" Set R="leverancier "_$P(^KLE(^KL1($P(R,D,2)),0),D,2)
 .....Else  If $P(R,D)="K" Set R="klant "_$P(^KKL(^KK1($P(R,D,2)),0),D,2)
 .....Else  Set R=""
 .....Quit:$$^vhTXTPOP("KLACHT","NORZREFS","",KlachtId,R,$$ONOM(KlachtId,,1))
 .....Set $P(sFL(1),D,23,24)=D
 ...Do SAVE(.sFL)
 ..Do REMOVE^vhLock("^KlachtD(KlachtId)")
 .Else  Do
 ..Do STORE^vhTERMINA()
 ..Set R=$$RAADPL(KlachtId,,0)
 ..Do LDISP^vhLock("^KlachtD(KlachtId)","Klacht "_KlachtId)
 ..Do REFRESH^vhTERMINA()
 Quit
 ;
SAVE(sFL) 
 New I,R,KlachtId,KLNr,MailVControle,MailBHGenomen,MailBHVerantw,MailPRProblem,MailOmschakPM,MailTegemLev,MailMagazijn
 Set KlachtId=sFL("ID")
 Goto SaveContact:$G(EditContact)
 If KlachtId Do
 .Set R=^KlachtD(KlachtId)
 .
 .; Voorraadkontrole
 .Set:";"_$P(sFL(1),D,20)_";"[";VC;" MailVControle=";"_$P(R,D,20)_";"'[";VC;"
 .
 .; Omschakeling - PM
 .Set:$P(sFL(1),D,4,5)="OMS\PM" MailOmschakPM=$P(R,D,4,5)'="OMS\PM"
 .
 .; Rechtzetting leverancier
 .Set:";"_$P(sFL(1),D,20)_";"[";TL;" MailTegemLev=";"_$P(R,D,20)_";"'[";TL;"
 .
 .; Product probleem
 .If $P(sFL(1),D,4)'="DEF",$P(sFL(1),D,4)'="FPR",$P(sFL(1),D,4)'="BSC"
 .Else  If $P(sFL(1),D,4)=$P(R,D,4)
 .Else  If $P(sFL(1),D,5)'="BLUM",$P(sFL(1),D,5)'="AND"
 .Else  If $P(sFL(1),D,5)=$P(R,D,5)
 .Else  Set MailPRProblem=1
 .
 .; Probleem magazijn
 .If $P(sFL(1),D,4)'="VGP",$P(sFL(1),D,4)'="VVP"
 .Else  If $P(sFL(1),D,4)=$P(R,D,4)
 .Else  Set MailMagazijn=1
 .Set:'$G(MailMagazijn) MailMagazijn=($P(sFL(1),D,5)="MAG")
 .
 .; Behandelverantwoordelijke verschillend van registratiegebruiker
 .If $P(sFL(1),D,21),$P(sFL(1),D,21)'=$P(sFL(1),D,30) Set MailBHVerantW=$P(R,D,21)'=$P(sFL(1),D,21)
 .
 .; Behandelaar verschillend van registratiegebruiker
 .If $P(sFL(1),D,23),$P(sFL(1),D,23)'=$P(sFL(1),D,30) Set MailBHGenomen=$P(R,D,23)'=$P(sFL(1),D,23)
 .
 .Do DELETE(KlachtId)
 .Set $P(sFL(1),D,32)=CUserId,$P(sFL(1),D,33)=$H
 Else  Do
 .Set KlachtId=$$NEXTID(),sFL("ID")=KlachtId
 .
 .; Voorraadkontrole
 .Set MailVControle=";"_$P(sFL(1),D,20)_";"[";VC;"
 .
 .; Omschakeling - PM
 .Set MailOmschakPM=$P(sFL(1),D,4,5)="OMS\PM"
 .
 .; Rechtzetting leverancier
 .Set MailTegemLev=";"_$P(sFL(1),D,20)_";"[";TL;"
 .
 .; Product probleem
 .If $P(sFL(1),D,4)'="DEF",$P(sFL(1),D,4)'="FPR",$P(sFL(1),D,4)'="BSC"
 .Else  If $P(sFL(1),D,5)'="BLUM",$P(sFL(1),D,5)'="AND"
 .Else  Set MailPRProblem=1
 .
 .; Probleem magazijn
 .If $P(sFL(1),D,4)'="VGP",$P(sFL(1),D,4)'="VVP",$P(sFL(1),D,5)'="MAG"
 .Else  Set MailMagazijn=1
 .
 .; Behandelverantwoordelijke verschillend van registratiegebruiker
 .Set:$P(sFL(1),D,21) MailBHVerantW=$P(sFL(1),D,21)'=$P(sFL(1),D,30)
 .
 .; Behandelaar verschillend van registratiegebruiker
 .Set:$P(sFL(1),D,23) MailBHGenomen=$P(sFL(1),D,23)'=$P(sFL(1),D,30)
 .
 .If ";"_$P(sFL(1),D,20)_";"'[";TN;",";"_$P(sFL(1),D,20)_";"'[";NL;"
 .Else  Do  ; Terugname of nalevering automatisch in behandeling
 ..For I=1:1 Set R=$G(sFL("B",I)) Quit:R=""  Quit:"OBFV"[$P(R,"#")
 ..Quit:R=""
 ..Set $P(sFL(1),D,23)=CUserId,$P(sFL(1),D,24)=$H
 .If '$G(RegPar("KRED")),'$G(RegPar("PROF")) Quit  ; Automatisch in behandeling indien behandeler = CUserId
 .Quit:$P(sFL(1),D,21)'=CUserId
 .Set $P(sFL(1),D,23)=CUserId,$P(sFL(1),D,24)=$H
 Set ^KlachtD(KlachtId)=sFL(1)
 Merge ^KlachtD(KlachtId,"O")=sFL("O")
 Merge ^KlachtD(KlachtId,"C")=sFL("C")
 Merge ^KlachtD(KlachtId,"R")=sFL("R")
 Merge ^KlachtD(KlachtId,"B")=sFL("B")
 Do BLDIND(KlachtId)
 Do:$G(MailVControle) MAIL(KlachtId,"VCTR",.sFL)
 Do:$G(MailBHVerantW) MAIL(KlachtId,"BHVW",.sFL)
 Do:$G(MailBHGenomen) MAIL(KlachtId,"BHGN",.sFL)
 Do:$G(MailPRProblem) MAIL(KlachtId,"PRBA",.sFL)
 Do:$G(MailMagazijn) MAIL(KlachtId,"PRMA",.sFL)
 Do:$G(MailOmschakPM) MAIL(KlachtId,"OMPM",.sFL)
 Do:$G(MailTegemLev) MAIL(KlachtId,"RZTL",.sFL)
 Quit
 ;
SaveContact
 New R,NextContact
 Do:$D(sFL("C"))
 . Set R=QU(1)_D_$H
 . Set NextContact=$O(^KlachtD(KlachtId,"C",""),-1)+1,^KlachtD(KlachtId,"C",NextContact)=R_D_sFL("C",1),$P(^KlachtD(KlachtId),D,34,35)=R
 Quit
 ;
DELOBJ(KlachtId) 
 Do DELETE(KlachtId,1)
 Quit
 ;
DELETE(KlachtId,DelObj) 
 New R,X,CopyId,KLNr
 Set DelObj=$G(DelObj)
 If DelObj Kill ^KlachtCD(KlachtId)
 Else  Do
 .Set CopyId=$O(^KlachtCD(KlachtId,""),-1)+1
 .Merge ^KlachtCD(KlachtId,CopyId)=^KlachtD(KlachtId)
 Do DELIND(KlachtId)
 Kill ^KlachtD(KlachtId)
 Quit
 ;
 ; Nieuw KlachtId
NEXTID() 
 New KlachtId
 Lock +KlachtID
 Set KlachtId=$G(^KlachtD)+1,^KlachtD=KlachtId
 Lock -KlachtID
 Quit KlachtId
 ;
RUBREXEC 
 New I,R,Order,OrdBon,PMBon
 If X="." Do
 .If $G(RegPar("OPROEP"))'="KRED",$G(RegPar("OPROEP"))'="PROF"
 .Else  Set X=$$^vhTXTPOP("KLACHT","VERPLICHT")
 If X'=".",X'="V" Do
 .If $G(Behandel),KlachtId,$$STATUS^KLACHTO(KlachtId)<2 Set %SC=1
 .If $G(RegPar("RegPar")) Set %SC=1
 If X="-" Do
 .If '$$CHECKsFL() Set X="" Quit
 .Quit:'%SC
 .Do:$$ISTNNL(.sFL)
 ..If ";"_$P(sFL(1),D,20)_";"[";TN;" Do
 ...Set PMBon=0
 ...For I=1:1 Set R=$G(sFL("B",I))  Quit:R=""  Quit:$P(R,"#")="F"
 ...If R="" For I=1:1 Set R=$G(sFL("B",I))  Quit:R=""  If $P(R,"#")="B" Set PMBon=1 Quit
 ...Set OrdBon=$$^vhTXTPOP("KLACHT","ORDER","","terugname"_$P("\ of +/-bon",D,PMBon+1),"Terugname",PMBon)
 ...Do:OrdBon="O" TNNL(.sFL,"B") Do:OrdBon="B" PMBON(.sFL)
 ..If ";"_$P(sFL(1),D,20)_";"[";NL;" Do
 ...Set OrdBon=$$^vhTXTPOP("KLACHT","ORDER","","nalevering","Nalevering",0)
 ...Do:OrdBon="O" TNNL(.sFL,"R")
 If X="V",KlachtId,$$ASK^vhWACHTW("MANAGER",,,0) Do
 .Do DELETE(KlachtId)
 .Set X="."
 Quit
 ;
ISTNNL(sFL) 
 New IsTnNl
 If ";"_$P(sFL(1),D,20)_";"'[";TN;",";"_$P(sFL(1),D,20)_";"'[";NL;" Set IsTnNl=0
 Else  If $P(sFL(1),D)'="K" Set IsTnNl=0
 Else  Set IsTnNl=1
 If IsTnNl,";"_$P(sFL(1),D,20)_";"[";NL;" Do
 .For I=1:1 Set R=$G(sFL("R",I)) Quit:R=""  If $P(R,"#")="O" Set IsTnNl=0 Quit
 Quit IsTnNl
 ;
 ; Terugname of nalevering (opmaken order)
TNNL(sFL,ElemTyp) 
 New I,R,X,KLNr,PRNr,Count,FaktRef,Reden,Taal,Type,FANr,ORDNr,BONNr
 Do STORE^vhTERMINA()
 Set KLNr=$P(sFL(1),D,2),Taal=$P(^KKL(^KK1(KLNr),0),D,9),Count=0
 Do:ElemTyp="B"
 .Set Reden=$$FETCHPOP^vhScherm("KLACHT","TYPE",$P(sFL(1),D,4),"O"),Type=""
 .For  Set Type=$O(^RES("FLOWORD","PI","KREDIETNOTA","D",Type)) Quit:Type=""  Do  Quit:$P(R," - ",2)=Reden
 ..Set R=^RES("FLOWORD","PI","KREDIETNOTA","D",Type),R=$P(R,"`",2)
 .If Type="" Set Reden=""
 .Else  Set Reden=$G(^RES("FLOWORD","PI","KREDIETNOTA","D",Type,Taal),R)
 .For I=1:1 Quit:'$D(sFL("B",I))  Do  Quit:Count
 ..Set R=sFL("B",I)
 ..Quit:$P(R,"#")'="F"
 ..Set FANr=$P(R,"#",2),R=^KFA("F",FANr,0,0)
 ..Set R="Cfr. "_$S(Taal="F":"facture ",1:"factuur ")_$$EXTNUM^vhDTyp(FANr,0,".T",0)_$S(Taal="F":"du ",1:"van ")_$P(R,D,6)
 ..Set Count=Count+1,PRNr(Count)="T\"_R_"\\1"
 For I=1:1 Quit:'$D(sFL(ElemTyp,I))  Do
 .Set R=sFL(ElemTyp,I)
 .Quit:$P(R,"#")'="P"
 .Set R=$P(R,"#",2)_D_$P(R,"#",3)_D_D_$P(R,"#",4)
 .If ElemTyp="B",$P(R,D,2) Set $P(R,D,2)=-$P(R,D,2)
 .Set Count=Count+1,PRNr(Count)=R
 If ElemTyp="B",$L(Reden) Do
 .Set R="T\"_Reden_"\\1"
 .Set:$P(sFL(1),D,5)="KLA" $P(R,D,3)=$P($H,",",2)_";T",$P(R,D,4)=""
 .Set Count=Count+1,PRNr(Count)=R
 Do
 .New (KLNr,ORDNr,PRNr,sScr,QU)
 .Do
 ..New KLNr,ORDNr,PRNr,sScr
 ..Do INIT^vhTERMINA
 .Do BUILDOBJ^FLOWORD(KLNr,,,.PRNr)
 .Set ORDNr=UR
 If ORDNr,$D(^KO1(ORDNr)) Do
 .Set sFL("R",$O(sFL("R",""),-1)+1)="O#"_ORDNr
 .Set R=^KO1(ORDNr,"F"),BONNr=$P(R,D,2)
 .Quit:'BONNr
 .Set sFL("R",$O(sFL("R",""),-1)+1)="B#"_BONNr
 Do REFRESH^vhTERMINA()
 Quit
 ;
 ; Type = VCTR -> Voorraadkontrole
 ;        BHVW -> Behandelverantwoordelijke verschillend van registratiegebruiker
 ;        BHGN -> Behandelaar verschillend van registratiegebruiker
 ;        OMPM -> Omschakeling - PM
 ;        PRBA -> Product probleem
 ;        PRMA -> Probleem magazijn
 ;        RZTL -> Rechtzetting leverancier
MAIL(KlachtId,Type,sFL) 
 New R,MailId,KLLEVTyp,KLLEVNr,Txt,FromUser,ToUser,OnderwOfOmschr
 Set KLLEVTyp=$P(sFL(1),D),KLLEVNr=$P(sFL(1),D,2),KLLEVTyp=$S(KLLEVTyp="K":"KL",KLLEVTyp="L":"LE",1:KLLEVTyp)
 If Type="VCTR" Do
 . Quit:";"_$P(sFL(1),D,20)_";"'[";VC;"
 . Set MailId=$$SYSTEM^vhMAIL(KLLEVTyp,KLLEVNr,"Incident voorraadcontrole","KLACHTVC",,"KLACHT\"_KlachtId_"\R",1,1)
 If Type="BHVW" Do
 . Set FromUser=$P(sFL(1),D,30),ToUser=$P(sFL(1),D,21)
 . Quit:FromUser=ToUser  Quit:ToUser=$G(QU(1))
 . Quit:'$P($G(^vhUSER("D",ToUser,"K")),D,3)  ; Gebruiker wenst niet verwittigd te worden
 . Set OnderwOfOmschr=$$ONOM(KlachtId,,1) Set:OnderwOfOmschr="" OnderwOfOmschr=$$ONOM(KlachtId,,2)
 . Set Txt(1)="U bent aangesteld door "_$$USERNAME^vhUSER(FromUser)
 . Set Txt(2)="~voor de behandeling van incident "_$$EXTNUM^vhDTyp(KlachtId,0,".",0)_"."
 . Set:$L(OnderwOfOmschr) Txt(3)="~Onderwerp : "_OnderwOfOmschr
 . Set MailId=$$SYSTEM^vhMAIL(KLLEVTyp,KLLEVNr,"Incident behandeling",ToUser,.Txt,"KLACHT\"_KlachtId_"\R",1,1)
 If Type="BHGN" Do
 . Set FromUser=$P(sFL(1),D,23),ToUser=$P(sFL(1),D,30)
 . Quit:FromUser=ToUser
 . Set Txt=$$ONOM(KlachtId,,1)_"~~In behandeling genomen door "_$$USERNAME^vhUSER(FromUser)_"."
 . Set MailId=$$SYSTEM^vhMAIL(KLLEVTyp,KLLEVNr,"Incident in behandeling",ToUser,Txt,"KLACHT\"_KlachtId_"\R",1,1)
 If Type="OMPM" Do
 . Quit:$P(sFL(1),D,4,5)'="OMS\PM"
 . Set MailId=$$SYSTEM^vhMAIL(KLLEVTyp,KLLEVNr,"Incident omschakeling","KLACHTPM",,"KLACHT\"_KlachtId_"\R",1,1)
 If Type="PRBA" Do
 . If $P(sFL(1),D,4)'="DEF",$P(sFL(1),D,4)'="FPR",$P(sFL(1),D,4)'="BSC" Quit
 . If $P(sFL(1),D,5)'="BLUM",$P(sFL(1),D,5)'="AND" Quit
 . Set Txt=$$ONOM(KlachtId)_"~~"_$P(^RES("KLACHT","PI","TYPE","D",$P(sFL(1),D,4)),"`",2)_" - "_$P(^RES("KLACHT","PI","GROEP","D",$P(sFL(1),D,5)),"`",2)_"."
 . Set MailId=$$SYSTEM^vhMAIL(KLLEVTyp,KLLEVNr,"Incident product","KLACHTPM",Txt,"KLACHT\"_KlachtId_"\R",1,1)
 If Type="PRMA" Do
 . If $P(sFL(1),D,4)'="VGP",$P(sFL(1),D,4)'="VVP",$P(sFL(1),D,5)'="MAG" Quit
 . Set Txt=$$ONOM(KlachtId)_"~~"_$P(^RES("KLACHT","PI","TYPE","D",$P(sFL(1),D,4)),"`",2)_"."
 . Set MailId=$$SYSTEM^vhMAIL(KLLEVTyp,KLLEVNr,"Incident magazijn"_$S(";"_$P(sFL(1),D,20)_";"[";VC;":"/voorraadcontrole",1:""),"KLACHTMA",Txt,"KLACHT\"_KlachtId_"\R",1,1)
 If Type="RZTL" Do
 . Quit:";"_$P(sFL(1),D,20)_";"'[";TL;"
 . Set MailId=$$SYSTEM^vhMAIL(KLLEVTyp,KLLEVNr,"Incident tegemoetkoming leverancier","KLACHTPM",,"KLACHT\"_KlachtId_"\R",1,1)
 Quit
 ;
 ; Opmaken +/- bon (wijzigen bon)
PMBON(sFL) 
 New I,R,BONNr,Locals
 For I=1:1 Set R=$G(sFL("B",I)) Quit:R=""  If $P(R,"#")="B" Set BONNr=$P(R,"#",2)
 Do:$G(BONNr)
 .Set (Locals("ULNr"),UR)=BONNr
 .Do DO^vhPROGRAM("FUE^KF9","","",$G(NoMod))
 Quit
 ;
CHECKsFL() 
 New I,Rubriek,Field,Quit
 If $P(sFL(1),D,4)="DIV" Set Rubriek="O"
 Else  Do
 . Set Rubriek=""
 . For I=9,4,5,6 Set:$P(sFL(1),D,I)="" Rubriek=Rubriek_D_I
 . Set $E(Rubriek)=""
 Set Quit=0
 If $L(Rubriek) For I=1:1:$L(Rubriek,D) Do
 .If $P(Rubriek,D,I)="O" Set $P(Rubriek,D,I)=$S($G(sFL("O",1))="":"Omschrijving",1:"") Quit
 .For Field=1:1 Quit:'$D(sScrnDef(Field))  Do  Quit:Quit
 ..Set R=sScrnDef(Field)
 ..Set Quit=$P(Rubriek,D,I)=$P(R,"`",7)
 ..Set:'Quit Quit=$P(Rubriek,D,I)=$P($G(sScrnDef(Field,"F")),"`",3)
 .Set R=$G(sScrnDef(Field))
 .If $P(Rubriek,D,I)=$P(R,"`",7) Set $P(Rubriek,D,I)=$P(R,"`",3)
 .Else  If $P(Rubriek,D,I)=$P($G(sScrnDef(Field,"F")),"`",3) Set $P(Rubriek,D,I)=$P(R,"`",3)
 .Else  Set $P(Rubriek,D,I)=""
 If $L(Rubriek,D)>1 For I=1:1:$L(Rubriek,D)-1 Set $P(Rubriek,D,I)=$P(Rubriek,D,I)_", "
 Set Rubriek=$TR(Rubriek,D,"")
 For  Quit:$L(Rubriek)<65  Set Rubriek=$P(Rubriek,", ",1,$L(Rubriek,", ")-1)_"..."
 If $L(Rubriek,", ")>1,Rubriek'["..." Set Rubriek=$P(Rubriek,", ",1,$L(Rubriek,", ")-1)_" en "_$P(Rubriek,", ",$L(Rubriek,", "))
 Do:$L(Rubriek) TXT^vhINP(Rubriek_" niet ingevuld")
 Quit '$L(Rubriek)
 ;
KLLEV 
 New R,KLLEVTyp,KLLEVNr
 Set X=$$SELECT^KONTAKT("LK")
 If X=""!$P(X,";",2) Do
 .S:X="" X=";"
 .Set $P(sFL(1),D,1,2)=$TR(X,";",D),R=$$POS^vhScherm("KLLEVVAL"),FP=$P($P(R,D),";")*100+$P($P(R,D),";",2)
 .Write @F,$J("",12)
 .Do DISPRM^vhScherm("KLLEVLAB")
 .Set KLLEVTyp=$P(sFL(1),D),KLLEVNr=$P(sFL(1),D,2)
 .If KLLEVTyp'="K" Set $P(sFL(1),D,21)=""
 .Else  Set $P(sFL(1),D,21)=$$INTVW^KLOPV(KLLEVNr)
 .Do DISPVAL^vhScherm("VWBEH")
 .If KLLEVTyp="K",KLLEVNr Do REMATTR^vhScherm("KLREGIO","H","H"),DISPRM^vhScherm("KLREGIO"),DISPVAL^vhScherm("KLREGIO")
 Quit
 ;
AUTORZ 
 New I,R,Type,Groep,RZTyp
 Set Type=$P(sFL(1),D,4),Groep=$P(sFL(1),D,5),RZTyp=$P(sFL(1),D,20)
 For I="TN","NL" Do
 .Quit:RZTyp'[I
 .If $P(RZTyp,";")=I Set RZTyp=$P(RZTyp,";",2,99)
 .Else  Set RZTyp=$P(RZTyp,";"_I)_$P(RZTyp,";"_I,2)
 Set R=$G(^RES("KLACHT","PI","TYPE","D",Type,"GRP",Groep)),RZTyp=RZTyp_";"_R
 Set:$E(RZTyp)=";" $E(RZTyp)="" Set $P(sFL(1),D,20)=RZTyp
 Do:'$D(sDir) REPAINT^vhScherm("RZTYP"),REPAINT^vhScherm("RZTYP2")
 Quit
 ;
KLACHTOV(KLLEVTyp,KLLEVNr) 
 New R,KLACHTEN,Klachten,KlachtId,Count,MaxCount,Status
 Do:$D(sDir)
 .Do INIT^vhLIST("KLACHT","KLACHTEN",.KLACHTEN)
 .Set sDir=1,Count=0,MaxCount=$P(KLACHTEN("POS"),";",3)-$P(KLACHTEN("POS"),";")+1
 .For Status=1,2,3 Do  Quit:Count'<MaxCount
 ..Set KlachtId=""
 ..For  Set KlachtId=$O(^KlachtI(KLLEVTyp,KLLEVNr,KlachtId)) Quit:KlachtId=""  Do  Quit:Count'<MaxCount
 ...Set:$$STATUS^KLACHTO(KlachtId)=Status Count=Count+1,Klachten(Count)=KlachtId
 .Do WRITE^vhLIST(.KLACHTEN)
 Quit
 ;
REGPUT(Type,X) 
 New KLLEVNr,KLLEVTyp
 If Type="P",$P(sFL(1),D)'="K" Set KLLEVTyp="L",KLLEVNr=$P(^($O(^KPR(X,"J"))),D)
 Else  If Type="T" Set KLLEVTyp="L",KLLEVNr=$P(^KTO1(X),D)
 Else  If Type="R" Set KLLEVTyp=$P(^RCP("D",X),D),KLLEVNr=$P(^RCP("D",X),D,2)
 Else  If Type="O" Set KLLEVTyp="K",KLLEVNr=$P(^KO1(X,"F"),D)
 Else  If Type="B" Set KLLEVTyp="K",KLLEVNr=$P(^KU1(X,"F"),D)
 Else  If Type="F" Do
 .Set KLLEVTyp="K",KLLEVNr=$P($G(^KFA("F",X,0,0)),D)
 .Set:'KLLEVNr KLLEVNr=$P($G(^KFAP("F",X,0,0)),D)
 .Set:'KLLEVNr KLLEVNr=$P(sFL(1),D,2)
 Else  Set KLLEVTyp=$P(sFL(1),D),KLLEVNr=$P(sFL(1),D,2)
 Do:$P(sFL(1),D,1,2)'=KLLEVTyp_D_KLLEVNr
 .Set $P(sFL(1),D,1,2)=KLLEVTyp_D_KLLEVNr,FP=305
 .Write @F,$J("",12) 
 .Do DISPRM^vhScherm("KLLEVLAB"),DISPVAL^vhScherm("KLLEVVAL")
 Quit
 ;
BLDIND(KlachtId) 
 New I,R,KLLEVTyp,KLLEVNr,Type,Value
 Set R=^KlachtD(KlachtId),KLLEVTyp=$P(R,D),KLLEVNr=$P(R,D,2)
 Set ^KlachtI(KLLEVTyp,KLLEVNr,KlachtId)=""
 For I=1:1 Quit:'$D(^KlachtD(KlachtId,"B",I))  Do
 .Set R=^KlachtD(KlachtId,"B",I),Type=$P(R,"#"),Value=$P(R,"#",2)
 .Quit:$P(R,"#",5)  ; Verouderde informatie dus geen index
 .Set ^KlachtI(Type,Value,KlachtId)="B"
 For I=1:1 Quit:'$D(^KlachtD(KlachtId,"R",I))  Do
 .Set R=^KlachtD(KlachtId,"R",I),Type=$P(R,"#"),Value=$P(R,"#",2)
 .Quit:$P(R,"#",5)  ; Verouderde informatie dus geen index
 .Set ^KlachtI(Type,Value,KlachtId)="R"
 Quit
 ;
DELIND(KlachtId) 
 New I,R,KLLEVTyp,KLLEVNr,Type,Value
 Set R=^KlachtD(KlachtId),KLLEVTyp=$P(R,D),KLLEVNr=$P(R,D,2)
 Kill ^KlachtI(KLLEVTyp,KLLEVNr,KlachtId)
 For I=1:1 Quit:'$D(^KlachtD(KlachtId,"B",I))  Do
 .Set R=^KlachtD(KlachtId,"B",I),Type=$P(R,"#"),Value=$P(R,"#",2)
 .Kill ^KlachtI(Type,Value,KlachtId)
 For I=1:1 Quit:'$D(^KlachtD(KlachtId,"R",I))  Do
 .Set R=^KlachtD(KlachtId,"R",I),Type=$P(R,"#"),Value=$P(R,"#",2)
 .Kill ^KlachtI(Type,Value,KlachtId)
 Quit
 ;
AANBRENG(sFL) 
 New zb,R,KLLEVTyp,KLLEVNr,IntPers,Optie,Count
 Set R=sFL(1),KLLEVTyp=$P(R,D),KLLEVNr=$P(R,D,2),Optie("SELECT")=$P(R,D,3)
 Set Optie("TITEL")="Aanbrenger",Optie("AANSPR")=0,Count=0
 If KLLEVTyp="K" Do
 .Set IntPers=$$INTVW^KLOPV(KLLEVNr)
 .Set:IntPers IntPers=$$USERNAME^vhUSER(IntPers),Count=Count+1,Optie("AFTER",Count)=IntPers
 Set Count=Count+1,Optie("AFTER",Count)="Interne persoon"
 If $L(Optie("SELECT")),Optie("SELECT")'=$G(IntPers) Set Count=Count+1,Optie("AFTER",Count)=Optie("SELECT")
 Set Count=Count+1,Optie("AFTER",Count)="Andere"
 Set Pers=$$SELECT^PERS(KLLEVTyp,KLLEVNr,.Optie)
 If zb'="CANC" Do
 .If Pers="Andere" Set (sEr,X)="" Quit
 .If Pers="Interne persoon" Do  Quit:zb="CANC"
 ..Set Pers=$$USELECT^vhUSER("","Interne persoon",,,"K",1,,CUserId,,"C;C",,,,,"Z")
 ..If Pers,zb'="CANC" Set Pers=$$USERNAME^vhUSER(Pers)
 .Quit:$P(sFL(1),D,3)=Pers
 .Set $P(sFL(1),D,3)=Pers,%SC=1
 Set:$D(sDir) sDir=$S(zb="CANC":-1,1:1)
 Quit
 ;
 ;Call back voor subtype
CBSUBTYPE(Select) 
 New Include,Type,Groep
 Set Type=$P(sFL(1),"\",4),Groep=$P(sFL(1),"\",5)
 Set Include=Type=$P(Select,"`",3) Set:Include Include=Groep=$P(Select,"`",4)
 Quit Include
 ;
GROEPVW() 
 New GroepVw
 Set GroepVw=$P(sFL(1),D,11)
 Quit GroepVw
 ;
 ; OnOm = "" : Onderwerp,Omschrijving
 ;      = 1  : Onderwerp
 ;      = 2  : Omschrijving
 ;      = 21 : Omschrijving,Onderwerp
ONOM(KlachtId,CopyId,OnOm) 
 New I,R,Onderw,Omschr
 Set OnOm=$G(OnOm,"12"),R=""
 If $G(CopyId),KlachtId,$D(^KlachtCD(KlachtId,CopyId)) Do
 .Set R=^KlachtCD(KlachtId,CopyId),Omschr=$G(^KlachtCD(KlachtId,CopyId,"O",1))
 .For I=2:1 Quit:'$D(^KlachtCD(KlachtId,CopyId,"O",I))  Set Omschr=Omschr_^KlachtCD(KlachtId,CopyId,"O",I)
 Else  Do
 .Set:KlachtId R=^KlachtD(KlachtId),Omschr=$G(^KlachtD(KlachtId,"O",1))
 .For I=2:1 Quit:'$D(^KlachtD(KlachtId,"O",I))  Set Omschr=Omschr_^KlachtD(KlachtId,"O",I)
 Set Onderw=$P(R,D,9)_"~",Omschr=Omschr_"~"
 If $L(OnOm)=1 Set:Onderw="" Onderw=Omschr Set:Omschr="" Omschr=Onderw
 For I=$L(OnOm):-1:1 Set $E(OnOm,I)=$S($E(OnOm,I)=1:Onderw,$E(OnOm,I)=2:Omschr,1:"")
 Set:$E(OnOm)=" " $E(OnOm)="" Set:$E(OnOm,$L(OnOm))=" " $E(OnOm,$L(OnOm))=""
 Set:$E(OnOm)="~" $E(OnOm)="" Set:$E(OnOm,$L(OnOm))="~" $E(OnOm,$L(OnOm))=""
 Set OnOm=$TR(OnOm,"~"," ")
 Quit OnOm
 ;
TYPE(OldTyp) 
 New R,sFR,Pos,Line,Colom,Type,Optie,Titel,Optie,Count,Omschr,GrpLink,OLength
 Set sEr=-1,sFR=sScrnDef(sFld),Optie="PKO1-",Titel=$P(sFR,"`",3)
 Set Pos=$$POS^vhScherm(sFld),Line=$P($P(Pos,D,2),";"),Colom=$P($P(Pos,D,2),";",2)
 Set R=^RES("KLACHT","PI","TYPE","P","O"),OLength=$P(R,"`",4)
 Set Type=""
 For  Set Type=$O(^RES("KLACHT","PI","TYPE","D",Type)) Quit:Type=""  Do
 .Set R=^RES("KLACHT","PI","TYPE","D",Type),Count=$P(R,"`"),Omschr=$P(R,"`",2),GrpLink=$P(R,"`",3)
 .Set Type(Count)=Type_"`"_Omschr_$J("",OLength+1-$L(Omschr))
 Set Type=$$WILD^vhPOPUP(Line_";"_Colom,Optie,Titel,.Type,OldTyp)
 If Optie["P"!(Optie["p") Do
 .Set:$D(sDir) sDir=$S(zb="CANC":-1,1:1)
 .If $G(sDir)'=-1 Do
 ..If Type'=$G(sOldSel) Set %SC=1 Do:Optie'["p" PUT^vhScherm(sFld,Type)
 ..Do:Optie["p" PUT^vhScherm(sFld,Type)
 Quit Type
 ;
GROEP(Type,OldGroep)
 New I,R,Types,HoofdGroep,HoofdGroepen,Groep,Groepen,Count,Titel,IncAndere,Pos,Line,Colom,CallBack
 Set sEr=-1,Count=0,Titel="",HoofdGroepen=$P(^RES("KLACHT","PI","TYPE","D",Type),"`",3),Space=0
 For I="K","O" Set Space=Space+$P(^RES("KLACHT","PI","TYPE","P",I),"`",4)
 For  Quit:HoofdGroepen=""  Do
 . Set HoofdGroep=$P(HoofdGroepen,";"),HoofdGroepen=$P(HoofdGroepen,";",2,99)
 . Set R=^RES("KLACHT","PI","HOOFDGROEP","D",HoofdGroep),Groepen=$P(R,"`",3),IncAndere=$P(R,"`",4)
 . Xecute:$L(IncAndere) "Set IncAndere="_IncAndere
 . If Titel="" Set Titel=$P(R,"`",2)
 . Else  Do
 .. Set Count=Count+1,Groep(Count)="&S&C "_$P(R,"`",2)_ " "
 . For  Quit:Groepen=""  Do
 .. Set Groep=$P(Groepen,";"),Groepen=$P(Groepen,";",2,99)
 .. Set R=^RES("KLACHT","PI","GROEP","D",Groep),Types=$P(R,"`",3)
 .. Quit:";"_Types_";"'[(";"_Type_";")
 .. If Groep="AND",'IncAndere Quit
 .. Set Count=Count+1,Groep(Count)=Groep_"`"_$P(R,"`",2)_$J("",20-$L($P(R,"`",2)))_"`"_HoofdGroep
 Set Pos=$$POS^vhScherm(sFld),Line=$P($P(Pos,D,2),";"),Colom=$P($P(Pos,D,2),";",2)
 Set CallBack("A")="D`CBGROEP^KLACHT"
 Set Groep=$$WILD^vhPOPUP(Line_";"_Colom,"APKO1R-",Titel,.Groep,OldGroep,.CallBack)
 Set HoofdGroep=$P(Groep,"`",3),Groep=$P(Groep,"`")
 If zb="CANC" Set:$D(sDir) sDir=-1
 Else  Set $P(sFL(1),D,12)=HoofdGroep If Groep'=OldGroep Do PUT^vhScherm(sFld,Groep)
 Quit Groep
 ;
CBGROEP(Dummy)
 New HoofdGroep
 If $O(sX($O(sX("")))),$P(sY($O(sX(""))),"`")="AND" Do
 .Kill sX
 .Set HoofdGroep=$P(sFL(1),D,12)
 .For sY=1:1:sY If $P(sY(sY),"`")="AND",$P(sY(sY),"`",3)=HoofdGroep Set sX(sY)=1
 Quit
 ;
CUSERID() 
 New CUserId
 Set CUserId=$$DEVUSER^vhUSER($$IO^cQ5)
 Set:$L(CUserId,";")>1 CUserId=$$DEVUSER^vhUSER($$IO^cQ5,1)
 Quit CUserId
 ;
KLACHTID(Type,Value,Nieuw,Beperk) 
 New KlachtId
 Set Nieuw=$G(Nieuw)
 Set KlachtId=$O(^KlachtI(Type,Value,""))
 If KlachtId="" Set:Nieuw KlachtId="*"
 Else  Do
 .If 'Nieuw,$O(^KlachtI(Type,Value,KlachtId))=""
 .Else  Set KlachtId=$P($$SELECT^KLACHTS(Type,Value,,,,,.Beperk),D)
 Quit KlachtId
 ;
CHKBOX(Space,Text,Mark) 
 New ChkBox
 Set Space=$G(Space),Mark=$G(Mark)
 Set ChkBox=$J("",Space)_"O"
 Set:Mark ChkBox=ChkBox_$C(8)_"X"
 Set ChkBox=ChkBox_" "_Text
 Quit ChkBox
 ;
RAADPL(KlachtId,CopieId,Opvolg,NoMod,Keys,AktKey) 
 New Input
 Set Input=$$RAADPL^KLACHT3(KlachtId,$G(CopieId),$G(Opvolg),$G(NoMod),$G(Keys),$G(AktKey))
 Quit Input
 ;
PRINT(KlachtId,CopieId,DocTyp,Print) 
 Do PRINT^KLACHT3(KlachtId,$G(CopieId),$G(DocTyp),.Print)
 Quit
 ;
KDISABLE(Keys,Key) 
 New I
 For I=1:1 Quit:'$D(Keys("B",I))  If $P(Keys("B",I),"`",6)=Key Set $P(Keys("B",I),"`",3)="HD"
 Quit
 ;
KENABLE(Keys,Key) 
 New I
 For I=1:1 Quit:'$D(Keys("B",I))  If $P(Keys("B",I),"`",6)=Key Set $P(Keys("B",I),"`",3)=$TR($P(Keys("B",I),"`",3),"HD","")
 Quit
 ;
SAVETYPE(PopUp) 
 New Type
 Set Type=""
 For  Set Type=$O(PopUp("D",Type)) Quit:Type=""  Merge PopUp("D",Type,"GRP")=^RES("KLACHT","PI","TYPE","D",Type,"GRP")
 Kill ^RES("KLACHT","PI","TYPE")
 Merge ^RES("KLACHT","PI","TYPE")=PopUp
 Quit
 ;
FIELDEXEC(Field)
 If Field="TYPE" Do
 . New Value,Tabel,Cache
 . Quit:$D(sDir)
 . Set Value=R
 . Do FIELDI^vhScherm("GROEP")
 . Quit:Value'="DIV" 
 . Do PUT^vhScherm("PRGROEP",""),PUT^vhScherm("RZTYP",""),PUT^vhScherm("RZTYP2",""),PUT^vhScherm("RZTYP3","")
 . Kill sFL("R"),sFL("B")
 . Set Cache="B"
 . Do INIT^vhLIST("KLACHT","BTRELEM",.Tabel)
 . Do WRITE^vhLIST(.Tabel)
 . D DISPRM^vhScherm("BTRELEM")
 . Do INIT^vhLIST("KLACHT","RZTELEM",.Tabel)
 . Do WRITE^vhLIST(.Tabel)
 . D DISPRM^vhScherm("RZTELEM")
 Quit
 ;