cwburb ; ;[ 09/25/97  8:20 AM ]
 ;
 Kill
 Do INIT^vhTERMINA
 Set %J=$$%J^vhRtn1(),FANr=700000
 Kill ^HULP(%J)
 Write @F11,@F1
 Set FP=2401
 Write @F,"Ophalen van de data"
 For  Set FANr=$O(^KFA("F",FANr)) Quit:FANr>899999  Do
 .Set R=^KFA("F",FANr,0,0),Date=$P(R,D,6),Date=$$INTDATE^vhDTyp(Date)
 .Set BONNr="U"
 .For  Set BONNr=$O(^KFA("F",FANr,BONNr)) Quit:$E(BONNr)'="U"  Do
 ..Set FALNr=100
 ..For  Set FALNr=$O(^KFA("F",FANr,BONNr,FALNr)) Quit:'FALNr  Do
 ...Set R=^KFA("F",FANr,BONNr,FALNr),PRNr=$P(R,D,2),Aantal=$P(R,D,3),Kom=$P(R,D,28)="KOM"
 ...Quit:'PRNr
 ...If '$D(^KPR(PRNr,"J5810")),'$D(^KPRO(PRNr,"J5810")) Quit
 ...Set R=$G(^HULP(%J,"PRNR",PRNr)),$P(R,D,Kom+1)=$P(R,D,Kom+1)+1,$P(R,D,Kom+3)=$P(R,D,Kom+3)+Aantal
 ...Set:$P(R,D,Kom+5)<Date $P(R,D,Kom+5)=Date
 ...Set ^HULP(%J,"PRNR",PRNr)=R
 ;
 Set FANr=970000
 For  Set FANr=$O(^KFAP("F",FANr)) Quit:FANr=""  Do
 .Set R=^KFAP("F",FANr,0,0),Date=$P(R,D,6),Date=$$INTDATE^vhDTyp(Date)
 .Set BONNr="U"
 .For  Set BONNr=$O(^KFAP("F",FANr,BONNr)) Quit:$E(BONNr)'="U"  Do
 ..Set FALNr=100
 ..For  Set FALNr=$O(^KFAP("F",FANr,BONNr,FALNr)) Quit:'FALNr  Do
 ...Set R=^KFAP("F",FANr,BONNr,FALNr),PRNr=$P(R,D,2),Aantal=$P(R,D,3),Kom=$P(R,D,28)="KOM"
 ...Quit:'PRNr
 ...If '$D(^KPR(PRNr,"J5810")),'$D(^KPRO(PRNr,"J5810")) Quit
 ...Set R=$G(^HULP(%J,"PRNR",PRNr)),$P(R,D,Kom+1)=$P(R,D,Kom+1)+1,$P(R,D,Kom+3)=$P(R,D,Kom+3)+Aantal
 ...Set:$P(R,D,Kom+5)<Date $P(R,D,Kom+5)=Date
 ...Set ^HULP(%J,"PRNR",PRNr)=R
 ;
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:'PRNr  Do
 .Quit:'$D(^KPR(PRNr,"J5810"))
 .Set R=^KPR(PRNr,0),FysStock=$P(R,D,14)
 .Set ScanTyp=$P(R,D,24)
 .Quit:'FysStock
 .Set R=$G(^HULP(%J,"PRNR",PRNr)),$P(R,D,7,8)=FysStock_D_ScanTyp,^HULP(%J,"PRNR",PRNr)=R
 ;
 Set PRNr=0
 For  Set PRNr=$O(^HULP(%J,"PRNR",PRNr)) Quit:'PRNr  Do
 .Set SortKey=$$SORTKEY^PRODUKT(PRNr)
 .If SortKey="" Do
 ..Set R=^KPRO(PRNr,0),KortTxt=$P(R,D),R=^KPRO(PRNr,2),IdentNr=$P(R,D,25)
 ..Set SortKey=$P(^($O(^KPRO(PRNr,"I"))),D,3)
 ..Set Sectie=$P(^($O(^KPRO(PRNr,"I"))),D,5)
 ..Set SortKey=SortKey_$$COMPRES^PRODUKT(KortTxt,Sectie,"",IdentNr)
 .Else  Do
 ..Set R=^KPR(PRNr,0),KortTxt=$P(R,D),R=^KPR(PRNr,2),IdentNr=$P(R,D,25)
 .Set R=^HULP(%J,"PRNR",PRNr),R=IdentNr_D_KortTxt_D_R,^HULP(%J,"SORT",SortKey)=R
 Kill ^HULP(%J,"PRNR")
 Set Count=1,SortKey="",^HULP(%J,Count)="Identnummer\Korttekst\Lijnen stock\Lijnen KOM\Aantal stock\Aantal KOM\Datum stock\Datum KOM\Fys stock\ScanType"
 For  Set SortKey=$O(^HULP(%J,"SORT",SortKey)) Quit:SortKey=""  Do
 .Set R=^HULP(%J,"SORT",SortKey),Count=Count+1,^HULP(%J,Count)=R
 Kill ^HULP(%J,"SORT")
 Write !,"[] = ok voor begin transfer"
 Read K
 Set Next=0
 For  Set Next=$O(^HULP(%J,Next)) Quit:'Next  Do
 .Set R=^HULP(%J,Next)
 .For I=1:1:6 w $P(R,D,I),$C(9)
 .For I=7,8 w $S($P(R,D,I):$$EXTDATE^vhDTyp($P(R,D,I)),1:""),$C(9)
 .Write $P(R,D,9),$C(9),$P(R,D,10),$C(13)
 Write "~~~"
 Kill ^HULP(%J)
 Quit
 ;