cI281 ;Opsporen mogelijke problemen ;%I28 ; [ 04/25/00  4:15 PM ]
 ;
T1 ;Kies eerst uw groep van programma's.;
T2 ;Daarna worden uit die groep alle programma's onderzocht.;
T3 ;Dit programma zoekt naar dubbele labels en naar:;
T4 ;/WT;/WB;$ZU;$zu;MGR;$ZDEV;$zdev;U 0:;u 0:;U $P:;u $p:;U $PR;u $pr; *13;,*13;ER1^cANP000;$ZA;$za;$ZB;$zb;$ZC;$zc;$ZO;$zo; B  ; b  ;.B  ;.b  ; #;,#;
T5 ;Aantal gevonden : ;
T6 ;Start <N>;
 ;
 ; init + uitleg
1 S Q=$G(Q) D ^cA604,MASTER^cQ5:'$D(boot)
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),!
14 s x=$t(T4)
15 f i=2:1 s j=$p(x,U,i) q:j=""  w:i>2 ", " w:$x>69 ! w """",j,""""
 ;
 ; vraagstelling
2 d ^cRSEL I '$L($O(^UTILITY($J,""))) G YZ
20 s dev=$i d CRT^cSDEV
21 w !,$p($t(T6),U,2) r k g 2:"-^"[k&$l(k) s k=$tr(k,"JjYy1","11110") g 21:k'=1
23 w ! i %DEV'=dev u %DEV
25 w !,$zu($ZV'["MSM"*5)," / " d ^cD w " / " d ^cT
 ;
 ; uitvoering
 ; a = aantal lijnen in programma
 ; i = loopvar.
 ; j = loopvar.
 ; l = lijn uit programma
 ; ll = label uit lijn l
 ; lbl(x) = tabel met labels
 ; p = naam programma in behandeling
 ; s = aantal geconverteerde programma's
 ; sw = switch programma geconverteerd (1=ja)
 ; t = totaal aantal geselecteerde programma's
 ; x = zoekcriteria
 ; y = criterium
 ; z = hulpvariabele
3 s $p(x,U)=""
31 w !! s (s,p,t)="" f  s p=$o(^UTILITY($j,p)) q:p=""  d
 . s t=t+1 i $t(+0)=p q
 . i %DEV'=dev u dev w "." u %DEV
 . i $e(p,1,5)="%A322" q
 . i $e(p,1,5)="%A323" q
 . i p="%A350" q
 . i p="%A612" q
 . i $e(p,1,3)="%A7" q
 . i $e(p,1,5)="%ABIE" q
 . i p="%AFA2" q
 . i p="%AFA6" q
 . i p="%ANP000" q
 . i p="%ACTJOB" q
 . i $e(p,1,4)="%API" q
 . i $e(p,1,2)="%C" q
 . i $e(p,1,2)="%D" q
 . i $e(p,1,2)="%E" q
 . i $e(p,1,3)="%FG" q
 . i $e(p,1,3)="%FL" q
 . i $e(p,1,2)="%G" q
 . i $e(p,1,3)="%HD" q
 . i $e(p,1,3)="%HE" q
 . i $e(p,1,3)="%HO" q
 . i $e(p,1,2)="%I" q
 . i $e(p,1,2)="%L" q
 . i p="%MCU" q
 . i p="%MDMP" q
 . i p="%MFUNC" q
 . i p="%MODESET" q
 . i p="%MSMOPS" q
 . i p="%MTCHK" q
 . i $e(p,1,2)="%N" q
 . i $e(p,1,2)="%O" q
 . i $e(p,1,3)="%PA" q
 . i $e(p,1,2)="%Q" q
 . i $e(p,1,2)="%R" q
 . i $e(p,1,2)="%S" q
 . i p="%T" q
 . i p="%TI" q
 . i p="%TO" q
 . i $e(p,1,6)="%TRANS" q
 . i $e(p,1,4)="%UTL" q
 . i $e(p,1,2)="%V" q
 . i $e(p,1,2)="%X" q
 . i $e(p,1,2)="%Z" q
 . i $e(p,1,3)="SQL" q                   ; geen SQL*    MSM
 . k ^HULP(boot,$J),lbl
 . 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)_"  " d
 .. s ll=$p(l," "),ll=$p(ll,"(")
 .. i $l(ll) d                           ; test op dubbele labels
 ... i '$d(lbl(ll)) s lbl(ll)=i q
 ... w !,p,": +",i," label """,ll,""" already exists on +",lbl(ll),!
 .. i $e($p(l," ",2))=";" q              ; geen commentaarlijnen
 .. i l["$ZV",l["""MSM""" q              ; programma reeds aangepast
 .. k z s swl=0 f j=2:1 s y=$p(x,U,j) q:y=""  i l[y d
 ... s z=$e(l,$f(l,y),999)
 ... i y="$ZU",$e(z,1,2)="(0" q
 ... i y="$zu",$e(z,1,2)="(0" q
 ... i y="$ZU",$e(z,1,4)="($ZV" q
 ... i y="$zu",$e(z,1,4)="($ZV" q
 ... s (sw,swl)=1,z($f(l,y)-$l(y)-1)=$l(y)
 .. i l[";",l'[" ;" d
 ... s z=0 d S1 i 'z q
 ... i $e(l,z-2)'=$c(34) s (sw,swl)=1,z(z-3)=2
 .. i swl s z="" d
 ... w !,p,": +",i,!,l,!
 ... f  s z=$o(z(z)) q:z=""  w ?z,$e("^^^^^^^^^^",1,z(z))
 ... i %DEV=dev r k:5
 . i sw s s=s+1
33 w !!,$p($t(T5),U,2),s," / ",t,!
35 i %DEV'=dev w # c %DEV
 ;
YZ w ! Q
 ;
 ; opsporen laatste ";" teken
S1 i $f(l,";",z)>z s z=$f(l,";",z) g S1
S1Z q
 ;
ZZ ; 30.06.00 - 16 u 02 * V7.4