cI37 ;Hernummeren verkoopfacturen ;%I37 ; [ 08/05/96  5:21 PM ]
 ;
 ; Q-waarde + initialisatie
1 S Q=$G(Q) D ^cA604
11 w !!,$P($T(+1),U,2),!
13 w !,"Q-waarde <",Q,">" r k g 13:k=""&(Q=""),YZ:k="-"!(k="^") i $l(k) g 13:k'?1.3u s Q=k
15 d ^cA604 w !!,Q," : ",QN,!
17 w !,"Ok <N>" r k s k=$tr($e(k),"JjYy1","11110") i k'=1 g YZ
19 s H1=$t(+0)
 ;
 ; Schermopbouw
2 w @F11,@F1 s FP=202 w @F,@F4,$p($t(+1),U,2),QN," ",@F5,@F1
20 l ^HULP(H1):2 e  g YZ
21 s FP=401 w @F,"  Oud nr | Nw nr.  Voltooid op     US  BP       Gb.rek.  Klant"
22 w !,"  ------ + ------  --------------  --  -------  -------  --------------------"
23 s I3=0
25 s FP=601 w @F,@F1 s SWV=0
27 f  s I3=$o(^HULP(H1,Q,I3)) q:I3=""  d  q:FP>2000
 . w @F,$j(I3,8)," | "
 . s n=^(I3)
 . w $j($p(n,D),6),"  "
 . w $e($p(n,D,2)_$j("",8),1,8)," ",$e($p(n,D,3)_$j("",5),1,5),"  "
 . w $e($p(n,D,4)_$j("",4),1,4)
 . w $e($p(n,D,5)_$j("",9),1,9)
 . w $e($p($p(n,D,6)," ")_$j("",9),1,9)
 . w $e($tr($p(n,D,7,8),D," "),1,20)
 . s FP=FP+100
29 i $l(I3),$l($o(^(I3))) s SWV=1
 ;
 ; Keuzevraag
3 s R="K\22\3\Keuze\C1\6\",$p(R,D,11)=1 d R0 g YZ:K="-",23:K="D",YZ:K="P"
30 i K="." d ^cI370 g 2
31 i K="" g 3:'SWV s I3=I3-1 g 25
33 g 3:K<100000!(K>989999) s FNR=K,FP=2203 w @F,"Oud nr : ",FNR,@F1
35 g 4:'$d(^HULP(H1,Q,FNR))
37 s R="K\23\3\Bevestiging\""V[] = verwijderen""\1",$p(R,D,11)=1 d R0 i K="V" k ^HULP(H1,Q,FNR) g 23
39 g 3
 ;
 ; Nieuw nummer
4 s R="K\23\3\Nieuw nummer\\6" d R0
41 i K>99999,K<990000,K'=FNR s ^HULP(H1,Q,FNR)=K g 23
43 g 3
 ;
YZ w ! Q
 ;
 ; commentaar
C1 w !?2,"D[] = detail   P[] = printen   xxxxxx[] = oud nr ingeven" i SWV w "   [] = vervolg"
C1A w !?2,".[] = opstarten hernummering"
C1Z q
 ;
R0 S R0=$P(R,D,5) I $L(R0),R0'["""" S $P(R,D,5)=R0_"^"_$T(+0)
R0A S R0=$P(R,D,7) I $L(R0),R0'="DCTR" S $P(R,D,7)="",R1=$P(R,D,8),R0=$P($T(@R0),U,2,99) S:$L(R1) R0=R0_"&("_R1_")" S $P(R,D,8)=R0
R0Z S $P(R,D,12)=$T(+0) K R0,R1 D ^cA100 Q  ; v11 30.05.94
 ;
ZZ ; 19.09.96 - 13 u 49 * V6.2.05