KPRF ;KLANT-PRODUKTREFERENTIE ;KPRF; Do naar PROC [ 12/22/2003  4:33 PM ]
 G BEGIN
 ;
T1 ;KLANT;4;2;;4;14;;$P(K," ",2)_" "_$P(^KKL(K,0),D,2);6;;;;28;;;
T2 ;IDENTNUMMER;5;2;;5;14;;;11;;;;;;;2
T3 ;KORTTEKST;6;2;;6;14;;;30;;$L(K);;;;;1
T4 ;REFERENTIE;7;2;;7;14;;;30;;$L(K);;;;;3
 ;
T10 ;0;C;L;1;;\2;C;L;25;; | \4;C;L;30
T11 ; Korttekst                 | Referentie
T12 ;VERWIJDEREN PRODUKT : 
T13 ;V = verwijderen   , = hernemen
T14 ;  [] = ok 
T15 ; Dit produkt is reeds opgenomen   W = wijzigen 
T17 ;*** I'm thinking ***
T18 ;IMPORT
T19 ;KLANT PROD REF;OVERZICHT
 ;
O1 S K=$P($T(T15),U,2) G OY
OY S FP=2403 W @F,@F1,@FMTI,K,$P($T(T14),U,2),@FMTi,@F0 K IK D IK^PROC1
OZ Q
 ;
 ;Schermaanduiding
SA S FP=255 W @F,@FMTB,$J($P($T(T18),U,$F("I",U4)),25),@FMTb
 Q
 ;
SA1 S FP=255 W @F,$J("",5),@FMTK,$P($T(T17),U,2),@FMTk
 Q
 ;
 ; Help
HLP D SA
 S HLP(1)=$P($T(T19),U,2),HLP(2)=$P($T(T19),U,3),HLP(3)=10,HLP(6)="" D HLP^HELP
 Q
 ;
 ; Initialisatie
IN S K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
 F I=1:1 S U2=$P($T(@("T"_I)),U,2,999) Q:U2=""  D RUB
 S PRKL(1)="^HULP($J",PRKL(2)=$P($T(T10),U,2,999),PRKL(3)=10,PRKL(4)=10,PRKL(8)=$P($T(T11),U,2)
 S KCX=""
 Q
 ;
 ; Lock
LCK S LCK=1 L ^KPRR("D",KC,PR):2 E  X ^cTXT(0,"N",163) K IK D IK^PROC1 S LCK=0
 Q
 ;
 ; Opzetten rubrieken
RUB S FP=$P(U2,U,5)*100+$P(U2,U,6) W @F,@F9,":"
 S FP=$P(U2,U,2)*100+$P(U2,U,3) W @F,@F6,$P(U2,U,1),@F9
 Q
 ;
 ; Display gegevens
DISPL S K=$P(B,D,$P(U2,U,16)+1) I $L($P(U2,U,8)) X "S K="_$P(U2,U,8)
 S FP=$P(U2,U,5)*100+$P(U2,U,6)+3 W @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13)),@F,K
 Q
 ;
 ; Ophalen produkten klant
REN K ^HULP($J),DL S DL(1)="PRKL",(PR,VNR)=0 D SA1
REN1 S PR=$N(^KPRR("D",KC,PR)) G REN2:PR=-1 S REF=^(PR)
 I '$D(^KPR(PR,0)) S K=REF D KIL G REN1
 S VNR=VNR+1,PC=$P(^(0),D,1),PID=$P(^(2),D,25),^HULP($J,REF_$J("",30-$L(REF))_PR)=PR_D_PC_D_PID_D_REF G REN1
REN2 D RL^PROC1 I $D(U4),U4="V" S:PRKL(6)>1&'$D(^HULP($J,PRKL(6))) PRKL(6)=PRKL(6)-1 G REN3
 S PRKL(6)=1 F I=1:1 Q:'$D(^(I))  S R=+^(I) I R=BPR S PRKL(6)=I Q
REN3 I $D(PRKL(4)) S PRKL(7)=PRKL(6)-PRKL(4)+1 S:PRKL(7)<1 PRKL(7)=1
 D WL^PROC
 Q
 ;
 ; Show produkt
SPR G SPR2:'$D(^HULP($J)) S B=^($J,PRKL(6)) G SPR2:PR=+B
SPR1 S (BPR,PR)=+B F I=2:1 S U2=$P($T(@("T"_I)),U,2,999) Q:U2=""  D DISPL
SPR2 Q
 ;
 ; Compres referentie
COR S R=$$UPTRIMAN^vhRtn1(R)
 Q
 ;
 ; Bepalen indexen
