TIJD3 ;Tijdregestratie Afdruk in lijst en weekoverzicht [ 01/17/96  9:41 AM ]
 K  D INIT^vhTERMINA
 s IPNr=20
 D PRINT($H-14)
 q
PRINT(Datum) ; Afdruk VANAF TOT vanuit de ^TIJD global
 New Van,Tot,ModIP,Vorm
 Set Van=$$CALCDATE^vhDTyp($G(Datum),"W","FD")
 Set Tot=$$CALCDATE^vhDTyp(Van,"W",1,"LD"),Vorm="W"
 Do NIEUW^vhScherm("TIJDPRINT","","","","","",3) Quit:'%SC
 Set ModIP=$P($G(^vhUSER("D",IPNr,"T")),D)
 Set:ModIP="VTW" ModIP=""
 Do @$S(Vorm="L":"LIJST",1:"WEEKOVER")
 Quit
 
LIJST New Print,PD,Dat,Tijd,Cnt,MemCnt,Qty,TotTijd,Rec,%J
 Set %J=$$%J^vhRtn1()
 Do INIT^PROC("TIJDP"_ModIP,"PD")
 Set $P(PD(11),D,2)="Gebruiker : "_$P(^vhUSER("D",IPNr),D,5)
 Set $P(PD(11),D,3)="Van : "_$S(Van:$$EXTDATE^vhDTyp(Van,"DK"),1:"BEGIN")_" Tot : "_$S(Tot:$$EXTDATE^vhDTyp(Tot,"DK"),1:"EINDE")
 Kill ^HULP(%J,"P")
 Set Dat=Van-1
 Set:'Tot Tot=9999999
 Set Tijd=""
 Set Cnt=0
 For  Set Dat=$O(^TIJD("D",IPNr,Dat)) Quit:Dat=""  Quit:Dat>Tot  Do
 .Set Cnt=Cnt+1,^HULP(%J,"P",Cnt)=Dat_D_"DAT",MemCnt=Cnt,Qty=0,TotTijd=0
 .For  Set Tijd=$O(^TIJD("D",IPNr,Dat,Tijd)) Quit:Tijd=""  Do
 ..Set Rec=^TIJD("D",IPNr,Dat,Tijd)
 ..Set Cnt=Cnt+1,Qty=Qty+1
 ..Set ^HULP(%J,"P",Cnt)=Rec
 ..Set TotTijd=TotTijd+$P(Rec,D,2)-$P(Rec,D,1)
 .Set $P(^HULP(%J,"P",MemCnt),D,3)=Qty
 .Set $P(^HULP(%J,"P",MemCnt),D,4)=TotTijd
 Quit:'$D(^HULP(%J,"P"))
 Do PRINT^OUTPUT(.PD,"SPT","S;L;B","CA")
 Kill ^HULP(%J,"P")
 Quit
 
WEEKOVER New Einde,Einde,Dat,Print,sKOL,sROW,GRAF,Ref,VanTijd,EndTijd,Dag,DBase,DStap,TBase,TStap,Cnt
 Set Einde=Tot
 Do INIT^vhPRINTER("S;L",95,"P") Quit:'$D(Print)
 Write *27,"0",*27,"C",$C(86) ; 8 lijnen/inch en bladlengte = 86
 For  Do  Quit:Van>Einde
 .S Print("BLZ")=Print("BLZ")+1
 .Do WTITEL
 .Do WEEK ; 1ste week
 .If Van'>Einde Do 
 ..Write !!
 ..Do WEEK ; 2de week
 .Write #
 Write *27,"A",*12,*27,"2" ; 6 lijnen/inch (12/72=1/6)
 Do CLOSE^vhPRINTER
 Quit
 
WEEK New Disp
 Do INIT
 For Dat=Van:1:Tot Do DAG(Dat)
 Do WRITE
 Set Van=$$CALCDATE^vhDTyp(Van,"W",+1,"FD")
 Quit
 
INIT Set sKOL=Print("KOL")
 Set sROW=40
 Set GRAF=$TR(FG,"*","")
 Set Ref=$NA(^TIJD("D",IPNr))
 Kill Dag
 Set Delta=5
 Set Van=$$CALCDATE^vhDTyp(Van,"W","FD")
 Set Dag=0,Tot=Van-1
 For T=1:1:Delta Set Tot=Tot+1,Dag=Dag+1,Dag(Tot)=Dag
 Set DBase=5
 Set DStap=sKOL-DBase\Dag
 Set VanTijd=8*3600,EndTijd=17*3600
 Set TBase=2
 Set TStap=EndTijd-VanTijd\(sROW-TBase)
 Set TStap=$S(TStap<(3600/6):3600/6,TStap<(3600/4):3600/4,TStap<(3600/3):3600/3,TStap<(3600/2):3600/2,1:3600)
 Set VanTijd=VanTijd
 Set EndTijd=VanTijd+(sROW-TBase-1*TStap)
 Quit
 
WTITEL w *27,*58 ; 12 cpi
 Set Print("KOL")=95
 Do FTITEL^OUTPUT2(Print("KOL"),"Agenda","Gebruiker : "_$P(^vhUSER("D",IPNr),D,5))
 Set Print("KOL")=134
 W *18 ; 10 cpi
 Quit
 
