cI33 ;Conversie ^HULP(boot,$J+xxx) ivm V7 ;%I33 ; [ 02/23/00  8:55 AM ]
 ;
T1 ;Kies eerst uw groep van programma's.;
T2 ;Daarna worden uit die groep alle programma's geconverteerd.;
T3 ;Dit programma zoekt naar :;
T4 ;$J+;$j+;+$J;+$j;
T5 ;Aantal geconverteerd : ;
T6 ;Start <N>;
T7 ;Ook ^DMC wordt geconverteerd + ^BCSTATSQ.;
 ;
 ; init + uitleg
1 S Q=$G(Q) D ^cA604
11 w !!,$P($T(+1),U,2),!!,$P($T(T1),U,2),!!
13 f i=2:1:3 w $p($t(@("T"_i)),U,2),!
15 f i=2:1 s j=$p($t(@("T"_4)),U,i) q:j=""  w:i>2 ", " w """",j,""""
17 w !!,$P($T(T7),U,2)
 ;
 ; vraagstelling
2 d ^cRSEL I '$L($O(^UTILITY($J,""))) G YZ
21 w !,$p($t(T6),U,2) r k g 2:"-^"[k&$l(k) s k=$tr(k,"JjYy1","11110") g 21:k'=1
 ;
 ; uitvoering
 ; a = aantal lijnen in programma
 ; e = karakter uit de lijn op verplaatsing v
 ; i = loopvar.
 ; j = loopvar.
 ; l = lijn uit programma
 ; p = naam programma in behandeling
 ; s = aantal geconverteerde programma's
 ; sw = switch programma geconverteerd (1=ja)
 ; swl= switch lijn geconverteerd (1=ja)
 ; t = totaal aantal geselecteerde programma's
 ; v = verplaatsing in de lijn
 ; w = waarde die bij $J wordt opgeteld
 ; x = zoekcriteria
 ; y = criterium
3 s x=$t(T4),$p(x,U)=""
31 w !! s (s,p,t)="" f  s p=$o(^UTILITY($j,p)) q:p=""  d
 . s t=t+1 w:$x>70 ! w "." i $t(+0)=p q
 . k ^HULP(boot,$J)
 . x "zl @p f i=1:1 s l=$t(+i) q:'$l(l)  s ^HULP(boot,$J,i)=l"
 . s a=i-1,sw=0                          ; aantal lijnen, switch af
 . f i=1:1:a s l=^HULP(boot,$J,i) i l["^HULP" d
 .. i l["%08" w !,@F92,p,@F93,!,$C(7) q
 .. s swl=0
 .. f j=2:1 s y=$p(x,U,j),v=2 q:y=""  i l[y d
 ... i $e(y)="$" d                       ; $J+
 .... f  q:$f(l,y,v)<2  d
 ..... s v=$f(l,y,v),w=""
 ..... f  s e=$e(l,v) q:e=","!(e=")")!(v=999)  s w=w_e,v=v+1
 ..... i v=999 q
 ..... i $e(w)=".",$e(w,2)?1n q          ; er staat reeds $J+.xx
 ..... i $e(w,$l(w)-5,$l(w))="/10000" q  ; reeds geconverteerd
 ..... s l=$e(l,1,v-$l(w)-1)_"("_w_"/10000)"_$e(l,v,999),swl=1
 ... i $e(y)'="$" d                      ; +$J
 .... f  q:$f(l,y,v)<2  d
 ..... s v=$f(l,y,v)-1-$l(y),w=""
 ..... f  s e=$e(l,v) q:e=","!(e="(")!(v=0)  s w=e_w,v=v-1
 ..... i v=0 s v=999 q
 ..... i $e(w)=".",$e(w,2)?1n q          ; er staat reeds $J+.xx
 ..... i $e(w,$l(w)-6,$l(w))="/10000)" s v=$f(l,y,v) q  ; reeds geconv.
 ..... s l=$e(l,1,v)_"("_w_"/10000)"_$e(l,v+$l(w)+1,999),swl=1
 ..... s v=$f(l,y,v)
 .. i swl s ^HULP(boot,$J,i)=l
 .. s sw=sw+swl
 . i sw d
 .. s s=s+1 w p
 .. s y="f i=1:1:a s l=^HULP(boot,$J,i) zi l"
 .. x "zr  x y zs @p"
 w !!,$p($t(T5),U,2),s," / ",t,!
 ;
 ; conversie ^DMC
4 s uqc="" f  s uqc=$o(^DMC(uqc)) q:uqc=""  d
 . s usc="" f  s usc=$o(^DMC(uqc,usc)) q:usc=""  d
 .. f i="REF","INDEX" s l=$G(^DMC(uqc,usc,"DATA",i)) i l["^HULP" d
 ... s swl=0
 ... f j=2:1 s y=$p(x,U,j),v=2 q:y=""  i l[y d
 .... i $e(y)="$" d                       ; $J+
 ..... f  q:$f(l,y,v)<2  d
 ...... s v=$f(l,y,v),w=""
 ...... f  s e=$e(l,v) q:e=","!(e=")")!(v=999)  s w=w_e,v=v+1
 ...... i v=999 q
 ...... i $e(w)=".",$e(w,2)?1n q          ; er staat reeds $J+.xx
 ...... i $e(w,$l(w)-5,$l(w))="/10000" q  ; reeds geconverteerd
 ...... s l=$e(l,1,v-$l(w)-1)_"("_w_"/10000)"_$e(l,v,999),swl=1
 .... i $e(y)'="$" d                      ; +$J
 ..... f  q:$f(l,y,v)<2  d
 ...... s v=$f(l,y,v)-1-$l(y),w=""
 ...... f  s e=$e(l,v) q:e=","!(e="(")!(v=0)  s w=e_w,v=v-1
 ...... i v=0 s v=999 q
 ...... i $e(w)=".",$e(w,2)?1n q          ; er staat reeds $J+.xx
 ...... i $e(w,$l(w)-6,$l(w))="/10000)" s v=$f(l,y,v) q  ; reeds geconv.
 ...... s l=$e(l,1,v)_"("_w_"/10000)"_$e(l,v+$l(w)+1,999),swl=1
 ...... s v=$f(l,y,v)
 ... i swl s ^DMC(uqc,usc,"DATA",i)=l w !,$zr
 ;
 ; conversie ^BCSTATSQ
5 s i1="" f  s i1=$o(^BCSTATSQ(i1)) q:i1=""  d
 . s i2="" f  s i2=$o(^BCSTATSQ(i1,i2)) q:i2=""  d
 .. s i3="" f  s i3=$o(^BCSTATSQ(i1,i2,i3)) q:i3=""  d
 ... i i3'["^HULP" q
 ... s swl=0,l=i3 w !,$na(^BCSTATSQ(i1,i2,i3),3)
 ... f j=2:1 s y=$p(x,U,j),v=2 q:y=""  i l[y d
 .... i $e(y)="$" d                       ; $J+
 ..... f  q:$f(l,y,v)<2  d
 ...... s v=$f(l,y,v),w=""
 ...... f  s e=$e(l,v) q:e=","!(e=")")!(v=999)  s w=w_e,v=v+1
 ...... i v=999 q
 ...... i $e(w)=".",$e(w,2)?1n q          ; er staat reeds $J+.xx
 ...... i $e(w,$l(w)-5,$l(w))="/10000" q  ; reeds geconverteerd
 ...... s l=$e(l,1,v-$l(w)-1)_"("_w_"/10000)"_$e(l,v,999),swl=1
 .... i $e(y)'="$" d                      ; +$J
 ..... f  q:$f(l,y,v)<2  d
 ...... s v=$f(l,y,v)-1-$l(y),w=""
 ...... f  s e=$e(l,v) q:e=","!(e="(")!(v=0)  s w=e_w,v=v-1
 ...... i v=0 s v=999 q
 ...... i $e(w)=".",$e(w,2)?1n q          ; er staat reeds $J+.xx
 ...... i $e(w,$l(w)-6,$l(w))="/10000)" s v=$f(l,y,v) q  ; reeds geconv.
 ...... s l=$e(l,1,v)_"("_w_"/10000)"_$e(l,v+$l(w)+1,999),swl=1
 ...... s v=$f(l,y,v)
 ... i swl m ^BCSTATSQ(i1,i2,l)=^BCSTATSQ(i1,i2,i3) w " -> ",$na(^BCSTATSQ(i1,i2,l),3) k ^BCSTATSQ(i1,i2,i3)
 ;
YZ w ! Q
 ;
ZZ ; 13.03.00 - 17 u 31 * V7.3