cAFA6 ;Standaardfuncties catalogi ;%AFA6 [ 06/30/00  3:36 PM ]
 ;
T1 ;Catalogus;Link CTLG;
T2 ;Update linken
T3 ;Keuze\"1[] = bestand inlezen   2[] = bestand verwerken";
 ;
T1F ;Catalogue;Liaison CTLG;
T2F ;Mise à jour liaisons
T3F ;Choix\"1[] = lecture du fichier   2[] = traitement des données";
 ;
T1E ;Catalogus;Link CTLG;
T2E ;Update linken
T3E ;Keuze\"1[] = bestand inlezen   2[] = bestand verwerken";
 ;
CTLGDEF(K)         ; definitie van variabelen van de catalogus
 ; K = intern nummer catologus
 ;
 S CTLGUI1=K
 S CTLGDMS=$$SIG^cAFA1("CTLG",CTLGUI1,120) ;    DMS van de catalogus
 S CTLGUQA=$$SIG^cAFA1("CTLG",CTLGUI1,121) ;    UQA van de catalogus
 S CTLGUSA=$$SIG^cAFA1("CTLG",CTLGUI1,122) ;    USA van de catalogus
 Q
 ;
DMA(UQA,USA,BI)    ; ophalen omschrijving rubriek
 N I,J,R
 S R="",I=0,J=""
 F  S I=$O(^DMA(UQA,USA,I)) Q:'$L(I)  D  I $L(J) Q
 . S J=0 F  S J=$O(^DMA(UQA,USA,I,J)) Q:'$L(J)  I $G(^(J,16))=BI Q
 I '$L(I)!'$L(J) Q R
 S R=$P($G(^DMA(UQA,USA,I,J,1)),D)
 Q R
 ;
INL(CTLG)          ; inlezen floppie cataloog
 N KEU
 D P^cA612(2,1,20,80,1,0,1,1,$P($T(@("T0"_QT)),U,2)_$$SG^cAFA1("CTLG",CTLG,102),0,0,7,1,1)
 S MSDOS=$$SG^cAFA1("CTLG",CTLG,201),FORM=$P($G(^(1)),D,2)
 I '$L(MSDOS) S K="-" G INLZ
 I '$L(FORM) S K="-" G INLZ
