TIJD2 ;Tijdregestratie met overzicht venster [ 12/06/2003  11:12 AM ]
 
SWITCH New Dag
 Set Scherm="P"
 Set Delta=5
 Do INIT
 Do REFRESH
 Goto COMMAND
 Quit
 
COMMAND For  Do  Quit:Input="L"!(Input="-")!(Input=".")
 .Do REFRESH
 .Set Input=$$IN^vhKEY()
 .If Input="LE" Do DMOVE(-1)
 .If Input="RI" Do DMOVE(+1)
 .If Input="UP" Do UMOVE(-1)
 .If Input="DO" Do UMOVE(+1)
 .If Input="HO" Do UMOVE(-99)
 .If Input="EN" Do UMOVE(+99)
 .If Input="COM" Do CALL^vhMenu("TIJD")
 .Do EXEC^vhMenu("TIJD",Input)
 If Input="L" Goto SWITCH^TIJD
 If Input="-"!(Input="."),sScr("VTW") Job TIJD^SYNCCOPY(IPNr,sRemVol)
 Quit
 
DMOVE(Dir) 
 Set Datum=$$CALCDATE^vhDTyp(Datum,"A",Dir)
 If '$D(Dag(Datum)) Do
 .Kill Dag($O(Dag(""),Dir))
 .Set T=""
 .For  Set T=$O(Dag(T)) Quit:T=""  Set Dag(T)=Dag(T)-Dir
 .Set Dag(Datum)=$S(Dir<0:1,1:Delta)
 .Set HPos=sScr("ROW") ;EndTijd-VanTijd\TStap+TBase+1
 .Do:Dir>0 COPY^vhTERMINA(2,DBase+DStap,HPos,Delta*DStap+DBase-1,1,2,DBase,1)
 .Do:Dir<0 COPY^vhTERMINA(2,DBase,HPos,Delta-1*DStap+DBase-1,1,2,DBase+DStap,1)
 .Do DAG(Datum)
 Set UurS=""
 Do SELECT
 Quit
 
UMOVE(Dir) 
 If Dir=0 Set:'$D(@Ref@(Datum,UurS)) UurS=$O(@Ref@(Datum,UurS)) Set:'UurS UurS=$O(@Ref@(Datum,""),-1)
 If Dir=-99 Set UurS=$O(@Ref@(Datum,""))
 If Dir=+99 Set UurS=$O(@Ref@(Datum,""),-1)
 If Dir=-1 Set UurS=$O(@Ref@(Datum,UurS),-1) Set:'UurS UurS=OldUurS
 If Dir=+1 Set UurS=$O(@Ref@(Datum,UurS)) Set:'UurS UurS=OldUurS
 Do SELECT
 Quit
 
SELECT If OldDat,$D(Dag(OldDat)) Do INVSEL(OldDat,OldUurS)
 If UurS,'$D(^TIJD("D",IPNr,Datum,UurS)) Set UurS=""
 Do INVSEL(Datum,UurS)
 Set OldDat=Datum,OldUurS=UurS
 Quit
 
INVSEL(Dat,Uur) 
 Set VPos=$G(Dag(Dat))-1*DStap+DBase+1
 Set HPos=2
 If Uur Do
 .Set:Uur<VanTijd Uur=VanTijd  Set:Uur>EndTijd Uur=EndTijd
 .Set HPos=Uur-VanTijd\TStap+TBase+1
 Write $C(27,91),HPos,";",VPos,";",HPos,";",VPos+DStap-2,";",7,"$t"
 Quit
 
REFRESH 
 New T
 Quit:sRT>sRB
 Do WRAND
 Set (OldDat,Dat)=""
 For  Set Dat=$O(Dag(Dat)) Quit:Dat=""  Do DAG(Dat)
 Set OldDat="",OldUurS=""
 Do SELECT
 Do RESET^vhScherm
 Quit
 
DATUM Do FIELD^vhScherm("TIJDHFD","DATUM") Quit:'%SC
 Do INIT,REFRESH
 Quit
 
