CONTRACT ;Transfert van contract-orders [ 12/04/92  9:24 AM ]
 Set Select="C"
 Set KL=1000,ORD=""
 For  Set KL=$O(^KOD(KL)) Quit:KL=""  Do
 .K HULP
 .Set K=^KKL(^KK1(KL),0)
 .Set L=""
 .Set PR=""
 .Goto TO2:KL'=1680
 .For  Set PR=$O(^KPRR("D",KL,PR)) Quit:PR=""  Do
 ..Quit:'$D(^KPR(PR))
 ..Set P0=^KPR(PR,0),P1=^(2)
 ..Quit:$P(^(1),"\",20)
 ..Set PJ=^KPR(PR,$O(^KPR(PR,"J")))
 ..Set PI=^KPR(PR,$O(^KPR(PR,"I")))
 ..Set Key=$P(PI,"\",1,3)_$TR($P(P0,"\",1),"\/. :","")
 ..Set HULP(Key)=KL_"\"_$P(K,"\",2)_"\"_$P(K,"\",7)_"\"_$P(P1,"\",25)_"\"_$P(P0,"\",1)_"\"_$P(P0,"\",14)_"\\"_$P(PJ,"\",16)
TO2 .For  Set ORD=$O(^KOD(KL,"F",ORD)) Quit:ORD=""  Do
 ..Set A=^(ORD,1)
 ..Quit:$P(A,"\",25)'=Select
 ..Set LN=99
 ..For  Set LN=$O(^KOD(KL,"F",ORD,LN)) Quit:LN=""  Do
 ...Set L=^(LN)
 ...Quit:$P(L,"\",17)'="KF0"
 ...Set PR=$P(L,"\",2),P0=^KPR(PR,0),P1=^(2)
 ...Set PJ=^KPR(PR,$O(^KPR(PR,"J")))
 ...Set PI=^KPR(PR,$O(^KPR(PR,"I")))
 ...Set Key=$P(PI,"\",1,3)_$TR($P(P0,"\",1),"\/. :","")
 ...Set:$P(L,"\",27)&$D(HULP(Key)) $P(HULP(Key),"\",6)=$P(HULP(Key),"\",6)+$P(L,"\",3)
 ...Set HULP(Key)=KL_"\"_$P(K,"\",2)_"\"_$P(K,"\",7)_"\"_$P(P1,"\",25)_"\"_$P(P0,"\",1)_"\"_($S($P(L,"\",27):$P(L,"\",3),1:0)+$P(P0,"\",14))_"\"_$P(L,"\",25)_"\"_$P(PJ,"\",16)
 .Quit:L=""
 .W !
 .Set I="" For  Set I=$O(HULP(I)) Quit:I=""  W !,$TR(HULP(I),"\",$C(9))