cAB125 ;Beheer multiples; %AB123 [ 10/31/00  5:15 PM ]
 ;
 G YZ
 ;
T0 ;Beheer DMC ;
T1 ;Index ;
T2 ;"[] = einde";
T3 ;Code;      
T6 ;Er kunnen geen multiples worden verwijderd;
T7 ;Volgnummer\"Volgnummer van de te verwijderen multiple";
T9 ;Verwijderen\"V[] = verwijderen   ,[] = hernemen";
T10 ; Wijzigen multiple;
T11 ;Nummer element;
T12 ;Deze code is reeds in gebruik;
T13 ;Index ;
T14 ; werd nog niet ingevuld;
T15 ; Verwijderen multiple;
T16 ;"Mxxx";
 ;
 ;  Vragen CODE
CODE S R="CODE\22\3\"_$P($T(@("T3"_QT)),U,2)_"\"_$P($T(@("T16"_QT)),U,2)_"\10\\$L(K)\\\\\1" D R0 G CODEZ:K="-"
 S OK=1
 I CODE'=OCODE D
 . I CODES[(D_CODE_D) S K=$P($T(@("T12"_QT)),U,2) D TXT^cAFA1(250) S OK=0
 I OK=0 G CODE
 S VCODE=MTAB(KEUZE,0)
 I CODE'=VCODE D
 . M ^DMC(UQC,USC,"MULTI",CODE)=^DMC(UQC,USC,"MULTI",VCODE)
 . K ^DMC(UQC,USC,"MULTI",VCODE)
 . S MTAB(KEUZE,0)=CODE
CODEZ Q
 ;
 ;  Vragen index
INDEX N IN    
 S OK=1
 F i=1:1:(NUME-2)  D
 . I INDEX(i)="" S K=$P($T(@("T13"_QT)),U,2)_i_$P($T(@("T14"_QT)),U,2) D TXT^cAFA1(250) S OK=0 Q
 I OK=0 G INDEXZ
 S IN=INDEX((NUME-1))
 S R="IN\22\3\"_$P($T(@("T1"_QT)),U,2)_(NUME-1)_"\"_$P($T(@("T2"_QT)),U,2)_"\3\\K?3N!(""-""[K)\\\\\1\\\" D R0 G INDEXZ:K="-"
 S INDEX((NUME-1))=IN
 I VOLG((NUME-1))="" D
 . S I1=""
 . S VOLG((NUME-1))=($O(^DMC(UQC,USC,"MULTI",CODE,I1),-1)+1)
 I INDEX(NUME-1)="" K ^DMC(UQC,USC,"MULTI",CODE,VOLG(NUME-1))
 E  S ^DMC(UQC,USC,"MULTI",CODE,VOLG(NUME-1))=INDEX(NUME-1)
 S MTAB(KEUZE,1)=""
 S I2=""
 F  S I2=$O(^DMC(UQC,USC,"MULTI",CODE,I2)) Q:I2=""  D
 . S INDEX=$P($G(^DMC(UQC,USC,"MULTI",CODE,I2)),D)
 . S MTAB(KEUZE,1)=MTAB(KEUZE,1)_I2_U_INDEX_D
 D SORT
INDEXZ Q
 ;
 ;  Controle of CODE reeds bestaat
INPUT(K) N R
 S R=0
 I CODES'[(D_K_D) S R=1 G INPUTZ
 I CODES[(D_K_D) S K=$P($T(@("T12"_QT)),U,2) D TXT^cAFA1(250)
INPUTZ Q R
 ;
 ;  Wijzigen van een bestaande multiple
S1 N CODE,INDEX,VOLG,TELLER,IN,EINDE,I1,OCODE,OK S $ZT="TRAP^cAN000"
S1A D P^cA612(11,0,11,80,1,0,1,0,$P($T(@("T10"_QT)),U,2),0,1,1,0,0)
S1B S OCODE=MTAB(KEUZE,0)
S1C S CODE=MTAB(KEUZE,0)
S1D S (INDEX(1),INDEX(2),INDEX(3),INDEX(4),INDEX(5),INDEX(6))=""
S1E S (VOLG(1),VOLG(2),VOLG(3),VOLG(4),VOLG(5),VOLG(6))=""
S1F S TELLER=1
S1G F  S INDEX=$P($P(MTAB(KEUZE,1),D,TELLER),U,2) Q:(INDEX=""!(TELLER=7))  D
 . S INDEX(TELLER)=$P($P(MTAB(KEUZE,1),D,TELLER),U,2)
 . S VOLG(TELLER)=$P($P(MTAB(KEUZE,1),D,TELLER),U)
 . S TELLER=TELLER+1
S1H D SCHRIJF
S1I S R="NUME\22\3\"_$P($T(@("T11"_QT)),U,2)_"\\1\\$L(K)&(""1234567-""[K)" D R0 G S1Z:K="-"
S1J I NUME="1" D CODE G S1C
S1K I NUME'=1&(NUME'="-") D INDEX G S1C
S1Z D C^cA612 Q
 ;
 ;  Maken van een nieuwe multiple
S2 N CODE,INDEX S $ZT="TRAP^cAN000"
S2A S CODE=""
S2B S (INDEX(1),INDEX(2),INDEX(3),INDEX(4),INDEX(5),INDEX(6))=""
S2C S STOP=0
S2D D P^cAN230("DMC.MULTI","DAM","")
S2E I STOP=1 D
S2F . S EINDE=0 
 . F i=1:1:6  Q:(EINDE=1)  D
 .. I INDEX(i)="" S EINDE=1 Q
 .. S ^DMC(UQC,USC,"MULTI",CODE,i)=INDEX(i)
S2Z Q
 ;
 ;  Verwijderen van een multiple
S3 I NR=0 S K=$P($T(@("T6"_QT)),U,2) D TXT^cAFA1(250) G S3Z
S3A S R="VOLGNR\22\3\"_$P($T(@("T7"_QT)),U,2)_"\2\\$L(K)&(((K?.N)&((K'<1)&(K'>NR)))!(""-""[K))" D R0 G S3Z:K="-"
S3B D P^cA612(11,0,11,80,1,0,0,1,$P($T(@("T15"_QT)),U,2),0,1,1,0,0)
S3C S CODE=MTAB(VOLGNR,0)
S3D S (INDEX(1),INDEX(2),INDEX(3),INDEX(4),INDEX(5),INDEX(6))=""
S3E S TELLER=1
S3F F  S INDEX=$P($P(MTAB(VOLGNR,1),D,TELLER),U,2) Q:(INDEX=""!(TELLER=7))  D
 . S INDEX(TELLER)=$P($P(MTAB(VOLGNR,1),D,TELLER),U,2)
 . S TELLER=TELLER+1
S3G D SCHRIJF
S3H S R="VERWI\22\3\"_$P($T(@("T9"_QT)),U,2)_"\1\\$L(K)&("",V-""[K)\\\1" D R0
S3I I VERWI="-" D C^cA612 G S3A
S3J I VERWI="," G S3Y
S3K I VERWI="V" D
 . K ^DMC(UQC,USC,"MULTI",CODE)
 . D SORT
S3Y D C^cA612
S3Z Q
 ;
 ;  In een venster plaatsen van de actieve multiple
SCHRIJF W /CUP(2,2),@F2,"1. ",@F6,$P($T(@("T3"_QT)),U,2),@F9,"    : ",CODE  
 F i=1:1:6  W /CUP((i+2),2),@F2,(i+1),". ",@F6,$P($T(@("T1"_QT)),U,2),i,@F9," : ",INDEX(i)
SCHRIJFZ Q
 ;
SORT ;  Sorteren van de multiples
 S TEL=0
 K ^HULP(boot,$J+.7)
 S I1=""
 F  S I1=$O(^DMC(UQC,USC,"MULTI",CODE,I1)) Q:I1=""  D
 . S TEL=TEL+1
 . M ^HULP(boot,$J+.7,TEL)=^DMC(UQC,USC,"MULTI",CODE,I1)
 K ^DMC(UQC,USC,"MULTI",CODE)
 M ^DMC(UQC,USC,"MULTI",CODE)=^HULP(boot,$J+.7)
 K ^HULP(boot,$J+.7)
SORTZ Q
 ;
YZ Q
 ;
R0 S $P(R,D,12)=$T(+0) D ^cAN1000 Q
 ;
ZZ ; 02.11.00 - 13 u 32 * V7.81