cAFA61(CTLG)	; Inlezen update catalogus ; [ 10/24/01  10:26 AM ]
	;
	;  Opgeroepen via ^DMM("CTLG","PW","65"
	;
T1	; Inlezen cataloog ;
T2	;Eerste bestand\"0[] = neen   1[] = ja";
T3	;Opgelet: De update bestaat uit meerdere bestanden !;
T4	;Bij het eerste bestand moet de tijdelijke catalog geïnitialiseerd;
T5	;worden.  Indien dit het eerste bestand is dat wordt ingelezen,;
T6	;gelieve op onderstaande vraag 'ja' te antwoorden.;
	;
T1E	; Inlezen cataloog ;
T2E	;Eerste bestand\"0[] = neen   1[] = ja";
T3E	;Opgelet: De update bestaat uit meerdere bestanden !;
T4E	;Bij het eerste bestand moet de tijdelijke catalog geïnitialiseerd;
T5E	;worden.  Indien dit het eerste bestand is dat wordt ingelezen,;
T6E	;gelieve op onderstaande vraag 'ja' te antwoorden.;
	;
	; CTLG = intern nummer catalogus
	;
1	D P^cA612(19,1,5,80,1,0,0,0,$P($T(T1),U,2),0,0,0,0,0)
	N PRG,A,B,TEL,VERW
	S $ZT="TRAP^cAN000"
	;  Ophalen basisgegevens catalogus
	D B(CTLG)
	S PRG=$P(B(1),D,24)              ; Specifiek voor updata catalogus
	D INL^cAFA6(CTLG) G YZ:K="-"     ; inlezen floppie
	;
	;  Indien de parameter 'meerdere bestanden' op ja staat, wordt de
	;  vraag gesteld of dit het eerste bestand is.
2	I $P(B(1),D,10)=1 D
	. D P^cA612(2,1,20,80,1,0,1,1,$P($T(@("T1"_QT)),U,2),0,0,7,1,1)
	. W /CUP(2,2),$P($T(@("T3"_QT)),U,2)
	. W /CUP(4,8),$P($T(@("T4"_QT)),U,2)
	. W /CUP(5,8),$P($T(@("T5"_QT)),U,2)
	. W /CUP(6,8),$P($T(@("T6"_QT)),U,2)
	. S R="VERW\22\3\"_$P($T(@("T2"_QT)),U,2)_"\1\\""-01""[K&$L(K)" D R0
	. D C^cA612
21	I $G(VERW)="-" G YZ
23	D CREATE($P(B(1),D)_".PW")             ; aanmaak ^DPW
	;
3	N TAB
	S TAB(204)=DT
	S TAB(205)=QU
	S TAB(203)=TEL
	D B^cAN220("PW","CTLG",CTLG,"TAB")
	S REFRESH=1
	;
YZ	D C^cA612 Q
	;
CREATE(DMSPW)	     ; Aanmaken definitieve catalogus
	N A,B,UI1,ULOG,UQC,UREF,IREF,USC,USM,UTIT,UTX,UXX
	S $ZT="TRAP^cAN000"
	D DMS^cAN000("UQC","USC",DMSPW)
	I '$L(UQC)!'$L(USC) Q
	S TEL=0
	S IREF=$G(^DMC(UQC,USC,"DATA","INDEX")),UREF=$G(^("REF"))
	I '$L(IREF)!'$L(UREF) Q
	; vorige verwijderen
	; Indien de parameter 'meerdere bestanden' op ja staat,
	; wordt er enkel verwijderd als dit het eerste bestand is.
	I '$L($G(VERW))!($G(VERW)=1) K @IREF,@($P(UREF,",UI1")_")")
	;
	;  Inlezen specifieke gegevens
	I $L(PRG) D @PRG
	;
CREATEZ	Q
	;
STRIP(STRING,PUNCT,LEADSPC,TRAILSPC,CONTRCHR,MAJOR,KWOTE)	         ;strip-funktie
	N I S STRING=$TR(STRING,"\","/")
	F I="PUNCT","LEADSPC","TRAILSPC","CONTRCHR","MAJOR","KWOTE" I '$D(@I) S @I=1
	I LEADSPC F I=1:1:$L(STRING) Q:$E(STRING)'=" "  S STRING=$E(STRING,2,999)
	I TRAILSPC F  Q:$E(STRING,$L(STRING))'=" "  S STRING=$E(STRING,1,$L(STRING)-1)
	I CONTRCHR F I=1:1:$L(STRING) I $E(STRING,I)?1C S STRING=$TR(STRING,$E(STRING,I),""),I=I-1
	I MAJOR S STRING=$$UC^cAFA1(STRING)
	I PUNCT,STRING?.E1P.E S STRING=$$DP^cAFA1(STRING)
	I KWOTE S STRING=$$STRIPKW(STRING)
	Q STRING
	;
B(UI1)	; terug inlezen A en B tabel
	S B(1)=$$SIGN^cAFA1("CTLG",UI1,0)
	F I=1:1:9 I $D(^(I)) S B(I+1)=^(I)
	M A=B
	Q
	;
STRIPKW(STRING)	   
	N I
	I $E(STRING)'=""""&($E(STRING,$L(STRING))'="""") G STRIPKWZ
	S STRING=$E(STRING,2,99)
	S STRING=$E(STRING,1,$L(STRING)-1)
STRIPKWA	I STRING["""""" S STRING=$P(STRING,"""""")_""""_$P(STRING,"""""",2,99) G STRIPKWA
STRIPKWZ	Q STRING
	;
R0	S $P(R,D,12)=$T(+0) D ^cAN1000 Q  ; v12 23.01.95
	;
Z	X ^cZ Q
ZZ	; 07.11.01 -  9 u 36 * V7.89