cAN2301 ;Algemeen vraagprogramma ;%AN230 ; [ 01/04/01  9:50 AM ]
 G 0
 ;
T0 ;Algemeen vraagprogramma ;
T2 ;Bevestiging\"[] = ok   ,[] = hernemen   xx[] = wijzigen rubriek xx";
 ;
T0F ;Programme de question général ;
T2F ;Confirmation\"[] = ok   ,[] = reprendre   xx[] = modifier rubrique xx";
 ;
T0E ;Question program ;
T2E ;Confirmation\"[] = ok   ,[] = retry   xx[] = modify element xx";
 ;
 ; patroon
0 N IREF S IREF=^DMC("DAM","NR.PATROON","DATA","INDEX") S K='$D(@IREF)
01 I 'K D ^cAN103("K",18,"DAM","NR.PATROON",1) I K="-" G YZ
03 S J=USL F I=1:1:$L(J,D) S $P(J,D,I)="?"
05 N P F I=1:1:SW3 S P(I)=$G(@IREF@(K,I-1),J)
 i $d(PATROON),$l(PATROON) x PATROON
 ;
 ; variabelen leeg + pagina 1
1 K B M B=P
10 F I=1:1:SW3 F J=1:1:$L(B(I),D) I $P(B(I),D,J)="?" S $P(B(I),D,J)=""
11 K A M A=B S SW2=1,UI1=""
 ;
 ; pagina per pagina
2 K C D S1^cAN000(SW2) S SW5=1
21 W /WSCROFF F U1=1:1 Q:'$D(C(U1))  D S2^cAN000(U1) S U7=U2(16) I U7>100,U7<(SW3+1*100) D  I K'="?" D S3^cAN000(K)
 . S K=$P(P(U7\100),D,U7#100) I U7#100>$L(P(U7\100),D) S K="?"
23 W /WSCRON S SW5=0
25 S (SW1,U1)=0
27 S U1=$O(C(U1)),RK=28 I U1="" G 6
 ;
 ; merge + uitvoeren rubriek
3 D M^cAN000(U1)
31 S K="",U7=U2(16) I U7>100,U7<(SW3+1*100) S K=$P(B(U7\100),D,U7#100)
32 I $L(U2(17)) X U2(17) G 41
33 I $L(U2(7)) X U2(7)
34 I 'SW1,U7>100,U7<(SW3+1*100) D  I P'="?",RK'=31 G 41
 . S P=$P(P(U7\100),D,U7#100) I U7#100>$L(P(U7\100),D) S P="?"
35 I $L(U2(19)) X U2(19) I $L(U2(11)) D  I @U2(11) G 39
 . S U2(11)=U2(11)_"!(K=""-"")!(K="","")"
37 I $L(U2(19)),$L(U2(11)) G 35
39 I $L(U2(19)) G 41
 ;
 ; manuele input
4 D ^cAN100 s $zt="TRAP^cAN000"
41 I K="-" S U1=$O(C(U1),-1),RK=31 G 6:SW1,3:U1,25:SW2>1,YZ
43 I K="," G 6:SW1,21
 ;
 ; X na input + output
5 I $L(U2(12)) X U2(12) I K="-"!(K=",") G 41
51 D B^cAN000(U7,K),S3^cAN000(K)
53 G 27:'SW1
 ;
 ; einde pagina
6 I $G(REFRESH) D S1^cAN203
 I '$G(UCONF) G 8
61 S R="K\22\3\"_$P($T(@("T2"_QT)),U,2)_"\2\\""-,""[K!$D(C(+K))" D R0 G 8:K="",25:K="," I K="-" S SW1=0,U1=$O(C(""),-1),RK=31 G 3
63 S SW1=1,U1=+K G 3
 ;
 ; na elke pagina
8 S OK=0 I $L($P(UXX,D)) X $P(UXX,D) I 'OK G 95
83 I SW2=SW4 S K="."
87 I K="." G 9
89 S SW2=SW2+1 G 2
 ;
 ; controle input overige pagina's
9 K REFRESH
 S SW2(0)=SW2 I SW2<SW4 S OK=1 D  I 'OK S U1=U1(0) G 3
 . F  S SW2=SW2+1 D  Q:SW2=SW4!'OK
 .. K C D S1^cAN000(SW2) S SW5=1
 .. W /WSCROFF F U1=1:1 Q:'$D(C(U1))  D S2^cAN000(U1) D  D S3^cAN000(K)
 ... S U7=U2(16),K="" I U7>100,U7<(SW3+1*100) D
 .... S K=$P(P(U7\100),D,U7#100) I U7#100>$L(P(U7\100),D) S K="?"
 ... I $L(U2(17)) X U2(17)
 ... S:K="?" K=$P(B(U7\100),D,U7#100)
 ... I OK,$L(U2(11)) S OK=0,U1(0)=U1 I @U2(11) S OK=1
 ; gekoppelde modules
91 I $L(UQM),$L(USM) D
 . K REFRESH
 . S (I,OK)=0 F  S I=$O(^DMM(UQM,USM,I)) Q:I=""!OK  D
 .. I $D(^(I,UFU)) X ^(UFU,2) S OK=$T
 . I OK S SW2=SW2(0) D
 .. K C D S1^cAN000(SW2) S SW5=1
 .. W /WSCROFF F U1=1:1 Q:'$D(C(U1))  D S2^cAN000(U1) D  D S3^cAN000(K)
 ... S U7=U2(16),K="" I U7>100,U7<(SW3+1*100) S K=$P(B(U7\100),D,U7#100)
 ... I $L(U2(17)) X U2(17)
 .. F  D ^cAN001(UTX,22,UQM,USM,UFU,0,"","") Q:K="-"!(K=",")  X X I $G(REFRESH) D S1^cAN203
 I $G(REFRESH) D S1^cAN203
 ; einde openen
93 I $L($P(UXX,D,2)) X $P(UXX,D,2)
95 S K="-",SW1=0,U1="" G 41:'$G(UCONF)
 ;
YZ D C^cA612 Q
 ;
R0 S $P(R,D,12)=$T(+0) D ^cAN1000 Q  ; v12 23.01.95
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84