HADGLAS ;NEW PROGRAM [ 07/11/2000  2:13 PM ]
 Write @F11,@F1
 Write @FMTB," HALUX Zoeken glas - ",QN," ",@FMTb,!
HG1 READ !,"Ingave Afm 1 : ",ZoekAfm1
 Quit:ZoekAfm1="-"
 READ !,"Ingave Afm 2 : ",ZoekAfm2
 Goto:ZoekAfm2="-" HG1
 Set ZoekVul=$$PI^vhPOPUP("C;C","OK1Z","Vulling","HAD","VULLING","")
 Set FP=501 Write @F,"Vulling : ",$S($L(ZoekVul):ZoekVul,1:"ZONDER")
 Write !
 Set PRNr=0
 Set Beide=2
 Set:ZoekAfm1'?1.5N ZoekAfm1=ZoekAfm2,ZoekAfm2="" 
 Set:ZoekAfm2'?1.5N ZoekAfm2=ZoekAfm1,Beide=1
 Set:ZoekAfm1<ZoekAfm2 Afm=ZoekAfm2,ZoekAfm2=ZoekAfm1,ZoekAfm1=Afm
 Set IsFind=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 .Quit:'$D(^KPR(PRNr,"J6332"))
 .Set RecG=$G(^KPR(PRNr,"G"))
 .Set Prof=$P(RecG,D,2) Quit:'$L(Prof)
 .Set Vul=$P(RecG,D,10)
 .If $L(ZoekVul),Vul'=ZoekVul Quit
 .Set:Vul="" Vul="  "
 .Set MinVrGl=$P($G(^RES("HAD","PI","PROFIEL","D",Prof)),"`",3)*2
 .Quit:'MinVrGl
 .Set Hoogte=$P(RecG,D,8)-MinVrGl
 .Set Breedte=$P(RecG,D,9)-MinVrGl
 .Set:Hoogte<Breedte Afm=Breedte,Breedte=Hoogte,Hoogte=Afm
 .Set Found=0
 .If ZoekAfm1-1<Hoogte,ZoekAfm1+1>Hoogte Set Found=Found+1
 .If ZoekAfm2-1<Breedte,ZoekAfm2+1>Breedte Set Found=Found+1
 .Quit:Found'=Beide
 .Set TxtO=""
 .Set BNr=""
 .For  Set BNr=$O(^ORD("IP",PRNr,BNr)) Quit:BNr=""  Set TxtO=TxtO_","_BNr
 .Set:$L(TxtO) TxtO="O:"_$E(TxtO,2,99)
 .Set TxtT=""
 .Set BNr=""
 .For  Set BNr=$O(^TO("IP",PRNr,BNr)) Quit:BNr=""  Set TxtT=TxtT_","_BNr
 .Set:$L(TxtT) TxtT="T:"_$E(TxtT,2,99)
 .Set IsFind=1
 .Write !,$P(^KPR(PRNr,0),D,1),"  H:",$J(Hoogte,4)," x B:",$J(Breedte,4),"  ",Vul,"  ",TxtO," ",TxtT
 If 'IsFind Write !,"NIETS GEVONDEN !!",!
 Write !,@FMTK,"Wachtende op indrukken toets",@FMTk Read K