Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIKKUTL3

DIKKUTL3.m

Go to the documentation of this file.
  1. DIKKUTL3 ;SFISC/MKO-VERIFY KEY INTEGRITY ;3:10 PM 27 Oct 1998
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. VERIFY(DIKKEY,DIKKTOP,DIKKFILE) ;Verify key integrity
  1. N DIKKTEMP,POP,%ZIS
  1. ;
  1. ;Ask whether to save records in a template
  1. S DIKKTEMP=$$ASKTEMP(DIKKTOP)
  1. ;
  1. ;Select Device
  1. S %ZIS=$S($D(^%ZTSK):"Q",1:"")
  1. W ! D ^%ZIS Q:$G(POP)
  1. K %ZIS,POP
  1. ;
  1. ;Queue report
  1. I $D(IO("Q")) D Q
  1. . N I,ZTSK
  1. . S ZTRTN="MAIN^DIKKUTL3"
  1. . S ZTDESC="KEY INTEGRITY CHECK"
  1. . F I="DIKKEY","DIKKTOP","DIKKFILE","DIKKTEMP" S ZTSAVE(I)=""
  1. . D ^%ZTLOAD
  1. . I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_$G(ZTSK),!
  1. . E W !,"Report canceled!",!
  1. . S IOP="HOME" D ^%ZIS
  1. ;
  1. U IO
  1. ;
  1. MAIN ;Queued tasks enter here
  1. N DIKKHLIN,DIKKFIL,DIKKNAME,DIKKPAGE,DIKKTAB,DIKKUI,DIKKUIFL,DIKKUINM
  1. N DIKKIENS,DIKKFLD,DIKKFNAM,DIKKROOT,DIKKSUPP
  1. K ^TMP("DIKKUTL",$J)
  1. ;
  1. ;Check key integrity
  1. D INTEG^DIKK(DIKKTOP,"","",DIKKEY,"",1)
  1. I $D(DIERR) D MSG^DIALOG() Q
  1. ;
  1. ;Initialize "global" variables for report
  1. S DIKKPAGE=0
  1. S %H=$H D YX^%DTC
  1. S DIKKHLIN=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)_" PAGE "
  1. S DIKKTAB(1)=9,DIKKTAB(2)=41
  1. S DIKKNAME=$P($G(^DD("KEY",DIKKEY,0)),U,2)
  1. S DIKKUI=$P($G(^DD("KEY",DIKKEY,0)),U,4)
  1. S DIKKUINM=$P($G(^DD("IX",+DIKKUI,0)),U,2),DIKKUIFL=$P($G(^(0)),U)
  1. ;
  1. ;Print first header
  1. W:$E(IOST,1,2)="C-" @IOF
  1. D HDR
  1. I '$D(^TMP("DIKKTAR",$J)) W !!," ** NO PROBLEMS **" G END
  1. ;
  1. ;Loop through target error and list problems
  1. S DIKKFIL=0
  1. F S DIKKFIL=$O(^TMP("DIKKTAR",$J,DIKKFIL)) Q:'DIKKFIL!$D(DIRUT) D
  1. . D COLHDR
  1. . S DIKKROOT=$$FROOTDA^DIKCU(DIKKFIL)
  1. . S DIKKIENS=" "
  1. . F S DIKKIENS=$O(^TMP("DIKKTAR",$J,DIKKFIL,DIKKIENS)) Q:DIKKIENS=""!$D(DIRUT) D
  1. .. D:$D(^TMP("DIKKTAR",$J,DIKKFIL,DIKKIENS,"K",DIKKEY)) KEYERR(DIKKFIL,DIKKIENS,DIKKEY,DIKKROOT)
  1. .. S (DIKKSUPP,DIKKFLD)=0
  1. .. F S DIKKFLD=$O(^TMP("DIKKTAR",$J,DIKKFIL,DIKKIENS,DIKKFLD)) Q:'DIKKFLD!$D(DIRUT) D FLDERR(DIKKFIL,DIKKIENS,DIKKFLD,DIKKROOT,.DIKKSUPP)
  1. .. Q:$D(DIRUT)
  1. .. D W()
  1. ;
  1. END D:'$D(DIRUT) EOPREAD
  1. ;
  1. ;Save in template, cleanup, and quit
  1. D:$G(DIKKTEMP) SAVETEMP(DIKKTEMP)
  1. K ^TMP("DIKKTAR",$J)
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. E X $G(^%ZIS("C"))
  1. Q
  1. ;
  1. KEYERR(RFIL,IENS,KEY,ROOT) ;
  1. D WRREC(RFIL,IENS,DIKKTAB(1),.ROOT) Q:$D(DIRUT)
  1. W ?DIKKTAB(2),"Duplicate Key "_$P($G(^DD("KEY",KEY,0)),U,2)_" (#"_KEY_")"
  1. Q
  1. ;
  1. FLDERR(FIL,IENS,FLD,ROOT,SUPP) ;
  1. I '$G(SUPP) D Q:$D(DIRUT)
  1. . D WRREC(FIL,IENS,DIKKTAB(1),.ROOT) Q:$D(DIRUT)
  1. . W ?DIKKTAB(2),"Missing Key Field(s):"
  1. D W($P($G(^DD(FIL,FLD,0)),U)_" ["_FIL_","_FLD_"]",DIKKTAB(2)+1)
  1. S SUPP=1
  1. Q
  1. ;
  1. WRREC(FILE,IENS,TAB,ROOT) ;Write the record info
  1. N DA,DIERR,ENAM,MSG
  1. S:$G(ROOT)="" ROOT=$$FROOTDA^DIKCU(FILE)
  1. D DA(IENS,.DA) Q:$D(DIRUT)
  1. S ENAM=$P($G(@ROOT@(DA,0)),U)
  1. S:ENAM]"" ENAM=$$EXTERNAL^DILFD(FILE,.01,"",ENAM,"MSG")
  1. W ?TAB,$S(ENAM]"":ENAM,1:"Unknown record name")
  1. Q
  1. ;
  1. W(STR,TAB,KWN) ;Write STR
  1. I $Y+3+$G(KWN)'<IOSL D Q:$D(DIRUT)
  1. . D EOP Q:$D(DIRUT)
  1. . D HDR,COLHDR
  1. W !?+$G(TAB),$G(STR)
  1. Q
  1. ;
  1. EOP ;Check whether task should be stopped
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DIRUT)=1 Q
  1. D EOPREAD Q:$D(DIRUT)
  1. W @IOF
  1. Q
  1. ;
  1. EOPREAD ;
  1. Q:$E(IOST,1,2)'="C-"!$D(ZTQUEUED)
  1. N DIR,DIROUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="E" W ! D ^DIR
  1. Q
  1. ;
  1. HDR ;Write page header
  1. S DIKKPAGE=$G(DIKKPAGE)+1
  1. S $X=0 W "KEY INTEGRITY CHECK"
  1. W ?(IOM-$L(DIKKHLIN)-$L(DIKKPAGE)-1),DIKKHLIN_DIKKPAGE
  1. W !,$TR($J("",IOM-1)," ","-")
  1. W !," Key: "_DIKKNAME_" (#"_DIKKEY_"), File #"_DIKKFILE
  1. W !,"Uniqueness Index: "_DIKKUINM_" (#"_DIKKUI_")"
  1. W:DIKKFILE'=DIKKUIFL ", Whole File #"_DIKKUIFL
  1. Q
  1. ;
  1. COLHDR ;Write column headers
  1. N FNAM
  1. S FNAM=$P($G(^DD(DIKKFIL,.01,0)),U)
  1. D W() Q:$D(DIRUT)
  1. D W("ENTRY #","",2) Q:$D(DIRUT) W ?DIKKTAB(1),FNAM,?DIKKTAB(2),"ERROR"
  1. W !,"-------",?DIKKTAB(1),$TR($J("",$L(FNAM))," ","-"),?DIKKTAB(2),"-----"
  1. Q
  1. ;
  1. ASKTEMP(DIKKTOP) ;Ask for a template name
  1. N DDA,DIC,DICKL,DIR,DIROUT,DIRUT,DIU0,DK,DQ,DTOUT,DUOUT
  1. N C,D,D1,D1,D2,D3,D4,I,J,L,O,X,Y
  1. ;
  1. S DK=DIKKTOP
  1. D S2^DIBT1 Q:Y<0!$D(DIRUT) ""
  1. Q +Y
  1. ;
  1. SAVETEMP(Y) ;Save records in template Y
  1. N CNT,DK,FILE,FLD,IENS,REC
  1. S (CNT,FILE)=0 F S FILE=$O(^TMP("DIKKTAR",$J,FILE)) Q:'FILE D
  1. . S IENS="" F S IENS=$O(^TMP("DIKKTAR",$J,FILE,IENS)) Q:IENS="" D
  1. .. S REC=$P(IENS,",",$L(IENS,",")-1)
  1. .. S:$D(^DIBT(+Y,1,REC))[0 CNT=CNT+1,^DIBT(+Y,1,REC)=""
  1. S:CNT>0 ^DIBT(+Y,"QR")=DT_U_CNT
  1. Q
  1. ;
  1. DA(IENS,DA) ;Given IENS, write ien's and setup DA array
  1. N I
  1. D W("","",$L(IENS,",")-2) Q:$D(DIRUT)
  1. K DA
  1. F I=$L(IENS,",")-1:-1:2 S DA(I-1)=$P(IENS,",",I) W DA(I-1),!
  1. S DA=$P(IENS,",") W DA
  1. Q
  1. ;