DAG(Dat) New Uur,VPos,PosV,PosT,Betreft,OnderW,Rec,R,Kol
 Set VPos=$G(Dag(Dat))-1*DStap+DBase
 Set Uur=""
 Set Disp(Dat)=0
 For  Set Uur=$O(@Ref@(Dat,Uur)) Quit:Uur=""  Do
 .Set Rec=@Ref@(Dat,Uur)
 .Set PosV=$$CALC($P(Rec,D)),CharV=$C($P(GRAF,D,5))
 .Set PosT=$$CALC($S($P(Rec,D,2):$P(Rec,D,2),1:$P(Rec,D))),CharT=$C($P(GRAF,D,8))
 .If PosT<($S($P(Rec,D,2):$P(Rec,D,2),1:$P(Rec,D))-VanTijd\TStap+1) Set CharT="V"
 .;Ophalen teksten
 .Set Betreft=$P(Rec,D,3)
 .Set Onderw=$P(Rec,D,4)
 .If ModIP="SOF" Do
 ..Set:$L(Betreft) Betreft=$P($G(^POP("TIJDBETREF","D",Betreft),D_Betreft),D,2)
 ..Set:$L(Onderw) Onderw=$P($G(^POP("TIJDONDERW","D",Onderw),D_Onderw),D,2)
 .Else  Do
 ..Set:$L(Betreft) Betreft=$$DISPLAY^KONTAKT(Betreft,"GZ",",")
 ..Set:$L(Onderw) Onderw=$P($G(^POP("TIJDMOTIV","D",Onderw),D_Onderw),D,2,3)
 ..Set:$L($P(Rec,D,5)) Onderw=$P(Onderw,D,2)_";"_$P(Rec,D,5)
 ..Set:'$L($P(Rec,D,5)) Onderw=$P(Onderw,D,1)
 ..Set:'$L(Betreft) Betreft=Onderw,Onderw=""
 .;Opzoeken vrije kolom
 .Set R=$P($G(Disp(Dat,PosV)),D)
 .For Kol=1:1 Quit:" "[$E(R,Kol)  If $E(R,Kol)=$C($P(GRAF,D,8)),PosV'=PosT Set CharV=$C($P(GRAF,D,11)) Quit
 .Set:Disp(Dat)<Kol Disp(Dat)=Kol
 .If PosV'=PosT Do
 ..Do MERGE(PosV,Kol,CharV,Betreft,1,$P(Rec,D))
 ..Do MERGE(PosT,Kol,CharT,$S(PosV+1=PosT:Onderw,1:""))
 ..For T=PosV+1:1:PosT-1 Do MERGE(T,Kol,$C($P(GRAF,D,10)),Onderw) Set Onderw=""
 .Else  Do MERGE(PosV,Kol,$C(219),Betreft,1,$P(Rec,D))
 Quit
 
MERGE(Pos,Kol,Char,Text,Bold,Tijd) 
 New R
 If $G(Tijd),Pos-1*TStap+VanTijd'=Tijd Set Text=$E($$EXTTIME^vhDTyp(Tijd),$S(Tijd>EndTijd!(Tijd<VanTijd):1,1:4),5)_";"_Text
 Set R=$P($G(Disp(Dat,Pos)),D)
 Set $E(R,Kol)=Char
 Set Disp(Dat,Pos)=R_D_Text_D_$G(Bold)
 Quit
 
CALC(Uur) New T
 Set T=Uur-VanTijd\TStap+1
 Set:T<1 T=1
 Set:T>(sROW-TBase-1) T=sROW-TBase-1
 Quit T
 
WRITE New Dat,Fill,Pos,Kol,Mark
 Set Dat=""
 ; Schrijven datums
 Write !,*18,*27,*73,*16,$J("",DBase) ;,$C($P(GRAF,D,10))
 For  Set Dat=$O(Disp(Dat)) Quit:Dat=""  Do
 .Write $C($P(GRAF,D,10))," "
 .If DStap>10 Write $E($E($$EXTDATE^vhDTyp(Dat,"DC"),1,DStap-10),1,2)_" "
 .Write $$EXTDATE^vhDTyp(Dat,"DK")
 .Write $J("",DStap-10-$S(DStap-10>1:3,DStatp>10:2,1:0))
 ; Schrijven separator
 Write !,*15,$TR($J("",DBase)," ",$C($P(GRAF,D,9)))
 Set Fill=$TR($J("",DStap-1)," ",$C($P(GRAF,D,9)))
 For  Set Dat=$O(Disp(Dat)) Quit:Dat=""  Do
 .Write $C($P(GRAF,D,11)),Fill
 ; Schrijven uren
 Set Fill=$J("",DStap-1)
 For Pos=1:1:sROW-TBase-1 Do
 .Write:(Pos#2) !,*15,$$EXTTIME^vhDTyp(Pos-1*TStap+VanTijd)
 .Write:'(Pos#2) !,*15,$J("",DBase)
 .For  Set Dat=$O(Disp(Dat)) Quit:Dat=""  Do
 ..Write $C($P(GRAF,D,10))
 ..If '$D(Disp(Dat,Pos)) Write Fill Quit
 ..Set Kol=Disp(Dat),Mark=$P(Disp(Dat,Pos),D)
 ..Write Mark,$J("",Kol-$L(Mark))
 ..Write:$P(Disp(Dat,Pos),D,3) *18,*27,*73,*18 ;@FMTB
 ..Write $E($P(Disp(Dat,Pos),D,2)_Fill,1,DStap-Kol-1)
 ..Write:$P(Disp(Dat,Pos),D,3) *18,*27,*73,*16 ;@FMTb
 Quit