cAN101(OUT,RSLN,RSQ,RSDMS,RSX,RSB,RSFLT,RSTIT,RSZ) ;Syn. ;%AN101 ; [ 01/04/01 8:18 AM ] N RSTAB S RSZ="",RSTAB=0 G 1 ; T0 ;Synoniemen ; ; T0F ;Synonymes ; ; T0E ;Synonyms ; ; ; ingang met "zonder" toegelaten Z(OUT,RSLN,RSQ,RSDMS,RSX,RSTAB,RSFLT,RSTIT,RSZ) N RSB S:$G(RSZ)="" RSZ=$$Z^cAFO1 G 1 ; ; indeling inputzone(s) S1 W /WSCROFF,/CUP(1,1),/WCMD,/CUP(2,1),/cDR(1),/cDR(2,78) S1A S I=RSM(1,"TAAL",$E(QT_"N")) I $D(RSM(2)) D . W /CUP(1,2+$L($P(I,D))+3+$P(I,D,2)+1),/cDR(3) . W /CUP(2,2+$L($P(I,D))+3+$P(I,D,2)+1),/cDR(8) S1B W /cDR(0),/CUP(1,2),/SGR(1),$P(I,D),/SGR(0)," :" I $D(RSM(2)) D . W /CUP(1,2+$L($P(I,D))+3+$P(I,D,2)+3) . W /SGR(1),$P(RSM(2,"TAAL",$E(QT_"N")),D),/SGR(0)," :" S1C I $L(RSZ) D . W /CUP(2,$P(QW(QW),D,4)-$L(RSZ)-4),/cDR(1),/cDR(8) . W /CUP(1,$P(QW(QW),D,4)-$L(RSZ)-4),/cDR(3),/cDR(0)," ",RSZ S1Z Q ; ; tonen input S2(K) W /CUP(1,RSK-1),$E(K_$J("",RSL),1,RSL),/WDSP Q ; ; conversie input S3(R) I RK=28,K'="-",K'=",",K'="..",$L($G(RSM(R,"CONV"))) X RSM(R,"CONV") S3Z Q ; ; algemene initialisatie 1 N I,II,J,JJ,R,RSC,RSCONF,RSD,RSDD,RSI,RSJ,RSK,RSKEYS,RSL,RSM,RSN,RSQ2,RSQ22,RSREF,RSV,UQC,USC,RSBAR,RSUI1,SWSL,oQ 10 S $ZT="TRAP^cAN000" M oQ=Q N Q S Q=oQ ; KU : 20.02.07 : nodig om Q(49) te veranderen en achteraf Q terug te zetten. ; ; New : indien in de fout is in de errortrap juiste Q en Q(49) van RSDMS te vinden ; ; maar op prompt is de oude Q en Q(49) terug D Q49^cAFA10(Q,RSDMS) ; bepalen Q(49) voor RSDMS 11 D DMS^cAN000("UQC","USC",RSDMS) S K="-" G YZ:'$L(UQC),YZ:'$L(USC),YZ:'$D(^DMC(UQC,USC)) 13 S RSDD=^DMC(UQC,USC,"DATA"),RSREF=^("DATA","REF"),RSQ2=^("INDEX") S RSQ22=$G(^("INDEX2")) ; KU : 20.02.07 15 S R=$G(RSTIT,$P(^DMC(UQC,USC,"TAAL",$E(QT_"N")),D,2)) I R="" S R=$P(^DMC(UQC,USC,"TAAL",$E(QT_"N")),D,2) I R="" S R=$P(^DMC(UQC,USC,"TAAL","N"),D,2) 17 D P^cA612(RSLN,1,25-RSLN,80,1,1,1,1,$$UC^cAFA1($E(R))_$E(R,2,99),0,1,0,0,0) 19 S RSCONF=$G(^DMC(UQC,USC,"CONF")),RSC=^("SYN",0) D G 41:RSC,Y . S SWSL=1 . I $L($P($G(^DPAR(0,"PAR.DMS",RSDMS,0)),D,11)) S RSC=$P(^(0),D,11),SWSL=0 . I SWSL=1,$L($G(QU)) D ; self-learning .. S I=$G(^DPAR(0,"PAR.DMS",RSDMS,QU),RSC) .. I $D(^DMC(UQC,USC,"SYN",I)) S RSC=I Q .. S RSC=$O(^(0)) . S RSCONF(70)=0,RSCONF(28)=0 ; ^F en opmerking . I $G(QU(1)),$P($G(^DPAR(0,"PAR.DMS",RSDMS,0)),D,10) D .. S I=$G(^DATA(0,"USR_PAR.DMS",QU(1)_" "_RSDMS,0)) .. S RSCONF(70)=$P(I,D,3) I RSCONF(70) S RSCONF=1 .. S RSCONF(28)=$P(I,D,4) . S RSKEYS="" ; extra keys . S I="" F S I=$O(^DMC(UQC,USC,"SYN",0,0,I)) Q:I="" S RSKEYS=RSKEYS_D_I ; ; input-1 2 I $L(RSZ),'$L($G(RSTAB)),'$L($G(RSX)) S RSTAB=1 G 6 20 S RSTAB=0,RSI(1)="",K="" I $L($G(RSX)) G 3:$E(RSX,1,2)'=".." K RSX G 4 21 S I=RSM(1,"TAAL",$E(QT_"N")),RSK=6+$L($P(I,D)),RSL=$P(I,D,2) 22 I $L($G(RSM(1,"X"))) X RSM(1,"X") G 24 221 I $L($P(RSM(1,"B"),D,2)) G 3 ; via multiple 23 D ^cAFA0(K,RSLN+1,RSK,RSL,7,"27\29"_RSKEYS,0,0,0),S3(1),S2(K) 24 I RK=27 S RSTAB=0,K="-" G 4:$L($G(RSM(1,"X"))),Y 25 I RK=28 D G Y:K="-",4:K="..",Y:'RSM(1,"B"),3 . S RSTAB=0 . S:$E(K)="-"!($E(K)=",") K="-" . I K="-"!(K="..") Q . S RSI(1)=K 27 I RK=29 S RSTAB=$L(RSZ) G 3 28 I $D(^DMC(UQC,USC,"SYN",0,0,RK,0)) D C^cA612 X ^(0) G NEW:$L($G(NUI1)),15 29 S RSTAB=0 G 2 ; ; input-2 3 S RSI(2)="",K="" I $L($G(RSX))!'$D(RSM(2)) G 6:RSTAB,2:RK=29,5 30 W /CUP(3,1),/WCMD 31 S I=RSM(2,"TAAL",$E(QT_"N")),RSK=RSK+RSL+6+$L($P(I,D)),RSL=$P(I,D,2) 32 I $L($G(RSM(2,"X"))) X RSM(2,"X") G 34 33 D ^cAFA0(K,RSLN+1,RSK,RSL,7,"27\29"_RSKEYS,0,0,0),S3(2),S2(K) 34 I RK=27 S RSTAB=0,K="-" G 4:$L($G(RSM(2,"X"))),Y 35 I RK=28 S RSTAB=0 D G Y:K="-",4:K=".." S RSI(2)=K G 5 . I $E(K)="-"!($E(K)=",") S K="-" 37 I RK=29 G 6:RSTAB,2 38 I $D(^DMC(UQC,USC,"SYN",0,0,RK,0)) D C^cA612 X ^(0) G NEW:$L($G(NUI1)),15 39 S RSTAB=0 G 3 ; ; selectie indexbestand 4 D ^cAN103("K",RSLN+1,"DAM","^DMC_SYN",RSC) G Y:K="-" S RSC=K 41 K K,RSM M RSM=^DMC(UQC,USC,"SYN",RSC) D S1 S RSN=0 43 I $L($G(QU)) S ^DPAR(0,"PAR.DMS",RSDMS,QU)=RSC 45 I $L($G(RSB)) D S RSB="" I $L(RSX) S K=RSX D S3(1) S RSI(1)=K,(RSX,RSI(2))="" G 5 . S I=0 F S I=$O(^DMC(UQC,USC,"SYN",I)) Q:I="" D .. K J M J=^(I) .. ; zoekmethode barcode .. I $P(RSB,"#",2) S RSB=$P(RSB,"#") I $D(^DMC(UQC,USC,"DATA","BAR","SYN")) S II=^("SYN") I II,$D(^DMC(UQC,USC,"SYN",II)),^(II,1,"B")=RSB K J M J=^DMC(UQC,USC,"SYN",II) .. I J(1,"B")=RSB K RSM M RSM=J S RSC=I,I=999 . K J D S1 47 G 2 ; ; scroll in selectie 5 ; indien begint met $$... eventueel een intern nummer ? K RSUI1 I $E(RSI(1),1,2)="$$" N UI1 S UI1=+$E(RSI(1),3,99) I UI1,$D(@RSREF) S RSUI1=UI1 G BAR ; indien via code (barcode) ; RSBAR kan meegegeven worden via ^("CONF") ; RSBAR = 1 : barcodes mogelijk I $G(RSBAR) D ^cAN1010 I $L($G(RSUI1)) G BAR D ^cAN1011 51 I RK=27 S K="-" G Y 53 I RK=28 G Y 55 I RK=29 G 2 58 I $D(^DMC(UQC,USC,"SYN",0,0,RK,0)) D C^cA612 X ^(0) G NEW:$L($G(NUI1)),15 59 G 5 ; ; zonder 6 S K=$P(QW(QW),D,4)-$L(RSZ)-2 W /CUP(1,K),/SGR(7),RSZ,/CUP(1,K),/WDSP 61 D ^cAFA0("",0,0,0,0,$P(RSKEYS,D,2,99),0,0,0) W /SGR(0),RSZ 63 I RK=27 S K="-" G Y 65 I RK=28 S K="" G Y 67 I RK=29 G 2 68 I $D(^DMC(UQC,USC,"SYN",0,0,RK,0)) D C^cA612 X ^(0) G NEW:$L($G(NUI1)),15 69 G 6 ; ; ingang via "[] = synoniemen" *** niet meer gebruiken *** SPATIE(OUT,RSLN,RSQ,RSDMS,RSX) N RSZ S RSZ="" D 1 I K'="-" D . N UQC,USC,UDD . D DMS^cAN000("UQC","USC",RSDMS) S UDD=^DMC(UQC,USC,"DATA") . I UDD<3 S K=$$SIG^cAFA1(RSDMS,K,101) G YZ ; ; uitgang igv barcode BAR S K=RSUI1 K RSUI1 G Y ; ; uitgang igv 1x openen ipv continu NEW S K=NUI1 K NUI1 G YA ; ; einde Y D C^cA612 YA I $L(K),K'="-" D . N UI1 . S UI1=K I '$D(@RSREF) S K="-" Q . I RSCONF(28),$L($G(^DMC(UQC,USC,"OPM"))) S R=^("OPM") I $D(@RSREF) X R S K=UI1 . I $D(@RSREF),$L(RSZ),RSDD<3 S K=$P(^(UI1,0),D) YZ S @OUT=K ; K Q(49) M Q=oQ ; KU : 20.02.07 Q ; ZZ ; 29.08.07 - 10 u 22 * V8.09