cAN009 ;Controle indexen op integriteit ;%AN009 ; [ 01/11/01  12:22 PM ]
 ;
T0 ;Controle indexbestanden op integriteit ;
T2 ;Keuze\"[] = controle   P[] = printen vorige controles";
T3 ;Bevestiging\".[] = ok   ,[] = hernemen   P[] = printen";
 ;
T0F ;Contrôle des fichiers d'index sur l'intégrité ;
T2F ;Choix\"[] = contrôle   P[] = imprimer contrôles précédentes";
T3F ;Confirmation\".[] = ok   ,[] = reprendre   P[] = imprimer";
 ;
T0E ;Control integrity index files ;
T2E ;Choice\"[] = control   P[] = print previous controls";
T3E ;Confirmation\".[] = ok   ,[] = retry   P[] = print";
 ;
1 D P^cA612(2,1,20,80,1,1,0,0,$P($T(@("T0"_QT)),U,2),0,0,7,1,1)
 ;
11 S R="K\22\3\"_$P($T(@("T2"_QT)),U,2)_"\1\\""-Pp""[K" D R0 G YZ:K="-"
 I K="" G 2
 D ^cAN3223("","1#2#4") G 11:K="-"
 D ^cAN0091(Q) G 11
 ;
 ; keuze bestand
2 S Q1=$$^cANSYN("DMS","",$G(Q1),0,0,"","I $$O^cAN007(UI1)") I K="-" G YZ
21 D DMS^cAN000("UQC","USC",Q1)
23 S K=$P(^DMC(UQC,USC,"TAAL",$E(QT_"N")),D,2)
25 W /CUP(2,3),$$UC^cAFA1($E(K)),$E(K,2,99),/WCMD
27 S R="KEU\22\3\"_$P($T(@("T3"_QT)),U,2)_"\1\\""-,.P""[K&$L(K)",$P(R,D,11)=1 D R0
 I K="-"!(K=",") G 11
 D ^cAN3223("","1#2#4") G 27:K="-",28:KEU="P"
 D S2(Q,Q1,"",4)
28 D ^cAN0091(Q,Q1)
29 G 27
 ;
YZ D C^cA612 Q
 ;
R0 S $P(R,D,12)=$T(+0) D ^cAN1000 Q  ; v12 23.01.95
 ;
 ; logging begin per bestand
START S LOG="^DCIND(Q,DMS)" K @LOG D ^cA105,^cA106
 S @LOG@(0,0)=DT_D_TD_D_$G(QU)_D_$G(BI)_D_UQC_D_USC_D_UREF_D_IREF_D_IREF2_D
 Q
 ;
 ; logging einde per bestand
STOP D ^cA105,^cA106 S $P(@LOG@(0,0),D,10,11)=DT_D_TD
 Q
 ;
 ; vanuit back-ground
BG(TQ,BIS,DMS)         ; controle indexbestanden
 ; BIS = B-index, DMS = ^DMS(TQ,DMS (indien niet ingevuld : alle)
 S $ZT="^cA407"
 S Q=$P(TQ," ")
 D
 . N TQ,BIS,DMS
 . D ^cA604
 S QU=$G(QU,"DAM")
 I '$L($G(DMS)) D S1(TQ,$G(BIS),"")
 I $L($G(DMS)) D S2(TQ,DMS,$G(BIS),"")
 Q
 ;
S1(TQ,BIS,LN)      ; alle bestanden die actief zijn ^DMS
 ; TQ = Q-waardes gescheiden door " "
 ; BIS= bepaalde B-index
 ; LN = lijnnr : indien niet ingevuld wordt er niets getoond op scherm
 N DMS
S1A S DMS=""
 F  S DMS=$O(^DMS(Q,DMS)) Q:DMS=""  I '$P(^(DMS,0),D,30) D S2($P(TQ," "),DMS,$G(BIS),$G(LN))
 S TQ=$P(TQ," ",2,99) I $L($P(TQ," ")) G S1A
 Q
 ;
S2(Q,DMS,BIS,LN)   ; voor één bepaald bestand
 ; DMS= DMS van wat je wilt controleren
 ; BIS= bepaalde B-index
 ; LN = lijnnr : indien niet ingevuld wordt er niets getoond op scherm
 N UQC,USC,UREF,IREF,OK,I,LOG,IREF2
 D DMS^cAN000("UQC","USC",DMS,1) I '$L(UQC)!'$L(USC) G S2Z
 S UREF=$G(^DMC(UQC,USC,"DATA","REF")),IREF=$G(^("INDEX")),IREF2=$G(^("INDEX2"))
 I '$L(UREF)!('$L(IREF)&'$L(IREF2)) G S2Z
 S OK=1 F I=1:1 S J=$P($P($P(UREF,"(",$E(UREF)="@"+2),")"),",",I) Q:'$L(J)  I J'["""",J'="Q"&(J'="UI1") S OK=0 Q
 I 'OK G S2Z
 I '$G(BIS) D S1^cAN002(UQC,USC,$G(LN),1)          ; alle indexen
 I $G(BIS) D S2^cAN002(UQC,USC,$G(LN),BIS,"",1)    ; één B-index
 D S3
S2Z Q
 ;
S3 ; vanuit de INDEXEN naar DATA
 S S1=^DMC(UQC,USC,"DATA")
 S Q2="" I S1<3 S Q2=$G(^("DATA","OUD"))
 S SW3=1,I="" F  S I=$O(^DMC(UQC,USC,"INDEX",I)) Q:I=""  S J=^(I) D
 . S J=$P(J,D) I J\100>SW3 S SW3=J\100
 S I="" F  S I=$O(^DMC(UQC,USC,"INDEX2",I)) Q:I=""  S J=^(I) D
 . S J=$P(J,D) I J\100>SW3 S SW3=J\100
 S I="" F  S I=$O(^DMC(UQC,USC,"MULTI",I)) Q:I=""  S J=I D
 . F L=1:1 Q:'$D(^DMC(UQC,USC,"MULTI",I,L))  S J=^(L) I J\100>SW3 S SW3=J\100
S3A G S3B:'$L(Q2),S3B:$G(BIS)
 ; oude bestanden
 S S5=""
 F ATL=1:1 S S5=$O(@Q2@(S5)) Q:S5=""  D
 . S UI1=^(S5) I S1=2 S UI1=$P(S5," ",2,99)
 . D PRINT($TR($P(Q2,"_Q_",2),""")"))
 . D R I '$L(B(1)) S $P(@LOG@(UI1,$TR($P(Q2,"_Q_",2),""")")),D,3,4)=S5_D_"No data for UI1 = "_UI1 Q
 . I S1'=1,$P(B(1),D,30)=2 S $P(@LOG@(UI1,$TR($P(Q2,"_Q_",2),""")")),D,3,4)=S5_D_"Deleted : UI1 = "_UI1 Q
 . I S1=2 S S3=$P(B(1),D,2),S9=$$DI^cAN000(S3,UI1) I S9'=S5 S $P(@LOG@(UI1,$TR($P(Q2,"_Q_",2),""")")),D,3,4)=S5_D_S9
 . I S1=1,$P(B(1),D)'=S5 S $P(@LOG@(UI1,$TR($P(Q2,"_Q_",2),""")")),D,3,4)=S5_D_$P(B(1),D)
 ;
S3B ; indexen
 S S4="" F  S S4=$O(^DMC(UQC,USC,"INDEX",S4)) Q:S4=""  D
 . S S2=$P(^(S4),D),S0=$P(^(S4),D,2) I '$L(S2) Q
 . I $G(BIS),S2'=BIS Q
 . S S3=""
 . F ATL=1:1 S S3=$O(@IREF@(S2,S3)) Q:S3=""  D
 .. S UI1=^(S3)
 .. D PRINT(S2)
 .. D R I '$L(B(1)) S $P(@LOG@(UI1,S2),D,3,4)=S3_D_"No data for UI1 = "_UI1 Q
 .. I $P(B(1),D,30)=2 S $P(@LOG@(UI1,S2),D,3,4)=S3_D_"Deleted : UI1 = "_UI1 Q
 .. S S5=$S(S1<3:$P(B(1),D),1:UI1)
 .. S S9=$P($G(B(S2\100)),D,S2#100) I S0,S9="" S S9=$TR(S0,"12","0 ")
 .. S S9=$$DI^cAN000(S9,S5) I S9'=S3 S $P(@LOG@(UI1,S2),D,3,4)=S3_D_S9
 ;
S3C ; indexen (VJ-17.08.00)
 S S4="" F  S S4=$O(^DMC(UQC,USC,"INDEX2",S4)) Q:S4=""  D
 . S S2=$P(^(S4),D),S0=$P(^(S4),D,2) I '$L(S2) Q
 . I $G(BIS),S2'=BIS Q
 . S S3="",ATL=0
 . F  S S3=$O(@IREF2@(S2,S3)) Q:S3=""  D
 .. S SI=""
 .. F  S SI=$O(@IREF2@(S2,S3,SI)) Q:SI=""  D
 ... S UI1=SI,ATL=ATL+1 I S1<3 S UI1=^(SI)
 ... D PRINT(S2)
 ... D R I '$L(B(1)) S $P(@LOG@(UI1,S2_"/2"),D,3,4)=S3_D_"No data for UI1 = "_UI1 Q
 ... I $P(B(1),D,30)=2 S $P(@LOG@(UI1,S2_"/2"),D,3,4)=S3_D_"Deleted : UI1 = "_UI1 Q
 ... S S5=$S(S1<3:$P(B(1),D),1:UI1)
 ... S S9=$P($G(B(S2\100)),D,S2#100) I S0,S9="" S S9=$TR(S0,"12","0 ")
 ... S S9=$P($$DI^cAN000(S9,S5)," ") I S9'=S3 S $P(@LOG@(UI1,S2_"/2"),D,3,4)=S3_D_S9 Q
 ... I S5'=SI S $P(@LOG@(UI1,S2_"/2"),D,3,4)=SI_D_S5
 ;
S3D ; multiples
 S M4=0 F  S M4=$O(^DMC(UQC,USC,"MULTI",M4)) Q:M4=""  D
 . K MI M MI=^(M4) S MAX=$O(MI(""),-1),MW=0
 . I $G(BIS) S M=1 D  I M Q
 .. F I=1:1:MAX S BI=MI(I) I BI=BIS S M=0
 . S M5=$NA(@IREF@(M4)),M6=M5,M7=$L(M5,",")
 . F ATL=1:1 S M6=$ZO(@M6) Q:'$L(M6)  Q:$NA(@M6,M7)'=$NA(@M5,M7)  D
 .. S UI1=@M6
 .. D PRINT(M4)
 .. D R I '$L(B(1)) S $P(@LOG@(UI1,M4),D,3,4)=$P($P(M6,","""_M4_""",",2,99),")")_D_"No data for UI1 = "_UI1 Q
 .. I $P(B(1),D,30)=2 S $P(@LOG@(UI1,M4),D,3,4)=$P($P(M6,","""_M4_""",",2,99),")")_D_"Deleted : UI1 = "_UI1 Q
 .. K MID F I=1:1:MAX S BI=MI(I),MID(I)=$P($$DI^cAN000($P(B(BI\100),D,BI#100),"")," ")
 .. S MID(MAX)=MID(MAX)_" "_UI1,MREF=$NA(@IREF@(M4)) F I=1:1:MAX S MREF=$NA(@MREF@(MID(I)))
 .. I MREF'=M6 S $P(@LOG@(UI1,M4),D,3,4)=$P($P(M6,","""_M4_""",",2,99),")")_D_$P($P(MREF,","""_M4_""",",2,99),")")
S3Z Q
 ;
R N S1,S2,UREF S $ZT="TRAP^cAN000"
RA S S1=^DMC(UQC,USC,"DATA"),UREF=^("DATA","REF")
 K B
RB I S1<5 D
 . S B(1)=$G(@UREF@(0)) F S2=2:1:SW3 S B(S2)=$G(^(S2-1),$G(USL,D))
RC I S1=5 D
 . S B(1)=$G(@UREF)
RZ Q
 ;
PRINT(R) I '$G(LN) G PRINTZ
 I '(ATL#20) W /CUP(LN,3),R_" "_ATL,/EL(0) W /WDSP
PRINTZ Q
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84