VERSLAG2 ;Verslagen [ 11/05/98  8:09 AM ]
 ;
 ; Opvragen van de tijd
GTIME() 
 New X
GT2 Do FIELD^vhScherm("VERSLAGD",sFld+1)
 Quit:'X X
 Do DISPLAY^vhScherm("VERSLAGD","","","","TIME")
 Do FIELD^vhScherm("VERSLAGD",sFld+2)
 Goto GT2:X="-"
 Quit:'X X
 Quit FTime_","_TTime
 ;
 ; Tonen van de tijd
DTIME(FTime,TTime) 
 New R
 Set R=$$EXTTIME^vhLib.DataTypes(FTime) Set:TTime R=R_" - "_$$EXTTIME^vhLib.DataTypes(TTime)
 Quit R
 ;
 ; Opvragen van de bezoeksoort
GBEZOEK(X) 
 New Pos
 Set FP=2201 Write @F,@F1
 Set Pos=($P(sFR,"`",5)+1)_";"_($P(sFR,"`",6)-2)
 Quit $$PI^vhPOPUP(Pos,"1BKO-","Bezoeksoort","VERSLAG","BEZOEKSOORT",X)
 ;
 ; Tonen van de bezoeksoort
DBEZOEK(VerslId) 
 Quit $S('$G(VerslId):"",1:$$MOTEVA^VERSLAG(VerslId,"B",1))
 ;
 ; Tonen van de aktiviteit
DAKTIV(VerslId) 
 Quit $S('$G(VerslId):"",1:$$MOTEVA^VERSLAG(VerslId,"A",1))
 ;
 ; Opvragen van de interne personen
GINTPERS(Old) 
 New R,Pos,IntPers
 Set Old=$TR(Old,D,";")
 If Old="",$P($ZU(5),",")="VTW" Set Old=CUserId
 Set FP=2201 Write @F,@F1
 Set Pos="1;"_($P(sFR,"`",5)+1)_";"_($P(sFR,"`",6)-1)
 If $L(Old) Do
 .Set IntPers=$$USELECT^vhUSER("","","","VERSLIP","","","","",1,"")
 .For I=1:1:$L(Old,";") If (";"_IntPers_";")'[(";"_$P(Old,";",I)_";") Set Old=Old_";?" Quit
 If Old["?" Set IntPers=Old
 Else  Set IntPers=$$USELECT^vhUSER("","Interne personen","","VERSLIP","","",2,Old,1,Pos,1,"",1)
 If IntPers["?" Do
 .Set IntPers=$TR(IntPers,"?","")
 .Set IntPers=$$USELECT^vhUSER("","Interne personen","","",Q,"",2,IntPers,1,Pos,1)
 Quit $TR(IntPers,";",D)
 ;
 ; Tonen van de interne personen
DINTPERS(X) 
 New I
 For I=1:1:3 Do
 .Set FP=$P(sFR,"`",5)+I*100+$P(sFR,"`",6)
 .Write @F,$J("",$P(sFR,"`",10)),@F
 .If I=3,$P(X,D,4) Write "..." Quit
 .Write $E($S($P(X,D,I)="":"",$D(^vhUSER("D",$P(X,D,I))):$P(^vhUSER("D",$P(X,D,I)),D,5),1:$P(X,D,I)),1,$P(sFR,"`",10))
 Quit $E($S(X="":X,1:$P(^vhUSER("D",$P(X,D)),D,5)),1,$P(sFR,"`",10))
 ;
 ; Opvragen Derde
SDERDE() 
SD1 If RefType'="PP" Do  Quit:X="-" X
 .Set X=$$SELECT^KONTAKT("KLD","V")
 .Quit:X="-"
 .Set RefNr=$P(X,";",2),X=$P(X,";"),X=$S(X="K":"KL",X="L":"LE",1:"PP")
 .Set:X="PP" $P(Adres,D)=RefNr
 Set Adres=$$ADERDE(X,Adres)
 If X="PP",Adres="" Set RefType="" Goto SD1
 Set:$L(Adres) RefNr=""
 Quit X
 ;
ADERDE(Type,Ref) 
 New sFL,Adres
 Set Adres=""
 If Type="PP" Do
 .Set sFL(1)=Ref
 .Do STORE^vhTERMINA(),@($S(Ref'[D:"NIEUW",1:"EDIT")_"^vhScherm(""VERSLAGA"")"),REFRESH^vhTERMINA()
 .Set Adres=sFL(1) Set:$TR(Adres,D,"")="" Adres=""
 Quit Adres
 ;
 ; Tonen rubriek derde
DREFTYPE(X) 
 Quit $S(X="LE":"Leverancier",X="KL":"Klant",X="PP":"Prospect",1:"Derde")
 ;
 ; Ophalen van de gegevens derde
GDERDE(RefType,R) 
 New Rec
 If RefType="LE",R,$D(^KL1(R)) Set Rec=^KLE(^KL1(R),0)
 Else  If RefType="KL",R,$D(^KK1(R)) Set Rec=^KKL(^KK1(R),0)
 Else  If RefType="PP",R="" Set Rec=D_$G(Adres)
 Else  Set Rec=D_R
 Quit Rec
 ;
 ; Tonen data derde
DDERDE(RefType,R) 
 New Rec
 Set Rec=$$GDERDE(RefType,R)
 Set R=$P(Rec,D) Set:$L(R) R=R_" " Set R=R_$P(Rec,D,2)
 Set FP=$P(sFR,"`",5)+1*100+$P(sFR,"`",6)
 Write @F,$J("",8)
 Set FP=$P(sFR,"`",5)+1*100+$P(sFR,"`",6)+12 Write @F,$J("",22),@F,$E(R,1,22)
 Set FP=FP+100 Write @F,$J("",22),@F,$E($P(Rec,D,7),1,22)
 Quit
 ;
 ; Opvragen van de externe personen
GEXTPERS(RefType,RefNr,Old) 
 New I,R,Optie,Modify,ExtPers,CB,sFmt,Count,Select
 Set Old=$TR(Old,D,";"),FP=2201
 Write @F,@F1
 If "\KL\LE\"[(D_RefType_D) Do
 .For I=1:1:$L(Old,";") Do
 ..Quit:'$L($P(Old,";",I))
 ..Set Optie("BEFORE",I)=$P(Old,";",I),Optie("SELECT")=$G(Optie("SELECT"))_$P(Old,";",I)_";"
 .Set Optie("AUTOSEL")=1,Optie("TITEL")="Contaktpersonen",Optie("MULTI")="MS"
 .Set Optie("AFTER")="M```Wijzig",Optie("CASE")="L",Optie("CB","S")="D`CEXTPERS^VERSLAG2"
 .Set Optie("CB","A")="D`CEXTPERS^VERSLAG2"
 .Set R=$$SELECT^PERSS($E(RefType),RefNr,.Optie)
 Else  Do
 .If Old="" Set Modify=1,R="" Quit
 .Set Count=0,Select="",sFmt="^RES(""VERSLAG"",""LD"",""EXTPERS"")"
 .For I=1:1:$L(Old,";") Set Count=Count+1,Select=Select_";"_Count,ExtPers(Count)=Count_"`"_$P(Old,";",I)
 .Set Count=Count+1,ExtPers(Count)="&S"
 .Set Count=Count+1,ExtPers(Count)="M`Wijzig"
 .Set CB("S")="D`CEXTPERS^VERSLAG2"
 .Set R=$$WILD^vhPOPUP("4;C","O1MLbS-","Contaktpersonen",.ExtPers,Select,.CB)
 .Set Modify=$P(R,";",$L(R,";"))="M"
 .Quit:R=""
 .For I=1:1:$L(R,";") Set:$P(R,";",I) $P(R,";",I)=$P(ExtPers($P(R,";",I)),"`",2)
 If $G(Modify) Set R=$$MEXTPERS($P(R,";",1,$L(R,";")-1))
 Set:R'=Old %SC=1
 Quit $TR(R,";",D)
 ;
 ; Call back voor het opvraxen van de externe personen (Test "M"- wijzig)
CEXTPERS(Select,Old,New,Rec) 
 If $O(Pers(1))="" Set Modify=1
 Set:$P($G(Rec),"`")="M" sOptie=$TR(sOptie,"M",""),Modify=1
 Quit
 ;
 ; Toevoegen van externe personen (andere dan in KKL, KLE)
MEXTPERS(R) 
 New I,ExtPers
 For I=1:1:12 Set ExtPers(I)=$P(R,";",I)
 Do STORE^vhTERMINA(),EDIT^vhScherm("VERSLAGE"),REFRESH^vhTERMINA()
 Set R=""
 For I=1:1:12 If $L(ExtPers(I)) Set R=R_";"_ExtPers(I)
 Set $E(R)=""
 Quit R
 ;
 ; Tonen van de externe personen
DEXTPERS(X) 
 New I
 For I=1:1:4 Do
 .Set FP=$P(sFR,"`",5)+I*100+$P(sFR,"`",6)
 .Write @F,$J("",$P(sFR,"`",10)),@F
 .If I=4,$L($P(X,D,5)) Write "..." Quit
 .Write $E($P(X,D,I),1,$P(sFR,"`",10))
 Quit $P(R,D)
 ;
 ; Opvragen motivatie - evaluatie
GMOTEVA 
 New FP,LDMETemp
 Do STORE^vhTERMINA()
 Set FP=1201
 Write @F,@F1
 Set LDMETemp("POS")=LDME("POS")
 Set R=$P(LDME("POS"),"`"),$P(R,";",3)=$P(R,";",3)+(22-R),$P(LDME("POS"),"`")=R
 Set R=$P(LDME("POS"),"`",2),$P(R,";",3)=$P(R,";",3)+(21-R),$P(LDME("POS"),"`",2)=R
 Do WRITE^vhLIST(.LDME)
 Set R=$S($O(MotEva("")):"",1:"LN")
 For  Do  Set R=$$SCROLL^vhLIST(.LDME) Quit:R="-"  Do
 .If R="LN" Do MENIEUW
 .If "\LW\ENTER\"[(D_R_D) Do MEWIJZIG
 .If R="LV" Do MEDELETE
 Set LDME("POS")=LDMETemp("POS")
 Do REFRESH^vhTERMINA()
 Quit
 ;
 ; Tonen motivatie - evaluatie
DMOTEVA() 
 Do WRITE^vhLIST(.LDME)
 Quit ""
 ;
 ; Opvragen te doen
GTEDOEN 
 New FP,LDTDTemp
 Do STORE^vhTERMINA()
 Set FP=1601
 Write @F,@F1
 Set LDTDTemp("POS")=LDTD("POS")
 Set R=$P(LDTD("POS"),"`"),$P(R,";",3)=$P(R,";",3)+(22-R),$P(LDTD("POS"),"`")=R
 Set R=$P(LDTD("POS"),"`",2),$P(R,";",3)=$P(R,";",3)+(21-R),$P(LDTD("POS"),"`",2)=R
 Do WRITE^vhLIST(.LDTD)
 For  Set R=$$SCROLL^vhLIST(.LDTD) Quit:R="-"  Do
 .If R="LN" Do TDNIEUW
 .If "\LW\ENTER\"[(D_R_D) Do TDWIJZIG
 .If R="LV" Do TDDELETE
 Set LDTD("POS")=LDTDTemp("POS")
 Do REFRESH^vhTERMINA()
 Quit
 ;
 ; Tonen te doen
DTEDOEN() 
 Do WRITE^vhLIST(.LDTD)
 Quit ""
 ;
 ; Keert de kilometers van een verslag terug.
 ; Een bepaald verslag ("",VerslId)
 ; Een bepaald verslag van een bepaalde gebruiker (UserId,VerslId)
 ; Next "" of 1 geeft het volgend verslag
 ; Next -1 geeft het vorige verslag
KM(UserId,VerslId,Next) 
 New Date
 Set VerslId=$G(VerslId),UserId=$G(UserId)
 If UserId Do
 .If VerslId,'$D(Next) Do  Quit
 ..If $D(^VERSLAG("D",VerslId)),$P($G(^VERSLAG("D",VerslId,"I")),D)=UserId
 ..Else  Set VerslId=""
 .Set Next=$G(Next,1)
 .If VerslId Set Date=$P(^VERSLAG("D",VerslId,0),D)
 .Else  Set Date=$O(^VERSLAG("II",UserId,""),Next)
 .Set VerslId=$O(^VERSLAG("II",UserId,Date,""),Next)
 Else  Do
 .If VerslId,'$D(Next) Quit
 .Set Next=$G(Next,1)
 .Set VerslId=$O(^VERSLAG("D",VerslId),Next)
 Quit $S('VerslId:"",'$D(^VERSLAG("D",VerslId)):"",1:$P(^VERSLAG("D",VerslId,0),D,10,12))
 ;
 ; Kontrole van de kilometeringave
CHECKKM(Value,BeginKm,EindKm,DagKm,UserId,Type) 
 New Tekst,Km
 Set Tekst=""
 If $L(Value) Do
 .If Type="B" Do
 ..If Value>EindKm Set:EindKm Tekst="Mag niet groter zijn dan "_EindKm_" (eind km)"
 ..Else  If UserId Do
 ...Set Km=$$KM(UserId,-1)
 ...If Value<$P(Km,D,2) Set Tekst="Mag niet kleiner zijn dan "_$P(Km,D,2)_" (eind km vorig verslag)"
 ...If Value<$P(Km,D,3) Set Tekst="Mag niet kleiner zijn dan "_$P(Km,D,3)_" (dageinde vorige dag)"
 .If Type="E" Do
 ..If Value<BeginKm Set Tekst="Mag niet kleiner zijn dan "_BeginKm_" (begin km)"
 ..If DagKm,Value>DagKm Set Tekst="Mag niet groter zijn dan "_DagKm_" (dageinde)"
 .If Type="D" Do
 ..If Value<EindKm Set Tekst="Mag niet kleiner zijn dan "_EindKm_" (eind km)"
 Quit Tekst
 ;
 ; Keert de kilometers van het laatste verslag van een gebruiker terug
USERKM(UserId,Type,Next) 
 New I,R,Date,VerslId,Quit,Km,Count
 Quit:'UserId ""
 Set Type=$G(Type,"BED"),Next=$G(Next,1),(Date,Km)="",(Quit,Count)=0
 For  Set Date=$O(^VERSLAG("II",UserId,Date),Next) Quit:Date=""  Do  Quit:Quit
 .Set VerslId=""
 .For  Set VerslId=$O(^VERSLAG("II",UserId,Date,VerslId),Next) Quit:VerslId=""  Do  Quit:Quit
 ..Set Km=$$KM(UserId,VerslId)
 ..If $TR(Km,D,"")'="" Set Quit=1
 ..Else  Set Km=""
 ..Set Count=Count+1 Set:Count>100 Quit=1
 Set R=""
 For I=1:1:$L(Type) If "BED"[$E(Type,I) Set:$L(R) R=R_D Set R=R_$P(Km,D,$F("BED",$E(Type,I))-1)
 Quit R
 ;
 ; Keert de eindkilometerstand van het laatste verslag van een gebruiker terug
LASTKM(UserId) 
 New Km
 Set Km=$$USERKM(UserId,"ED",-1)
 Quit $S($P(Km,D,2):$P(Km,D,2),1:$P(Km,D))
 ;
MENIEUW 
 New sFL,zb
 Set:'$G(%SCTemp) %SCTemp=$G(%SC)
 Do NIEUW^vhScherm("VERSLAGME","","","","","",3)
 If $TR(sFL(1),D,"")'="",%SC Do NIEUW^vhLISTE(.LDME,sFL(1))
 Quit
 ;
MEWIJZIG 
 New sFL,zb
 Quit:'$D(MotEva(LDME("SELECT")))
 Set sFL(1)=MotEva(LDME("SELECT")) Set:'$G(%SCTemp) %SCTemp=$G(%SC)
 Do EDIT^vhScherm("VERSLAGME","","","","","",3)
 If sFL(1)'=MotEva(LDME("SELECT")),%SC Do
 .Set MotEva(LDME("SELECT"))=sFL(1)
 .Do LINE^vhLIST(.LDME,LDME("SELECT"))
 Quit
 ;
MEDELETE 
 Quit:'$D(MotEva(LDME("SELECT")))
 Do DELETE^vhLISTE(.LDME)
 Set %SC=1
 Quit
 ;
TDNIEUW 
 New MailId,MailTyp,Optie
 Set Optie("TYPE")="T"
 Set MailId=$$EXTERN^vhMAIL(RefType,RefNr,"","","","",.Optie)
 Quit:'MailId
 Do NIEUW^vhLISTE(.LDTD,MailId)
 Set %SC=1
 Quit
 ;
TDWIJZIG 
 New MailId,MailTyp,%SCTemp
 Quit:'$D(TeDoen(LDTD("SELECT")))
 Set MailId=TeDoen(LDTD("SELECT")),MailTyp="O",%SCTemp=%SC
 If $D(^vhMAIL("D",MailId)) Do
 .Do STORE^vhTERMINA()
 .Do LWIJZIG^vhMAIL5(MailId,1)
 .Do REFRESH^vhTERMINA()
 .Do ENABLE^vhLIST(.LDTD,"",1)
 .Set:'%SC %SC=%SCTemp
 Quit
 ;
TDDELETE 
 New MailId
 Quit:'$D(TeDoen(LDTD("SELECT")))
 Set MailId=TeDoen(LDTD("SELECT"))
 Do DELETE^vhLISTE(.LDTD),DELOBJ^vhMAIL(MailId)
 Set %SC=1
 Quit
 ;
DISPMEIT(Ref,X) 
 New R
 If $L(X) Do
 .If Ref="CONCUR" Do
 ..If $D(^KFAB1(X)) Set X=$P($G(^KFAB(^KFAB1(X),0)),D,2)
 ..Else  Set X=$P($G(^RES("VERSLAG","PI","CONCUR","D",X)),"`",2)
 .Else  If Ref="SUBJECT" Set R=$$DISPL^KLASS(X,1) If $L(R) Set X=R
 .Else  Set X=$P($G(^RES("VERSLAG","PI",Ref,"D",X)),"`",2)
 Quit X
 ;
DUMMY(Ref,X) 
 Do AKTDEAKT^VERSLAG2(Ref,X)
 Quit ""
 ;
AKTDEAKT(Ref,X,Repaint) 
 New R,Aktiv,DeAktiv,Attrib
 Set R=$S(X="":X,1:$G(^RES("VERSLAG","PI",Ref,"D",X))),Aktiv=$P(R,"`",3),DeAktiv=$P(R,"`",4)
 For  Quit:Aktiv=""  Do
 .New Ref
 .Set Ref=$P(Aktiv,"#"),Attrib=$P(Ref,">",2),Ref=$P(Ref,">") Set:Attrib="" Attrib="HD"
 .If $L(Ref) Do REMATTR^vhScherm(Ref,Attrib,Attrib)
 .Set Aktiv=$P(Aktiv,"#",2,99)
 For  Quit:DeAktiv=""  Do
 .New Ref
 .Set Ref=$P(DeAktiv,"#"),Attrib=$P(Ref,">",2),Ref=$P(Ref,">") Set:Attrib="" Attrib="HD"
 .If $L(Ref) Do PUT^vhScherm(Ref,""),PUTATTR^vhScherm(Ref,Attrib,Attrib)
 .Set DeAktiv=$P(DeAktiv,"#",2,99)
 If $G(Repaint) Do PAINT^vhScherm
 Quit
 ;
GETMEIT(Ref,X) 
 New Line,Col
 If Ref="CONCUR" Quit $$GETCONC(X)
 If Ref="SUBJECT" Quit $$GETSUBJ(X)
 Set FP=2201
 Write @F,@F1
 Set Line=sScrnPos+$P(sFR,"`",5)-$S($L(X):$P($G(^RES("VERSLAG","PI",Ref,"D",X)),"`"),1:1)+1,Col=$P(sFR,"`",6)
 Quit $$PI^vhPOPUP(Line_";"_Col,"O-1",$P(sFR,"`",3),"VERSLAG",Ref,X)
 ;
GETSUBJ(X) 
 New R,HoofdGr,KKey,Display,Count,Subject,Line,Col,Select,XTemp
 Set XTemp=X,(HoofdGr,Select)="",Count=0,FP=2201
 Write @F,@F1
 If X Set X=$$GETKEY^KLASS($$GETSORT^KLASS(X,1)) Set:X=XTemp XTemp=""
 For  Set HoofdGr=$O(^KPHG(HoofdGr)) Quit:HoofdGr=""  Do
 .Set KKey=$$GETKEY^KLASS(HoofdGr),Display=$$DISPL^KLASS(KKey,1)
 .Set Count=Count+1,Subject(Count)=Count_"`"_Display_"`"_KKey
 .If 'Select,KKey=X Set Select=Count
 Set Count=Count+1,Subject(Count)="&S"
 Set Subject=""
 For  Set Subject=$O(^RES("VERSLAG","PI","SUBJECT","D",Subject)) Quit:Subject=""  Do
 .Set R=^RES("VERSLAG","PI","SUBJECT","D",Subject),Display=$P(R,"`",2)
 .Quit:'$P(R,"`")
 .Set Subject(Count+R)=(Count+R)_"`"_Display_"`"_Subject
 .If 'Select,Subject=X Set Select=Count+R
 Set Count=$O(Subject(""),-1),Subject=Count
 Set Line=sScrnPos+$P(sFR,"`",5)-$S(Select:Select,1:1)+1,Col=$P(sFR,"`",6)
 Set Subject=$$WILD^vhPOPUP(Line_";"_Col,"O-1",$P(sFR,"`",3),.Subject,Select)
 If Subject Do
 .Quit:zb="CANC"
 .Set Subject=$P(Subject(Subject),"`",3)
 .Quit:'Subject
 .Set HoofdGr=$$GETSORT^KLASS(Subject),X=$$GETGROEP(HoofdGr,XTemp) Set:X Subject=X
 If Subject Do
 .Quit:zb="CANC"
 .Do FIELDI^vhScherm("CONCUR")
 .Do AKTDEAKT("SUBJECT","zz")
 Quit Subject
 ;
GETGROEP(HoofdGr,X) 
 New R,KKey,Display,Count,Groep,Line,Col,Select
 Set Groep=HoofdGr,Select="",Count=0,FP=2201
 Write @F,@F1
 For  Set Groep=$O(^KPGR(Groep)) Quit:$E(Groep,1,4)'=$E(HoofdGr,1,4)  Do
 .Set KKey=$$GETKEY^KLASS(Groep),Display=$$DISPL^KLASS(KKey,1)
 .Set Count=Count+1,Groep(Count)=Count_"`"_Display_"`"_KKey
 .If 'Select,KKey=X Set Select=Count
 Set Count=$O(Groep(""),-1),Groep=Count
 Set Line=sScrnPos+$P(sFR,"`",5)-$S(Select:Select,1:-1)-1,Col=$P(sFR,"`",6)
 Set Groep=$$WILD^vhPOPUP(Line_";"_Col,"ZO-1",$P(sFR,"`",3)_" - Groep",.Groep,Select)
 If zb'="CANC" Do
 .Set:Groep Groep=$P(Groep(Groep),"`",3)
 Quit Groep
 ;
GETCONC(X) 
 New R,Concur
 Set (Concur,Count)=0,FP=2201
 Write @F,@F1
 For  Set Concur=$O(^RES("VERSLAG","PI","CONCUR","D",Concur)) Quit:Concur=""  Do
 .Set R=^RES("VERSLAG","PI","CONCUR","D",Concur)
 .Set Count=Count+1,Concur(Count)=Concur_"`"_$P(R,"`",2)
 Set Count=Count+1,Concur(Count)="&S",Concur=0
 For  Set Concur=$O(^KFAB(Concur)) Quit:Concur=""  Do
 .Set R=^KFAB(Concur,0)
 .Set Count=Count+1,Concur(Count)=$P(R,D)_"`"_$P(R,D,2)
 Set Line=sScrnPos+$P(sFR,"`",5),Col=$P(sFR,"`",6)
 Set Concur=Count,Concur=$$WILD^vhPOPUP(Line_";"_Col,"ZO-1",$P(sFR,"`",3),.Concur,X)
 Quit Concur
 ;
PUTMEIT(X,Piece) 
 New R
 If zb="CANC" Set sDir=-1
 Else  Set:$P(sFL(1),D,Piece)'=X $P(sFL(1),D,Piece)=X,%SC=1
 Quit
 ;