INLA S R="KEU\22\3\"_$P($T(@("T3"_QT)),U,2)_"\1\\""-12""[K&$L(K)" D R0 G INLZ:K="-"
 ;
INLB I KEU=1 D ^cA703 I K="-" G INLA
INLC D ^cA705 I K'="." G INLA
 ;
INLZ D C^cA612 Q
 ;
LINK(CTLG)         ;
 D O^cA612(19,1,5,80,1,0,0,0)
 W /CUP(1,3),$P($T(@("T2"_QT)),U,2)
 N I1,C,IREF,IREFC,R,RA,UQC,USC,DMS,S1,OK,SW1,SW2,SW3,SW4,SW5,U1,U2,U3,U7,UFU,UI1,UQC,UREF,USC,USM,UTIT,UTX,UXX
 D CTLGDEF^cAFA6(CTLG) ; ophalen definitie catalogus
 D DMS^cAN000("UQC","USC",CTLGDMS)
 I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) S IREFC=^DMC(UQC,USC,"DATA","INDEX")
 I '$L($G(IREFC)) Q
 S DMS="PR_LE",I1=$$SG^cAFA1("CTLG",CTLG,103)  ; leveranciersnr
 D DMS^cAN000("UQC","USC",DMS)
 I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
 . N A,B,RI,UI1,PLF,UI1CAT,UI1CATC,UI1CTLG,UI1PR,PLFPD,I2,I3,SW3,TEL,TEL1,ULOG
 . S IREF=^DMC(UQC,USC,"DATA","INDEX")
 . S RI=I1_" ",SW3=3,UFU="W",TEL1=0
 . F TEL=1:1 S RI=$O(@IREF@(101,RI)) Q:$P(RI," ")'=I1  D
 .. S UI1=^(RI) W /CUP(3,3),TEL
 .. D READ^cANP000("A",UI1,DMS)
 .. M B=A
 .. S PLF=$$SG^cAFA1(DMS,UI1,103),UI1PR=$P(^(1),D)
 .. S UI1CAT=$P(^(1),D,29),UI1CTLG=$P(^(1),D,28)
 .. I '$L(PLF) Q
 .. I $L(UI1CTLG),UI1CTLG'=CTLG Q  ; gelinkt met andere catalogus
 .. I UI1CAT,$D(@IREF@("M3",CTLG,UI1CAT_" "_UI1)),$$SIG^cAFA1(CTLGDMS,UI1CAT,101)=PLF Q  ; goed gelinkt
 .. S PLFDP=$$DP^cAFA1(PLF),I2=PLFDP_" ",UI1CATC=""
 .. I '$L(PLFDP) Q
 .. F  S I2=$O(@IREFC@(101,I2)) Q:$P(I2," ")'=PLFDP  D  I $L(UI1CATC) Q
 ... S UI1CAT=^(I2)
 ... I $$SIG^cAFA1(CTLGDMS,UI1CAT,101)'=PLF Q  ; ander product
 ... S I3=UI1CAT_" "
 ... S I3=$O(@IREF@("M3",CTLG,I3))
 ... I $L(I3),$P(I3," ")=UI1CAT,^(I3)'=UI1 Q  ; reeds gelinkt met ander aankoopgegeven
 ... S UI1CATC=UI1CAT Q
 .. I '$L(UI1CATC) Q
 .. S U2(1)=$P($T(@("T1"_QT)),U,2)
 .. D B^cAN000(228,$S(UI1CAT:CTLG,1:""))
 .. I $P(A(2),D,28)'=$P(B(2),D,28) S $P(ULOG(228),D,2,3)=$S($L($P(A(2),D,28)):$$SIG^cAFA1("CTLG",$P(A(2),D,28),101),1:"")_D_$$SIG^cAFA1("CTLG",$P(B(2),D,28),101)
 .. S U2(1)=$P($T(@("T1"_QT)),U,3)
 .. D B^cAN000(229,UI1CAT)
 .. I $P(A(2),D,29)'=$P(B(2),D,29) S $P(ULOG(229),D,2,3)=$S($L($P(A(2),D,29)):$$SIG^cAFA1($$SIG^cAFA1("CTLG",$P(A(2),D,28),120),$P(A(2),D,29),101),1:"")_D_$$SIG^cAFA1(CTLGDMS,$P(B(2),D,29),101)
 .. D U^cAN000
 .. S TEL1=TEL1+1 W /CUP(3,20),TEL1
 S SW3=2
 D DMS^cAN000("UQC","USC","CTLG")
 S U2(1)=$$DMA^cAFA6("CTLG","PW",208)
 D B^cAN000(208,DT)
 S U2(1)=$$DMA^cAFA6("CTLG","PW",209)
 D B^cAN000(209,QU)
 S REFRESH=1
LINKZ D C^cA612 Q
 ;
LCATPR ; link tss cataloog en PR (voor in synoniemen)
 N PRLE,UI1PR,UI1PRLE,NUI1
 S AKPR="-"
LCATPR1 D ^cAN101("CPR",RSLN+1,"",CTLGDMS) I K="-" G LCATPRZ
 S PRLE=$$PRLE(CTLGUI1,CPR) I PRLE S AKPR=$$SIG^cAFA1("PR_LE",PRLE,201) G LCATPRZ
 N R
 S R="S UI1="_CPR
 D R^cAN200(CTLGUSA,CTLGUQA,"","CTLG",R) I K="-" S K="" G LCATPR1
 S PRLE=$$PRLE(CTLGUI1,CPR) I PRLE S AKPR=$$SIG^cAFA1("PR_LE",PRLE,201) K TERMINATE Q
 S K="" G LCATPR1