IND K REF S K=K_D
IND1 F I=1:1:$L(K) I $E(K,I)?1P,$E(K,I)'=" " Q
 S R=$E(K,1,I-1),K=$E(K,I+1,$L(K)) D COR I $L(R) S REF(R_" "_PR)=""
 G IND1:$L(K)
 Q
 ;
 ; Clear produkt
CLR F I=2:1 S U2=$P($T(@("T"_I)),U,2,999) Q:U2=""  S FP=$P(U2,U,5)*100+$P(U2,U,6)+3 W @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13))
 Q
 ;
 ; Kill indien '$D(^KPR(PR)) of verwijder
KIL D IND S R=-1
KIL1 S R=$N(REF(R)) I R'=-1 K ^KPRR("I",KC,R) G KIL1
 K ^KPRR("D",KC,PR)
 Q
 ;
 ; Selekteer bestaande
SEL S WNR=$N(^HULP($J,0)),WNR=0
SEL1 S WNR=$N(^(WNR)) I WNR'=-1 G SEL1:K'=+^(WNR)
 I WNR<PRKL(7)!((WNR-PRKL(7)+1)>PRKL(4)) S (PRKL(6),PRKL(7))=WNR D WL^PROC G SEL2
 D DL^PROC S PRKL(6)=WNR D EL^PROC
SEL2 Q
 ;
 ; Nieuw
NEW D CLR S BPR=""
NEW1 I VNR'=PRKL(6) S DL(2)="EN" D ML^PROC K DL(2)
NEW2 S R="K\2100\P" D ^SELPR I K="-" D CLR G NEW4
 I $D(^KPRR("D",KC,K)) D SEL,O1 G NEW1:R'="W",WZN
 S PR=K,B=PR_D_$P(^KPR(PR,0),D,1)_D_$P(^(2),D,25) D SPR1
 S I=4 D INP G NEW2:K="-" I K="," D CLR G NEW2
 D C23
 D IND S R=-1
NEW3 S R=$N(REF(R)) I R'=-1 S ^KPRR("I",KC,R)=REF(R) G NEW3
 I VNR'>PRKL(4),$D(^HULP($J,PRKL(6))) D DL^PROC
 S ^KPRR("D",KC,PR)=$P(B,D,4),VNR=VNR+1,^HULP($J,VNR)=B
 S PRKL(6)=VNR I VNR'>PRKL(4) D EL^PROC
NEW4 I K'="-",VNR>PRKL(4) S PRKL(6)=VNR-1,DL(2)="DO" D ML^PROC K DL(2)
 Q
 ;
 ;
 ; Input
INP S U2=$P($T(@("T"_I)),U,2,999) G INP2:U2=""
INP1 S R="K\23\3\"_$P(U2,U,1)_"\"""_$P(U2,U,10)_"""\"_$P(U2,U,9)_"\\"_$P(U2,U,11) D R0^cA100
 I K'="-",K'="," S $P(B,D,$P(U2,U,16)+1)=K D DISPL
INP2 Q
 ;
 ; Verwijderen
VRW G VRW3:'$D(^HULP($J)) I $D(B),B=^($J,PRKL(6)) G VRW1
 D SPR
VRW1 D LCK G VRW2:'LCK
 S FP=2303 W @F,$P($T(T12),U,2),$P(B,D,2)
 W !?2,$P($T(T13),U,2) K IK D IK^PROC1
 I R="V" D CLR S PR=+B,K=$P(B,D,4) K B D KIL S R="V"
VRW2 D C23
VRW3 Q
 ;
 ; Wijzigen
WZN G WZN3:'$D(^HULP($J)) S B=^($J,PRKL(6)),PR=+B,O=$P(B,D,4) I PR'=BPR D SPR1
 D LCK I 'LCK D C23 G WZN3
 S I=4 D INP G WZN:K="," D C23 G WZN3:K="-"
 S K=O D IND S R=-1
WZN1 S R=$N(REF(R)) I R'=-1 K ^KPRR("I",KC,R) G WZN1
 S ^KPRR("D",KC,PR)=$P(B,D,4),^HULP($J,PRKL(6))=B
 S K=$P(B,D,4) D IND S R=-1
WZN2 S R=$N(REF(R)) I R'=-1 S ^KPRR("I",KC,R)=REF(R) G WZN2
 D EL^PROC
WZN3 Q
 ;
 ; Clear vanaf lijn 23
C23 S FP=2301 W @F,@F1
 Q
 ;
 ; Importeren
