cAN1013 ;Synoniemen via HG-GR-SG ;%AN101 ; [ 05/30/96  10:13 AM ]
 ;
 ; algemene init
0 N HG,HGN,GR,GRN,SG,SGN,RSD,RSORT,FILTER
01 S $ZT="TRAP^cAN000"
 ;
 ; hoofdgroep
1 s FILTER="I $d(^INDEX(Q,""PR"",""M1"",UI1))"
11 s HG=$$^cANSYN("PR.HG",RSLN+2,"","","","",FILTER) g YZ:K="-"
13 s HGN=$p(^(K,0),D,QTU*10-8) d S2(HGN)
 ;
 ; groep
2 s FILTER="I $d(^INDEX(Q,""PR"",""M1"",HG,UI1))"
21 s GR=$$^cANSYN("PR.GR",RSLN+2,"","","","",FILTER) i K="-" d S2("") g 1
23 s GRN=$p(^(K,0),D,QTU*10-8) d S2(HGN_" - "_GRN)
 ;
 ; subgroep
3 s FILTER="I $$IM3^"_$T(+0)_"(""PR"",HG,GR,UI1,""M1"")"
31 s SG=$$^cANSYN("PR.SG",RSLN+2,"","","","",FILTER) i K="-" d S2(HGN) g 2
33 s SGN=$p(^(K,0),D,QTU*10-8) d S2(HGN_" - "_GRN_" - "_SGN)
 ;
 ; producten sorteren in ^HULP
4 I '$G(RSORT) D
 . L +^HULP("SORT",0)
 . S RSORT=$G(^HULP("SORT",0),1),^(0)=RSORT+1
 . L -^HULP("SORT",0)
41 K ^HULP("SORT",RSORT)
43 n RSO,RSB s RSO=101,RSB=101,RSI=SG,RSI2=""
 ;
5 s RSD="^INDEX(Q,""PR"",""M1"",HG,GR)"
51 S RSJ(1)=$$DP^cAFA1($$UC^cAFA1(RSI))_" ",RSJ(2)=$$DP^cAFA1($$UC^cAFA1(RSI2))
53 S J=RSJ(1)
55 F  D S1(J,1) Q:J=""  I $$S3 S ^HULP("SORT",RSORT,$$DI^cAN000($$S4(RSO),J(0)))=J(0)
 ;
 ; scrollen door producten
6 S RSD="^HULP(""SORT"",RSORT)",RSI(1)="",RSI(2)=""
61 d ^cAN1014
63 i RK=27 s K="-" d S2(HGN_"-"_GRN) w /CUP(3,1),/WCMD g 3
65 i RK=28 g YZ
67 i RK=29 d S2("") w /CUP(3,1),/WCMD g 1
69 g 61
 ;
YZ Q
 ;
 ; volgende (1) of vorige (-1) index
S1(S1,S2)          K J S J=$O(@RSD@(S1),S2) I $L(J) S J(0)=^(J)
S1A I $E(J,1,$L(RSJ(1)))'=RSJ(1) S J=""
S1B I J="",S2<0 S J=0
S1Z Q
 ;
S2(K) W /CUP(1,RSK-1),$E(K_$J("",RSL),1,RSL),/WCML,/WDSP Q
 ;
 ; test op niveau & 2° input
S3() N S1,S2,UI1 S S1=1
S3A S UI1=J(0),S2=+$P($G(@RSREF@(0)),D,30) I S2'=RSN S S1=0
S3B I S1,$L(RSJ(2)),$G(RSB2) D
 . S S2=$P($G(^(RSB2\100-1)),D,RSB2#100)
 . S S2=$$DP^cAFA1($$UC^cAFA1(S2)) I $E(S2,1,$L(RSJ(2)))'=RSJ(2) S S1=0
S3Z Q S1
 ;
 ; ophalen nieuwe input
S4(S1) N S2,UI1
 S UI1=J(0),S2=$P($G(^(S1\100-1)),D,S1#100)
S4Z Q S2
 ;
IM3(DMS,I1,I2,I3,MU)   ; index in gelinkd bestand ophalen via multiple
 n IREF,R,R1,UDD,UQC,USC
 d DMS^cAN000("UQC","USC",DMS)
 s UDD=^DMC(UQC,USC,"DATA"),IREF=$g(^("DATA","INDEX"))
 s R1=$o(@IREF@(MU,I1,I2,I3_" ")),R=$s($p(R1," ")=I3:$p(R1," ",2),1:"")
 q R
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84