LCATPRZ Q
 ;
MENU(K) S SWMENU=1 D CTLGDEF(K) Q
 ;
PR(CTLGUI1,I1)     ; ophalen intern productnr uit Q_PR indien gelink
 ; CTLGUI1 = intern nr catalogus (vb 1 = NIKO)
 ; I1      = intern nr product uit catalogus
 N UI1PR,UI1PRLE
 S UI1PRLE=$$PRLE(CTLGUI1,I1)
 I UI1PRLE S UI1PR=$$SIG^cAFA1("PR_LE",UI1PRLE,201)
 Q $G(UI1PR)
 ;
PRLE(CTLGUI1,I1)   ; ophalen internnr. aankoopgegeven
 ; CTLGUI1 = intern nr catalogus (vb 1 = NIKO)
 ; I1      = intern nr product uit catalogus
 N UI1PRLE
 S UI1PRLE=$$IM^cAFA3("PR_LE",CTLGUI1,I1,"M3")  ; ophalen link via aankoopgeg
 Q $G(UI1PRLE)
 ;
CHECK(%X)        ; check bestaande file
 ;test file-name ;mf; [ 09/12/96  10:46 AM ]
 ;
 I %X=""!(%X="-") S %X="-" g CHECKZ
 I $ZV'["MSM" S %X=1 G CHECKZ
 S %Y=%X
 ;S %CURDRV=$ZOS(14) ; save default drive
 ;I %X[":" S %Z=$ZOS(14) I %Z'=$P(%X,":") S %ER=$ZOS(1,$P(%X,":")) I %ER<0 S %Z=$ZOS(1,%CURDRV) D %OS1 G CHECKZ
 ;S %L=$L(%Y,"\") I %Y'[":" S %ER=$ZOS(14) S:%ER'<0 %Y=%ER_":"_%Y I %ER<0 S %Z=$ZOS(1,%CURDRV) D %OS1 G CHECKZ
 ;I %L>2 S %I=$ZOS(11,$P(%Y,":")) S %Z=$P(%Y,"\",1,$L(%Y,"\")-1),%Z=$P(%Z,":",2,999) S:%Z="" %Z="\" I %Z'=%I S %ER=$ZOS(8,%Z),%I=$ZOS(8,%I) I %ER<0 S %Z=$ZOS(1,%CURDRV) D %OS1 G CHECKZ
 ;S %CURDRV=$ZOS(1,%CURDRV) ; restore default drive
 ;I; %L=1 S %ER=$ZOS(11,$P(%Y,":")) I %ER<0 D %OS1 G CHECKZ
 ;S;:%L=1 %Y=$P(%Y,":")_":"_$S(%ER="\":%ER,1:%ER_"\")_$P(%Y,":",2)
 ;S %X=%Y S %ER=$ZOS(10,%Y) I %ER<0 D %OS1 G CHECKZ
 ;
CHECKZ Q %X
 ;
VKP(CTLG,BP,BTW,VKPCO)       ; Berekenen van de verkoopprijs
 ; CTLG = intern nr catalogus
 ; BP = basisprijs
 ; BTW = BTW-code
 ; VKPCO = verkoop coëfficient
 I '$L($G(CTLG))!'$L($G(BP)) G VKPZ
 I '$L($G(BTW)) S BTW=$$SIG^cAFA1("CTLG",CTLG,106)
 I '$L($G(VKPCO)) S VKPCO=$$SIG^cAFA1("CTLG",CTLG,105)
 I VKPCO="" S VKPCO="1"
 S R=$$EP^cAFA30(Q,BP,1,BTW,"","",203,"V",$G(UPRDMS,"PR"),VKPCO)
VKPZ Q R
 ;
 ;
R0 S $P(R,D,12)=$T(+0) D ^cAN1000 Q  ; v12 23.01.95
 ;
Z X ^cZ Q
ZZ ; 05.02.01 - 16 u 23 * V7.84