IMP D SA
 If $P(^cLOG(boot,"DEV",$$IO^cQ5),D,1)'="MC" Set FP=2301 Write @F,*7,*7,"Dit toestel is geen Macintosh (Druk een toets in)" R *K D C23 Q
 Set FP=2301 Write @F,"De bestaande produktreferenties bewaren of verwijderen :"
 Set FP=2401 Write @F,"V : Verwijderen   [] : Behouden"
 Kill IK Do IK^PROC1 If R="-" Do C23 Quit
 Goto IMP:R'="ENTER"&(R'="V")
 Set U4=R
 Set FP=501 Write @F,@F1
 Set FP=801 Write @F,"Het DATA formaat is als volgt : "
 Set FP=901 Write @F,@FMTB,"IdentNummer [TAB] KortTekst [TAB] ProduktReferentie [RETURN]",@FMTb
 Set FP=1701 Write @F,"Na de boodschap ""Bezig met transfert"", onmiddellijk de file doorsturen"
 Set FP=1801 Write @F,"dit door middel van ""SEND CHARS"" van het FILE Menu"
 Set FP=1901 Write @F,"of door middel van een ""PASTE"" van het clipboard "
 Set FP=2301 Write @F,@F1,"Klaar om het bestand te transferen : "
 Set FP=2401 Write @F,"[] voor transfert en - voor annuleer"
 Kill IK Do IK^PROC1 Quit:R="-"
 Lock ^KPRR("D",KC)
 If U4="V" Kill ^KPRR("I",KC),^KPRR("D",KC)
 Set FP=501 Write @F,@F1
 Set FP=801 Write @F,"De ganse data is doorgestuurd indien ""SEND CHARS"" van het FILE menu "
 Set FP=901 Write @F,"niet meer aangekruist is of elke aktiviteit stopt op het scherm "
 Set FP=1201 Write @F,"Indien deze lijst met de ProduktReferenties niet verschijnt, "
 Set FP=1301 Write @F,"dan een of twee keer op ENTER duwen." 
 Set FP=1524 Write @FSC
 Set FP=1601 Write @F,@F1,@FMTB,"Bezig met transfert",@FMTb
 Set FP=1701 Write @F
IMP1 Read Inp:30 Write ! Goto:'$TEST!(Inp="") IMP2
 Set PrNr=$P(Inp,$C(9),1),PrNm=$P(Inp,$C(9),2),PrRef=$P(Inp,$C(9),3)
 Do VIM 
 Goto IMP1
IMP2 S FP=124 W @FSC Q
 ;
 ; Verwerk import message
VIM S R=PrNr D COR S R=R_" " I $D(^KPR2(R)) S PR=$P(^(R),D,1) G VIM1
 S R=PrNm D COR S R=R_" " I '$D(^KPR1(R)) W @F0 Q
 S PR=$P(^(R),D,1)
VIM1 G VIM3:'$D(^KPRR("D",KC,PR)) S K=^(PR) D IND S R=-1
VIM2 S R=$N(REF(R)) I R'=-1 K ^KPRR("I",KC,R) G VIM2
VIM3 S K=PrRef D IND S R=-1
VIM4 S R=$N(REF(R)) I R'=-1 S ^KPRR("I",KC,R)=REF(R) G VIM4
 S ^KPRR("D",KC,PR)=PrRef
 Q
 ;
 ; Lijst
LST S KLX=^KK1(KC),KL=$P(KLX," ",1)_" "_($P(KLX," ",2)-1)
 S NM2=^KBA(99,2),NM3=^(3) D 15^KPRFL K DL S DL(1)="PRKL" D WL^PROC,C23
 Q
 ;
BEGIN D IN
 ;
KLANT S U2=$P($T(T1),U,2,999),R="B\2100\DE KLANT\KL\K1" D ^cA101 G END:K="-"
 S KC=$P(K," ",2) I KC=KCX G 11:DL(1)="PRKL" S DL(1)="PRKL" D WL^PROC G 11
 D DISPL,CLR S BPR="",U4="?"
 ;
1 S KCX=KC D REN
10 S U4="?" D SA
11 L  S DL(3)=3 D SL^PROC
13 L
 I R="-" D WIJZ^LOG("KLREF",KC) G END
 I R="K" D WIJZ^LOG("KLREF",KC) G KLANT
 S U4=R I U4="" S U4="ENTER"
 I U4="ENTER" D SPR G 11
 I U4="I" D IMP G 10:U4="I" D IN S B=^KK1(KC),U2=$P($T(T1),U,2,999) D DISPL G 1:R'="-" K DL S DL(1)="PRKL" D WL^PROC G 11
 I U4="L" D LST G 11
 I U4="N" D NEW G 13:K=",",11
 I U4="R" G 1
 I U4="V" D VRW G 1:R="V",13
 I U4="W" D WZN G 11
 I U4'="?",U4'="HELP" G 11
 D HLP G 13:"\-\K\"[(D_R_D) K DL S DL(1)="PRKL",U4=R D WL^PROC S R=U4 G 13:R="I",11
 ;
END K ^HULP($J) Q
 ;
Z X ^cZ Q
ZZ ; 12.12.91 - 16 u 24