BHINVEST ;Boekhouding investeringen [ 11/08/2003   8:41 PM ]
 S Debug=0
 Do INIT
 For  Do COMMAND Quit:Input="-"
 ;Do CLEAN
 Quit
 
COMMAND If DispMode="DTL" Do
 .Set Input=$$SCROLL^vhLIST(.MutLijst)
 .Set Select=MutLijst("SELECT")
 .Set MutRec=""
 .Set:Select MutRec=MutLijst("D",Select)
 .Set MutNr=$P(MutRec,D,31)
 Else  Do
 .Set Input=$$SCROLL^vhLIST(.Lijst)
 .Set Select=Lijst("SELECT")
 .Set InvestID=""
 .Set BuitLck=""
 .If Select Do
 ..Set Rec=^HULP(%J,"L",Select)
 ..Set InvestID=$P(Rec,D,20)
 ..Set BuitLck=$P(Rec,D,4) ; Investering buitengebruik
 If Input="COM" Set Input="" Do CALL^vhMenu("BHINVEST")
 Quit:Input=""
 Do EXEC^vhMenu("BHINVEST",.Input)
 Quit
 
INIT Set %J=$$%J^vhRtn1()
 Set Input=""
 Kill ^HULP(%J)
 W @F11,@F1
 Set DispMode="R"
 Set Afrond=0
 Set RefBJaar=$P(^BHINVEST,D,2)
 Kill Lijst
 Do INIT^vhLIST("BHINVEST","LIJST",.Lijst)
 Set Lijst("UPINIT")="X`Set (Key1,Key2,Key3,Key4,Next1,Next2)="""""
 Set Lijst("UPTRAV")="F`CBTRAV^BHINVEST"
 Set Lijst("UPSEL")="@`InvestID=Key4"
 Do INIT^vhLIST("BHINVEST","MUTLIJST",.MutLijst)
 Set InvestID=""
 Do REFRESH
 Quit 
 
CLEAN Kill ^HULP(%J) 
 Quit
 
FETCH ; Ophalen van alle investeringen beperkt tot DispMode
 New InvestID,Rec  
 Kill ^HULP(%J,"S"),^HULP(%J,"L")
 Set InvestID=""
 Set SkipDate=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes($H,"BJ",-1,"LD"),"J4")
 For  Set InvestID=$O(^BHINVEST(InvestID)) Quit:InvestID=""  Do
 .Set Rec=^BHINVEST(InvestID)
 .If DispMode="R" Quit:$P(Rec,D,4)&($P(Rec,D,4)<SkipDate)
 .If DispMode="O" Quit:$P(Rec,D,4)
 .If DispMode="B" Quit:'$P(Rec,D,4)
 .Do BLDHULP(InvestID,Rec)
 Quit   
 
LNIEUW Set sFL(1)="",InvestID="*"
 Do NIEUW^vhScherm("BHINVEST",,,,,0,3) 
 Quit:'%SC
 Lock +BHINVEST
 Set InvestID=$P(^BHINVEST,D)+1
 Set $P(^BHINVEST,D)=InvestID
 Lock -BHINVEST
 Set $P(sFL(1),D,11)=sUser
 Set $P(sFL(1),D,13)=sUser
 Set $P(sFL(1),D,12)=$H
 Set $P(sFL(1),D,14)=$H
 Set ^BHINVEST(InvestID)=sFL(1)
 Do BLDHULP(InvestID,sFL(1))
 Do UPDATE^vhLIST(.Lijst)
 Quit
 
LWIJZIG(InvestID) Quit:'InvestID
 Set sFL(1)=^BHINVEST(InvestID)
 Do EDIT^vhScherm("BHINVEST",,,,,0,3) 
 Quit:'%SC
 Do REMHULP(InvestID)
 Set $P(sFL(1),D,13)=sUser
 Set $P(sFL(1),D,14)=$H
 Set ^BHINVEST(InvestID)=sFL(1)
 Do BLDHULP(InvestID,sFL(1))
 Do UPDATE^vhLIST(.Lijst)
 Quit
 
LDELETE(InvestID) Quit:'InvestID 
 Do REMHULP(InvestID)
 Kill ^BHINVEST(InvestID)
 Do UPDATE^vhLIST(.Lijst)
 Quit
 
INUSE(InvestID) ; Startboekjaar en stop boekjaar
 ;Wordt berekend vanuit de mutaties dit wordt opgeroepen na elke wijziging in de mutaties
 Set BeginBJ=999999
 Set MutNr=""
 Set InvRec=^BHINVEST(InvestID)
 Set IsOver=0
 For  Set MutNr=$O(^BHINVEST(InvestID,"M",MutNr)) Quit:MutNr=""  Do  Quit:IsOver
 .Set MutRec=^BHINVEST(InvestID,"M",MutNr)
 .Set:$P(MutRec,D,2)="O" IsOver=1 ; Reeds overgedragen kan niet meer gewijzigd worden
 .Set:$P(MutRec,D)<BeginBJ BeginBJ=$P(MutRec,D)
 If $P(InvRec,D,1)'=BeginBJ,'IsOver Do
 .Set $P(InvRec,D,1)=BeginBJ
 .Set ^BHINVEST(InvestID)=InvRec
 Quit
 
 
CLOSEBJ(BoekJ) ; Het afsluiten van het boekjaar en openen van het volgend boekjaar
 Quit:BoekJ'=$P(^BHINVEST,D,2)
 New InvestID,RecBJ,AfRec,InvRec
 Set InvestID=""
 
 For  Set InvestID=$O(^BHINVEST(InvestID)) Quit:InvestID=""  Do
 .Set InvRec=^BHINVEST(InvestID)
 .Set EndBJ=$S($P(InvRec,D,4):$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes($P(InvRec,D,4),"BJ","LD"),"J4"),1:"")
 .Quit:EndBJ&(EndBJ<BoekJ)  ; Reeds meer dan een jaar afgesloten
 .Set AfRec=$$CALCAF(InvestID,BoekJ)
 .Quit:+$P(AfRec,D)=0
 .Set MutRec=""
 .Set $P(MutRec,D,1)=BoekJ+1
 .Set $P(MutRec,D,2)="O" ;Overdracht
 .Set $P(MutRec,D,6)=$P(AfRec,D,1)
 .Set $P(MutRec,D,7)=$P(AfRec,D,2)+$P(AfRec,D,3) ; Vorig + Huidig
 .Set ^BHINVEST(InvestID,"M",$O(^BHINVEST(InvestID,"M",""),-1)+1)=MutRec
 Set $P(^BHINVEST,D,2)=BoekJ+1
 Set RefBJaar=BoekJ+1
 Set DispMode="R"
 Do REFRESH
 Quit
 
OPENBJ(BoekJ) ; Het heropenen van een boekjaar
 Set (InvestID,MutNr)=""
 For  Set InvestID=$O(^BHINVEST(InvestID)) Quit:InvestID=""  Do
 .For  Set MutNr=$O(^BHINVEST(InvestID,"M",MutNr)) Quit:MutNr=""  Do
 ..Set MutRec=^BHINVEST(InvestID,"M",MutNr)
 ..;Alleen de overdracht records verwijderen
 ..Kill:$P(MutRec,D,1)>BoekJ&($P(MutRec,D,2)="O") ^BHINVEST(InvestID,"M",MutNr)
 Set $P(^BHINVEST,D,2)=BoekJ
 Set DispMode="R"
 Do REFRESH
 Quit
 
REFDATE ; Ingave van de referentiemaand
 Do FIELD^vhScherm("BHINVESTR","REFJAAR")
 Do REFRESH
 Quit
 
REFRESH New Txt
 Write @F,@F11
 Write @FMTI," Investeringstabel - ",QN," ",@FMTi,@F2
 Set Txt=$P(";Openstaande;Recente;Buitengebruik;Allen;;;Detail afschrijving",";",$F("ORBADTL",DispMode))
 Set FP=180-$L(Txt) Write @F,@FMTB,Txt,@FMTb
 Set FP=302 Write @F,"Referentie boekjaar : ",RefBJaar
 If RefBJaar'=$P(^BHINVEST,D,2) Set FP=350 Write @F,@FMTB,"Openstaand Boekjaar : ",$P(^BHINVEST,D,2),@FMTb
 If DispMode="DTL" Do
 .Set FP=501 Write @F,@F1
 .Write @FMTI," Afschrijvingstabel",$J("",61),@FMTi
 .Set sFL(1)=^BHINVEST(InvestID)
 .Do DISPLAY^vhScherm("BHINVEST",5,,,"1;2;3;4;5;6;7;8")
 .Do MUTFETCH(InvestID)
 .Do WRITE^vhLIST(.MutLijst)
 Else  Do
 .Do FETCH
 .Do UPDATE^vhLIST(.Lijst,0)
 .Do WRITE^vhLIST(.Lijst)
 Quit
 
BLDHULP(InvestID,Rec)  ; Opbouw van een investering in het hulpbestand via sorteersleutels
 New HG,HGSortNr,GR,GRSortNr
 Set HG=$P(Rec,D,6)
 Set HGSortNr=$P(^RES("BHINVEST","PI","HFDCAT","D",HG),"`",1)
 Set GR=$P(Rec,D,7)
 Set GRSortNr=$P(^RES("BHINVEST","PI","SUBCAT","D",GR),"`",1)
 If $P(Rec,D,1)="" Set $P(Rec,D,1)=+$H
 Set ^HULP(%J,"S",1000+HGSortNr_" "_HG,1000+GRSortNr_" "_GR,$P(Rec,D,1),InvestID)=""
 Quit
 
REMHULP(InvestID) ; Verwijderen van een inverstering uit het hulpbestand
 ; Eenvoudig verwijderen is niet mogelijk door het LAYGO principe van de hoofdgroep
 New HG,GR,Dat,InvID
 Set (HG,GR,Dat,InvID)=""
 For  Set HG=$O(^HULP(%J,"S",HG)) Quit:HG=""  Do
 .For  Set GR=$O(^HULP(%J,"S",HG,GR)) Quit:GR=""  Do
 ..For  Set Dat=$O(^HULP(%J,"S",HG,GR,Dat)) Quit:Dat=""  Do
 ...For  Set InvID=$O(^HULP(%J,"S",HG,GR,Dat,InvID)) Quit:InvID=""  Do
 ....Quit:InvID'=InvestID
 ....Kill ^HULP(%J,"S",HG,GR,Dat,InvID)
 Quit
 
CBFORMAT(Select,Rec) ; Opgeroepen door vhLIST
 If $P(Rec,D,20) Do
 .Set Fmt="DTL"
 Else  Set sFmt=$S($L($P(Rec,D,6)):"HFD",1:"SUB")
 Quit sFmt
 
CBTRAV(sRec,sCnt)  ;Opgeroepen door UPDATE^vhLIST, Recursief doorlopen van de verschillende nodes, tijdens het doorlopen worden extra lijnen gekreëerd voor de hooofd en subcategoriëen
 If Key2="",'Next1 Do  Quit sRec
 .Set Key1=$O(^HULP(%J,"S",Key1))
 .Set sRec=""
 .Set:Key1'="" $P(sRec,D,6)=$P(Key1," ",2,99),$P(sRec,D,7)=$P($G(^RES("BHINVEST","PI","HFDCAT","D",$P(Key1," ",2,99))),"`",2) ; Tussen lijn voor nivo 1
 .Set Next1=1
 If Key3="",'Next2 Do  Quit sRec
 .Set Key2=$O(^HULP(%J,"S",Key1,Key2))
 .Set sRec=""
 .Set:Key2'="" $P(sRec,D,7)=Key2,Next2=1 ;Tussen lijn nivo 2
 .Set:Key2'="" $P(sRec,D,7)=$P($G(^RES("BHINVEST","PI","SUBCAT","D",$P(Key2," ",2,99))),"`",2) ; Tussen lijn voor nivo 2
 .Set:Key2="" sRec=$$CBTRAV(sRec,sCnt)
 If Key4="" Do  Quit:Key3="" $$CBTRAV(sRec,sCnt)
 .Set Key3=$O(^HULP(%J,"S",Key1,Key2,Key3))
 .Set Next3=1
 Set Key4=$O(^HULP(%J,"S",Key1,Key2,Key3,Key4))
 Quit:Key4="" $$CBTRAV(sRec,sCnt)
 Set:'InvestID InvestID=Key4
 Set sRec=^BHINVEST(Key4)
 Set $P(sRec,D,20)=Key4 ; De InvestID ook opslaan
 Set $P(sRec,D,21)=$$CALCAF(Key4,RefBJaar)
 Set (Next1,Next2)=""
 Quit sRec
 
MUTFETCH(InvestID) 
 New MutRec,BJ,Mut,MutNr,VolgNr
 Do INIT^vhLIST("BHINVEST","MUTLIJST",.MutLijst)
 Set MutNr=""
 Set InvRec=^BHINVEST(InvestID)
 For  Set MutNr=$O(^BHINVEST(InvestID,"M",MutNr),-1) Quit:MutNr=""  Do
 .Set MutRec=^BHINVEST(InvestID,"M",MutNr)
 .Set $P(MutRec,D,31)=MutNr
 .Set MutLijst("S",$P(MutRec,D,1),$P(MutRec,D,2),MutNr)=MutRec
 Set VolgNr=0,BJ=""
 For  Set BJ=$O(MutLijst("S",BJ)) Quit:BJ=""  Do
 .Set DefBJ=BJ
 .;Default mutatienummer opzoeken waar de afschrijving op berekend wordt
 .For MutType="O","A","B","C" Set MutNr=$O(MutLijst("S",BJ,MutType,"")) Quit:MutNr
 .Set MutRec=MutLijst("S",BJ,MutType,MutNr)
 .Set AfRec=$$CALCAF(InvestID,BJ)
 .Set $P(MutRec,D,8)=$P(AfRec,D,3)
 .Set $P(MutRec,D,11)=$P(AfRec,D,4)
 .Set $P(MutRec,D,12)=$P(AfRec,D,5)
 .Set MutLijst("S",BJ,MutType,MutNr)=MutRec
 .Set (MutType,MutNr)=""
 .For MutType="O","A","B","C" Do
 ..For  Set MutNr=$O(MutLijst("S",BJ,MutType,MutNr)) Quit:MutNr=""  Do
 ...Set VolgNr=VolgNr+1
 ...Set MutRec=MutLijst("S",BJ,MutType,MutNr)
 ...Set $P(MutRec,D)=DefBJ
 ...Set DefBJ=""
 ...Set MutLijst("D",VolgNr)=MutRec
 Quit
 
MUTDEL(InvestID,MutNr) 
 New MutRec
 Set MutRec=^BHINVEST(InvestID,"M",MutNr)
 If $P(MutRec,D,7) Write *7 Quit  ; Locked
 Kill ^BHINVEST(InvestID,"M",MutNr)
 Do INUSE(InvestID)
 Do MUTFETCH(InvestID),WRITE^vhLIST(.MutLijst)
 Quit
 
MUTNEW(InvestID) 
 New sFL,InvRec,MutRec,%SC
 Set sFL(1)=""
 Set $P(sFL(1),D,1)=RefBJaar
 Do NIEUW^vhScherm("BHINVESTM",,,,,0,3)
 Quit:'%SC
 Set MutNr=$O(^BHINVEST(InvestID,"M",""),-1)+1
 Set $P(sFL(1),D,26)=sUser
 Set $P(sFL(1),D,27)=$H
 If $D(^BHINVEST(InvestID,"M"))=1 Do  ; Eerste record dan ingevoegd wordt
 .Set InvRec=^BHINVEST(InvestID)
 .Set:'$P(InvRec,D) $P(InvRec,D)=$S($P(sFL(1),D,22):$P(sFL(1),D,22),1:$$INTDATE^vhLib.DataTypes("01.01."_RefBJaar))
 .Set ^BHINVEST(InvestID)=InvRec
 Set ^BHINVEST(InvestID,"M",MutNr)=sFL(1)
 Do INUSE(InvestID)
 Do MUTFETCH(InvestID),WRITE^vhLIST(.MutLijst)
 Quit
 
 
MUTMOD(InvestID,MutNr) 
 New MutRec,sFL,%SC
 Set MutRec=^BHINVEST(InvestID,"M",MutNr)
 Set sFL(1)=MutRec
 Do EDIT^vhScherm("BHINVESTM",,,,,0,3)
 Quit:'%SC
 Set $P(sFL(1),D,26)=sUser
 Set $P(sFL(1),D,27)=$H
 Set ^BHINVEST(InvestID,"M",MutNr)=sFL(1)
 Do INUSE(InvestID)
 Do MUTFETCH(InvestID),WRITE^vhLIST(.MutLijst)
 Quit
 
MUTDISP(InvestID,MutNr) 
 New MutRec,sFL
 Set MutRec=^BHINVEST(InvestID,"M",MutNr)
 Set sFL(1)=MutRec
 Do DISPLAY^vhScherm("BHINVESTM",,,,,0,3)
 Quit
 
CALCAF(InvestID,RefBJaar) 
 ; Berekenen van de afschrijving en de restwaarde
 ; Return : Cumul AankoopWaarde/Cumul Afschrijving/Afschrijving/AfschrijfPerc/AfschrijfStelsel
 New InvRec,VolgNr,MutRec,Rec,AKPCumul,AFCumul
 Set InvRec=^BHINVEST(InvestID)
 Set VolgNr="",(AKPCumul,AFCumul)=""
 For  Set VolgNr=$O(^BHINVEST(InvestID,"M",VolgNr)) Quit:VolgNr=""  Do
 .Set MutRec=^(VolgNr)
 .Quit:$P(MutRec,D,1)'=RefBJaar  ; Verschillende boekjaar
 .Set AKPCumul=AKPCumul+$P(MutRec,D,6)
 .Set AFCumul=AFCumul+$P(MutRec,D,7)
 If AKPCumul'=AFCumul Do
 .Set Rec=$$CALCONE(AKPCumul,AKPCumul-AFCumul,$P(InvRec,D,2),$P(InvRec,D,3),Afrond)
 .Set Rec=AKPCumul_D_AFCumul_D_Rec
 Else  Do 
 .Set Rec=AKPCumul_D_AFCumul_D_0_D_0_D_$P(InvRec,D,3)
 Quit Rec
 
CALCONE(AkpVal,RestVal,AfPerc,AfTyp,Round) 
 Quit:RestVal<1 0_D_AfPerc_D_AfTyp
 If AfTyp="D" Do 
 .If (RestVal*AfPerc)>(AkpVal*(AfPerc/2)) Do
 ..Set Val=RestVal*AfPerc
 .Else  Do
 ..Set AfPerc=AfPerc/2
 ..Set AfTyp="l"
 If AfTyp="L"!(AfTyp="l") Do
 .Set Val=AkpVal*AfPerc
 Set Val=$J(Val,0,Round)
 Set RestVal=RestVal-Val
 Set:RestVal<0 Val=Val+RestVal
 Quit Val_D_AfPerc_D_AfTyp
 
REDISP 
 Set sFL("H")=$$CALCAF(InvestID,RefBJaar)
 Set sFL("V")=$$CALCAF(InvestID,RefBJaar-1)
 Do DISPVAL^vhScherm("HUIDIGEAFS")
 Do DISPVAL^vhScherm("AFSCHRIJFH")
 Do DISPVAL^vhScherm("AFSCHRIJFV")
 Do DISPVAL^vhScherm("RESTVALH")
 Do DISPVAL^vhScherm("RESTVALV")
 Quit
 
SUBCAT(Y)  ; Wijziging van de SUBCAT popup
 New Sort,HG2,GR,First
 Set:$L(HG) HG2=1000+$P(^RES("BHINVEST","PI","HFDCAT","D",HG),"`",1)_" "_HG
 Kill Sort
 Set Sort=""
 For  Set Sort=$O(Y(Sort)) Quit:Sort=""  Do
 .Set GR=1000+$P(^RES("BHINVEST","PI","SUBCAT","D",$P(Y(Sort),"`",1)),"`",1)_" "_$P(Y(Sort),"`",1)
 .Set First=2
 .If $L(HG2) Set:$D(^HULP(%J,"S",HG2,GR)) First=1
 .Set Sort(First,Sort)=$P(Y(Sort),"`",1,2)_"`"_$G(sX(Y))
 Kill Y,sX
 Set (First,Sort,Y)=""
 For  Set First=$O(Sort(First)) Quit:First=""  Do
 .For  Set Sort=$O(Sort(First,Sort)) Quit:Sort=""  Do
 ..Set Y=Y+1,Y(Y)=$P(Sort(First,Sort),"`",1,2)
 ..Set:$L($P(Sort(First,Sort),"`",3)) sX(Y)=$P(Sort(First,Sort),"`",3)
 .Set:First=1&$O(Sort(First)) Y=Y+1,Y(Y)="&S"
 Quit 
 
TRANSFER(RefBJaar) Do STORE^vhTERMINA()
 Set FP=2001 Write @F,@F1
 Set Dev=0
 Set Dev=$$OPEN^vhDEV(,"Investerings tabel.txt","WA")
 Use Dev
 Write $TR("HFDCat,Cat,Omschrijving,Toewijzing,Ingebruik,Aankoopwaarde initieel,Aankoopfaktuur,Afschrijving,Buitengebruikdatum,Verkoopbedrag,Verkoopfaktuur,Afschrijving Huidig,Restwaarde huidig,Aankoopwaarde huidig,Afschrijving vorig,Restwaarde vorig,Aankoopwaarde vorig,NieuwAf.Stelsel",",",$C(9)),!
 Set (HG,GR,Dat,InvestID)=""
 For  Set HG=$O(^HULP(%J,"S",HG)) Quit:HG=""  Do
 .For  Set GR=$O(^HULP(%J,"S",HG,GR)) Quit:GR=""  Do
 ..For  Set Dat=$O(^HULP(%J,"S",HG,GR,Dat)) Quit:Dat=""  Do
 ...For  Set InvestID=$O(^HULP(%J,"S",HG,GR,Dat,InvestID)) Quit:InvestID=""  Do TRANSONE(InvestID,RefBJaar)
 Close:0'[Dev Dev
 Do REFRESH^vhTERMINA()
 Quit
 
TRANSONE(InvestID,RefBJaar) 
 New Rec,Val,RestRecH,RestRecV
 Set Rec=^BHINVEST(InvestID)
 Set RestRecH=$$CALCAF(Rec,RefBJaar)
 Set RestRecV=$$CALCAF(Rec,RefBJaar-1)
 Set Val=$P(Rec,D,15)
 Write Val_" "_$P($G(^RES("BHINVEST","PI","HFDCAT","D",Val)),"`",2),$C(9) ; Hfd categorie
 Write:$L($P(Rec,D,16)) $P($G(^RES("BHINVEST","PI","SUBCAT","D",$P(Rec,D,26))),"`",2) ; Subcategorie
 Write $C(9)
 Write $P(Rec,D,18),$C(9) ; Omschrijving
 Write:$L($P(Rec,D,17)) $P($G(^RES("BHINVEST","PI","TOEWIJZING","D",$P(Rec,D,27))),"`",2) ; Toewijzing
 Write $C(9)
 Write $TR($$EXTDATE^vhLib.DataTypes($P(Rec,D,1),"DM"),".-","\\"),$C(9) ; Ingebruikstellingsdatum
 Write $TR($P(Rec,D,4),".",","),$C(9) ; Aankoopbedrag
 Write $TR($P(Rec,D,5),".",""),$C(9) ; Aankoopfaktuur
 Write $P(Rec,D,11) ;Afschrijvingstelsel
 Write $TR($P(Rec,D,10)*100,".",""),$C(9) ; Afschrijvingpercentage
 Write $TR($$EXTDATE^vhLib.DataTypes($P(Rec,D,7),"DM"),".-","\\"),$C(9) ; Buitengebruikdatum
 Write $TR($P(RestRecH,D,13),".",","),$C(9) ; Verkoopbedrag
 Write $TR($P(RestRecH,D,12),".",""),$C(9) ; Verkoopfaktuur
 Write $TR($P(RestRecH,D,1),".",","),$C(9) ; Afschrijving
 Write $TR($P(RestRecH,D,2),".",","),$C(9) ; Restwaarde
 Write $TR($P(RestRecH,D,3),".",","),$C(9) ; Nieuwe aankoopwaarde
 Write $P(RestRecH,D,5) ;Afschrijvingstelsel
 Write $TR($P(RestRecH,D,4)*100,".","") ; Afschrijvingpercentage
 Write $TR($P(RestRecV,D,1),".",","),$C(9) ; Afschrijving
 Write $TR($P(RestRecV,D,2),".",","),$C(9) ; Restwaarde
 Write $TR($P(RestRecV,D,3),".",","),$C(9) ; Nieuwe aankoopwaarde
 Write !
 Quit