PRSORT ;Sortering produkt binnen subgroep [ 02/22/2002  8:21 AM ]
 ;
N ; Normale korttekst
 Set Schaduw=0
 Do INIT
 Do COMMAND,CLEAN
 Quit
 ;
S ; Schaduw korttekst
 Set Schaduw=1
 Do INIT
 Do COMMAND,CLEAN
 Quit
 ;
COMMAND Do SELECT
 For  Quit:Input="-"!(Input=".")  Do
 .Do REFRESH,SL^PROC
 .Set Input=R
 .If Input="-"!(Input="."),$L(Status) Set Input=$$SAVE^vhINP(1)
 .;If Input="HELP" Do HELP
 .If Input="P" Do RAADPL
 .If Input="M" Do MARK
 .If Input="S" Do SELECT
 .If Input="U" Do UNSORT(KKey)
 .If Input="R" Do REFETCH
 Quit
 ;
INIT 
 Set NivNr=0,%J=$$%J^vhRtn1()
 Write @F11,@F1
 Do ADD^vhScherm(1,1),REFRESH
 Kill ^HULP(%J)
 Do INIT^PROC("PRSORT")
 Set (KHS,KSS,KGS)=""
 Set KKey=""
 Set Input=""
 Set Status=""
 Set PScreen=""
 Quit
 
CLEAN Kill ^HULP(%J)
 Quit
 
SELECT 
 Set K=$$SELECT^KLASS(3)
 If 'KKey,'K Set Input="-"
 Quit:'K
 Set KKey=$P(K,D)
 Do REFETCH
 Quit
 
REFETCH 
 Set KHS=$$GETSORT^KLASS(KKey,1)
 Set KGS=$$GETSORT^KLASS(KKey,2)
 Set KSS=$$GETSORT^KLASS(KKey,3)
 Kill ^HULP(%J)
 Set KT="",Cnt=""
 For  Set KT=$O(^KPH(KHS,KGS,KSS,"  ",KT)) Quit:KT=""  Do
 .Set PRNr=+^(KT)
 .Set Cnt=Cnt+1
 .Do FETCHL(PRNr)
 Do RL^PROC1
 Do ADD^vhScherm(1,24)
 Set PRSORT(6)=1,PRSORT(7)=0
 Quit
FETCHL(PRNr,Nr) 
 Set Rec=PRNr_D_$P(^KPR(PRNr,2),D,25)
 If Schaduw Set $P(Rec,D,3)=$P(^KPR(PRNr,0),D,20,21)
 Else  Do
 .Set $P(Rec,D,3)=$P(^KPR(PRNr,0),D,1)
 .Set Key=$O(^KPR(PRNr,"I"))
 .Set:$E(Key)="I" $P(Rec,D,4)=$P(^KPR(PRNr,Key),D,5)
 Set:'$D(Nr) Nr=$$COMPRES^PRODUKT($P(Rec,D,3),$P(Rec,D,4),"",$P(^KPR(PRNr,2),D,25))
 Set ^HULP(%J,Nr)=Rec
 Quit
 
UNSORT(KKey) 
 Set KHS=$$GETSORT^KLASS(KKey,1)
 Set KGS=$$GETSORT^KLASS(KKey,2)
 Set KSS=$$GETSORT^KLASS(KKey,3)
 Kill ^HULP(%J)
 Set KT=""
 For  Set KT=$O(^KPH(KHS,KGS,KSS,"  ",KT)) Quit:KT=""  Do
 .Set PRNr=+^(KT)
 .Set Key=$O(^KPR(PRNr,"I")) Quit:$E(Key)'="I"
 .Do STORE(PRNr,"")
 Do REFETCH
 Quit
 ;
MARK 
 New IK Set IK(2)=3
 Do IK^PROC1
 Quit:'($A(R)'<$A("A")&($A(R)'>$A("Z"))!(R=" "))
 Set PRNr=+$G(^HULP(%J,PRSORT(6)))
 Set Key=$O(^KPR(PRNr,"I")) Quit:$E(Key)'="I"
 Do STORE(PRNr,R)
 Do FETCHL(PRNr,PRSORT(6))
 Do EL^PROC:PRSORT(6)=PRSORT(9)
 Set DL(2)="DO" Do ML^PROC
 Kill DL(2)
 Quit
 ;
STORE(PRNr,Char) 
 Quit:'$D(^KPR(PRNr))
 For  Do  Quit:%TC
 .Lock +^KPR(PRNr):2 
 .Set %TC=$T
 .Else  Do LDISPL^vhLock("^KPR(PRNr)","Produkt "_$P(^KPR(PRNr,0),D,1))
 If Schaduw Set $P(^KPR(PRNr,0),D,21)=$S(Char=" ":"",1:Char)
 Else  Do
 .Do DELIND^PRODUKT2(PRNr)
 .Set $P(^KPR(PRNr,Key),D,5)=$S(Char=" ":"",1:Char)
 .Do BLDIND^PRODUKT2(PRNr)
 Lock -^KPR(PRNr)
 Quit
REFRESH 
 If sRT=1 Write @F11,@FMTI," BEHEER SERIES"_$S(Schaduw:" - SCHADUW",1:"")_" - ",QN," ",@FMTi,@F2,!,@F2
 If sRT<3,sRB>2 Set FP="301" Write @F,"  Klassificatie : ",$$DISPL^KLASS(KKey)
 If sRT<4,sRB>3 Set FP="401" Write @F,@F2
 If sRB>4 Kill DL(2),DL(3) Set DL(2)=sRT,DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Do RESET^vhScherm Quit
 
RAADPL 
 Set PRNr=+$G(^HULP(%J,PRSORT(6)))
 Quit:'PRNr
 For  Do  Quit:Aktie=""
 .Set R=$$RAADPL^PRODUKT(PRNr,$G(PScreen),1)
 .Set PScreen=$P(R,D),Aktie=$P(R,D,3)
 .Quit:Aktie=""
 .Set (PRNr,Aktie)=$$NEXTPROD(Aktie)
 Do ADD^vhScherm(1,24),REFRESH
 Quit
NEXTPROD(Dir) 
 New Next
 Set Dir=$S(Dir="N":1,1:-1)
 Set Next=$O(^HULP(%J,PRSORT(6)),Dir)
 If Next="" Quit ""
 Set PRSORT(6)=Next Kill PRSORT(7)
 Quit ^HULP(%J,Next)
 ;
 ;