cwhist ; ;[ 03/04/99  1:01 PM ]
 Quit
 ;
CORRWMS 
 New
 Set Q="K"
 Do ^cA604
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:'PRNr  Do CUMHIST(PRNr,"Corr WMS")
 Quit
 ;
CUMHIST(PRNr,Text) 
 New I,R,HistNr,HistRec,Corr,Aantal,Del,Piece
 Set HistNr="H9999"
 For  Set HistNr=$O(^KPR(PRNr,HistNr),-1) Quit:$E(HistNr)'="H"  Do
 .Set HistRec=^KPR(PRNr,HistNr)
 .Quit:HistRec'[Text
 .For I=$L(HistRec,D):-1:1 Do  Quit:HistRec'[Text
 ..Set R=$P(HistRec,D,I)
 ..Quit:R'[Text
 ..Set Corr=$E(R,7),Aantal=$E($P(R,"#"),8,99)
 ..If Corr=3,$D(Corr(3)) Kill Corr(3)
 ..If Corr=4,$D(Corr(4)) Kill Corr(4)
 ..If Corr=3,$D(Corr(4)),$P(Corr(4),D)'=Aantal Kill Corr(4)
 ..If Corr=4,$D(Corr(3)),$P(Corr(3),D)'=Aantal Kill Corr(3)
 ..Set Corr(Corr)=Aantal_D_HistNr_D_I
 ..If $D(Corr(3)),$D(Corr(4)) Do
 ...For Corr=3,4 Set R=Corr(Corr),Del($P(R,D,2),$P(R,D,3))=$P(R,D)
 ...Kill Corr
 If $D(Del) Do
 .Quit:$L(R)
 .Set HistNr=""
 .For  Set HistNr=$O(Del(HistNr),-1) Quit:HistNr=""  Do
 ..Set HistRec=^KPR(PRNr,HistNr),Piece=""
 ..For  Set Piece=$O(Del(HistNr,Piece),-1) Quit:Piece=""  Do
 ...Set $P(HistRec,D,Piece,99)=$P(HistRec,D,Piece+1,99)
 ..Set ^KPR(PRNr,HistNr)=HistRec
 .Set HistNr="H9999"
 .For  Set HistNr=$O(^KPR(PRNr,HistNr),-1) Quit:$E(HistNr)'="H"  Set HistRec=^KPR(PRNr,HistNr) Quit:$L(HistRec)  Do
 ..Kill ^KPR(PRNr,HistNr)
 ..If ^KPR(PRNr,"H")=1 Kill ^KPR(PRNr,"H")
 ..Else  Set ^KPR(PRNr,"H")=^KPR(PRNr,"H")-1
 Quit
 ;