INIT New Modif
 Set Modif='$$ACTREM^SYNCTIJD(IPNr) ; Kijkt na of de remote zichtbaar is op het netwerk.
 Do REMOVE^vhMenu("TIJDEDIT")
 Do:Modif SET^vhMenu("TIJDEDIT","MOD")
 Do:'Modif SET^vhMenu("TIJDEDIT","REMO")
 Set Ref=$NA(^TIJD("D",IPNr))
 Set GRAF=$TR(FG,"*","")
 Set ModIP=$P($G(^vhUSER("D",IPNr,"T")),D)
 Set:ModIP="VTW" ModIP=""
 Kill Dag
 Set Van=$$CALCDATE^vhDTyp(Datum,"W","FD")
 Set Van=$$CALCDATE^vhDTyp(Van,"A",0)
 Set Tot=$$CALCDATE^vhDTyp(Van,"A",Delta)
 Set Dag=0,Tot=Van-1
 For T=1:1:Delta Set Tot=$$CALCDATE^vhDTyp(Tot,"A",1),Dag=Dag+1,Dag(Tot)=Dag
 Set DBase=4
 Set DStap=sScr("KOL")-DBase\Dag
 Set VanTijd=8*3600,EndTijd=17*3600
 Set TBase=3
 Set TStap=EndTijd-VanTijd\(sScr("ROW")-TBase)
 Set TStap=$S(TStap<(3600/4):3600/4,TStap<(3600/3):3600/3,TStap<(3600/2):3600/2,1:3600)
 Set UurS=""
 Do ADD^vhScherm(1,24)
 ;Set TStap=1 sScr("ROW")-TBase\Tijd
 Quit
 
WRAND Write @F11,@F1
 Write @FMTI," Agenda - "_QN_" ",@FMTi
 Set FP=1000+sScr("KOL")-14 Write @FE,@FMTB," Weekoverzicht ",@FMTb
 Set Naam=$P(^vhUSER("D",IPNr),D,4)
 Write !,@FMTB,Naam,@FMTb
 Do HLIJN^vhTERMINA(3,1,5,"","",0)
 Set Cnt=0
 Set T=""
 For T=VanTijd:3600:EndTijd Quit:T=""  Do
 .Set Cnt=Cnt+1
 .Set FP=T-VanTijd\TStap+TBase+1*1000+1 Write @FE,$E($$EXTTIME^vhDTyp(T),1,2)
 Quit
 
DAG(Dat) New Disp
 Set VPos=$G(Dag(Dat))-1*DStap+DBase
 Set FP=TBase-1*1000+VPos+1 Write @FE
 If DStap>10 Write $E($E($$EXTDATE^vhDTyp(Dat,"DC"),1,DStap-10),1,2)_" "
 Write $$EXTDATE^vhDTyp(Dat,"DK")
 Write @F7
 Do FILL^vhTERMINA(TBase-1,VPos,sScr("ROW"),VPos) Write @FMTi
 Do HLIJN^vhTERMINA(TBase,VPos+1,VPos+DStap-1,"","",1)
 ;Set FP=TStap*1000+VPos Write @FE,@$P(FG,D,11)
 Write @F8
 Do FILL^vhTERMINA(TBase+1,VPos+1,sScr("ROW"),VPos+DStap-1,"","")
 Do FILLTIJD,DISPTIJD
 Set:Dat=OldDat OldDat=""
 Quit
 
DISPTIJD Write @F7
 For T=1:1:sScr("ROW")-TBase Do:$D(Disp(T))
 .Set FP=T+TBase*1000+VPos+1 Write @FE,$P(Disp(T),D)
 Write @F8
 For T=1:1:sScr("ROW")-TBase Do:$L($P($G(Disp(T)),D,2))
 .Set FP=T+TBase*1000+VPos+Disp+1
 .Write:'$P(Disp(T),D,3) @FE,$E($P(Disp(T),D,2),1,DStap-Disp-1)
 .Write:$P(Disp(T),D,3) @FE,@FMTB,$E($P(Disp(T),D,2),1,DStap-Disp-1),@FMTb
 Quit
 
FILLTIJD Kill Disp
 Set Uur=""
 Set Disp=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)),PosV=PosV\3+1
 .Set PosT=$$CALC($S($P(Rec,D,2):$P(Rec,D,2),1:$P(Rec,D))),CharT=$C($P(GRAF,D,8)),PosT=PosT\3+1
 .;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(PosV)),D)
 .For Kol=1:1 Quit:" "[$E(R,Kol)  If $E(R,Kol)=$C($P(GRAF,"\",8)),PosV'=PosT Set CharV=$C($P(GRAF,"\",11)) Quit
 .Set:Disp<Kol Disp=Kol
 .If PosV'=PosT Do
 ..Do MERGE(PosV,Kol,CharV,Betreft,1)
 ..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(97),Betreft,1)
 ;I $D(Disp) zw Disp r r
 Quit
 
MERGE(Pos,Kol,Char,Text,Bold) 
 Set R=$P($G(Disp(Pos)),D)
 Set $E(R,Kol)=Char
 Set Disp(Pos)=R_D_Text_D_$G(Bold)
 Quit
 
CALC(Uur) 
 Set T=Uur-VanTijd\600+1 ; Stappen van 10 minuten, de +1 is omdat elke lijn onderverdeeld is in 3x10 min. 
 Set:T<1 T=1
 Set:T>(sScr("ROW")-TBase-1*3) T=sScr("ROW")-TBase-1*3
 Quit T