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

DDS41.m

Go to the documentation of this file. 
  1. DDS41 ;SFISC/MKO-VERIFY DATA ;21SEP2006
  1.  ;;22.0;VA FileMan;**8,151**;Mar 30, 1999;Build 10
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  N DDO,DIERR
  1.  N DDS4B,DDS4DA,DDS4DONE,DDS4ERR,DDS4FLD,DDS4OUT,DDS4PG,DDS4PG1,DDS4TP
  1.  N DDSCAP,DDSERROR,DDSFDA,DDSI,DDSKEY,DDSPID,DDSREQ
  1.  ;
  1.  S DDS4OUT=$NA(@DDSREFT@("VALMSG"))
  1.  S DDS4PG=DDSPG
  1.  ;
  1.  K @DDS4OUT,@DDSREFT@("MSG"),@DDSREFT@("KMSG")
  1.  ;
  1.  I $G(DDSPTB)_$G(DDSREP)]"" N DIE,DDP,DDSDA,DA,DDSDL D
  1.  . S DA=DDSDAORG,DDSDL=DDSDLORG,DDSDA=DA_","
  1.  . F DDSI=1:1:DDSDL S DA(DDSI)=DDSDAORG(DDSI),DDSDA=DDSDA_DA(DDSI)_","
  1.  . S DDP=$P($G(DDSFLORG),U),DIE=U_$P($G(DDSFLORG),U,2) S:DIE=U DIE=""
  1.  ;
  1.  D LDALL
  1.  I $G(DIERR) D  G END
  1.  . N P
  1.  . S P(1)=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U),P(2)=$P($G(^(1)),U)
  1.  . S:P(2)="" P(2)="unnamed"
  1.  . D BLD^DIALOG(3041,.P),ERR^DDSMSG ;PAGE COULD NOT BE LOADED
  1.  . S DDS4ERR=1
  1.  ;
  1.  D LP
  1.  ;
  1.  ;Validate keys
  1.  S DDSKEY=1
  1.  I $D(DDSFDA) D
  1.  . S DDSKEY=$$KEYVAL^DIE("","DDSFDA",$NA(@DDSREFT@("KMSG")))
  1.  . I 'DDSKEY,$D(DDS4ERR)[0 S DDS4ERR=1 D BLD^DIALOG(3091,"","",DDS4OUT,"S")
  1.  ;
  1.  S DDSPG=DDS4PG
  1.  I '$G(DDS4ERR),$G(^DIST(.403,+DDS,20))'?."^" X ^(20)
  1.  I $G(@DDSREFT@("MSG"))>0!$G(DDS4ERR)!'DDSKEY D PRNT
  1.  ;
  1. END S Y='$D(DDSERROR)&'$G(DDS4ERR)&$G(DDSKEY)
  1.  K @DDS4OUT,@DDSREFT@("MSG"),@DDSREFT@("KMSG")
  1.  Q
  1.  ;
  1. LDALL ;Load all pages
  1.  S DX=0,DY=IOSL-1 X IOXY
  1.  W "Please wait.  Loading all pages ..."_$P(DDGLCLR,DDGLDEL)
  1.  S (DDSPG,DDS4PG1)=$O(^DIST(.403,+DDS,40,"B",$S($G(DDSPAGE)]"":DDSPAGE,1:1),""))
  1.  S Y=1
  1.  F  D ^DDS1(DDSPG) Q:$G(DIERR)  S DDSPG=$$NP^DDS5(.Y) Q:DDSPG=DDS4PG1!'Y
  1.  Q
  1.  ;
  1. LP ;Loop through all pages/blocks
  1.  N DDP
  1.  S DX=0,DY=IOSL-1 X IOXY
  1.  W "Verifying ..."_$P(DDGLCLR,DDGLDEL)
  1.  ;
  1.  S DDSPG=0 F  S DDSPG=$O(@DDSREFT@(DDSPG)) Q:'DDSPG  D
  1.  . S DDS4B=0 F  S DDS4B=$O(@DDSREFT@(DDSPG,DDS4B)) Q:'DDS4B  D
  1.  .. Q:$D(DDS4DONE(DDS4B))  Q:$P(@DDSREFS@(DDSPG,DDS4B),U,5)'="e"
  1.  .. S DDSPID=$S($P($G(^DIST(.403,+DDS,40,DDSPG,1)),U)]"":$P(^(1),U),1:"Page "_$P(^(0),U))
  1.  .. S DDS4DONE(DDS4B)="",DDP=$P(^DIST(.404,DDS4B,0),U,2)
  1.  .. S DDO=0 F  S DDO=$O(^DIST(.404,DDS4B,40,DDO)) Q:'DDO  D VF
  1.  Q
  1.  ;
  1. VF ;Check required and key fields
  1.  Q:$D(^DIST(.404,DDS4B,40,DDO,0))[0  S DDS4TP=$P(^(0),U,3)
  1.  Q:DDS4TP=1  Q:DDS4TP=4
  1.  S DDSCAP=$P(^DIST(.404,DDS4B,40,DDO,0),U,2)_$S($P(^(0),U,4)]"":" ("_$P(^(0),U,4)_")",1:"")
  1.  S DDSREQ=$P($G(^DIST(.404,DDS4B,40,DDO,4)),U)
  1.  S DDSKEY=0
  1.  ;
  1.  I DDS4TP=2 N DDP D
  1.  . S DDP=0,DDS4FLD=DDO_","_DDS4B
  1.  . S:DDSCAP="" DDSCAP=$P(^DIST(.404,DDS4B,40,DDO,0),U,5)
  1.  ;
  1.  E  D  Q:DDS4FLD'=+$P(DDS4FLD,"E")
  1.  . S DDS4FLD=$G(^DIST(.404,DDS4B,40,DDO,1))
  1.  . I $G(^DD(DDP,DDS4FLD,0))?."^" S DDS4FLD="" Q
  1.  . S:DDSCAP="" DDSCAP=$S($G(^DD(DDP,DDS4FLD,.1))]"":^(.1),1:$P(^(0),U))
  1.  . S:DDSREQ="" DDSREQ=$P(^DD(DDP,DDS4FLD,0),U,2)["R"
  1.  . S DDSKEY=$D(^DD("KEY","F",DDP,DDS4FLD))>0
  1.  ;
  1.  S DDS4DA=" "
  1.  F  S DDS4DA=$O(@DDSREFT@(DDSPG,DDS4B,DDS4DA)) Q:DDS4DA=""  D
  1.  . I $P(@DDSREFT@(DDSPG,DDS4B,DDS4DA),U,6)<2 D VR Q
  1.  . ;
  1.  . N DDS4PDA S DDS4PDA=DDS4DA N DDS4DA
  1.  . S DDS4DA=""
  1.  . F  S DDS4DA=$O(@DDSREFT@(DDSPG,DDS4B,DDS4PDA,"B",DDS4DA)) Q:'DDS4DA  D VR
  1.  Q
  1.  ;
  1. VR ;Check individual records
  1.  I $P($G(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"A")),U)]"" N DDSREQ S DDSREQ=$P(^("A"),U)
  1.  I 'DDSREQ,'DDSKEY Q
  1.  ;
  1.  ;Required WP fields (quit if mult)
  1.  I DDP,$D(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"M")) D:'^("M")  Q
  1.  . N DDS4I,DDS4REF,DDS4VAL
  1.  . I $G(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"F")) S DDS4REF=$NA(^("D"))
  1.  . E  S DDS4REF=$P(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"M"),U,2),DDS4REF=U_$E(DDS4REF,1,$L(DDS4REF)-1)_")"
  1.  . S (DDS4VAL,DDS4I)=0
  1.  . F  S DDS4I=$O(@DDS4REF@(DDS4I)) Q:'DDS4I  I $G(@DDS4REF@(DDS4I,0))'?." " S DDS4VAL=1 Q
  1.  . D:'DDS4VAL LDERR
  1.  ;
  1.  I $G(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"D"))="" D LDERR Q
  1.  ;
  1.  I DDSKEY,$D(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"F")) S DDSFDA(DDP,DDS4DA,DDS4FLD)=$G(^("D"))
  1.  Q
  1.  ;
  1. LDERR ;Call ^DIALOG to load error
  1.  N P
  1.  I $D(DDS4ERR)[0 S DDS4ERR=1 D BLD^DIALOG(3091,"","",DDS4OUT,"S")
  1.  S P(1)=DDSPID,P(2)=DDSCAP,P(3)=""
  1.  I $L(DDS4DA,",")>2 D
  1.  . N Y,C
  1.  . S P(3)=$P(@(@DDSREFT@(DDSPG,DDS4B,$G(DDS4PDA,DDS4DA),"GL")_+DDS4DA_",0)"),U)
  1.  . Q:P(3)=""
  1.  . S Y=P(3),C=$P(^DD(DDP,.01,0),U,2) D Y^DIQ S P(3)=Y
  1.  . S P(3)="(Subrecord: "_P(3)_")"
  1.  D BLD^DIALOG(3092,.P,"",DDS4OUT,"S")
  1.  Q
  1.  ;
  1. PRNT ;Print messages
  1.  N DDSABT
  1.  S (DDSABT,DX,DY)=0 X IOXY
  1.  W $P(DDGLCLR,DDGLDEL,2)
  1.  S $X=0,$Y=0
  1.  ;
  1.  ;Print required field messages
  1.  I $G(DDS4ERR) S DDSI=0 F  S DDSI=$O(@DDS4OUT@(DDSI)) Q:'DDSI  D  Q:DDSABT
  1.  . D:$G(@DDS4OUT@(DDSI))]"" WLIN(^(DDSI))
  1.  ;
  1.  ;Print duplicate key messages
  1.  S DDSI=0 F  S DDSI=$O(@DDSREFT@("KMSG","DIERR",DDSI)) Q:'DDSI  D  Q:DDSABT
  1.  . D WLIN(" "),WLIN(@DDSREFT@("KMSG","DIERR",DDSI,"TEXT",1))
  1.  . Q:@DDSREFT@("KMSG","DIERR",DDSI)'=740
  1.  . ;
  1.  . N DA,FIL,FILE,FLD,FLDS,FNAME,IENS,J,KEY,LEV,RNAME
  1.  . S FILE=@DDSREFT@("KMSG","DIERR",DDSI,"PARAM","FILE"),IENS=$G(^("IENS")),KEY=$G(^("KEY"))
  1.  . D FRNAME^DIKCU1(FILE,IENS,.FNAME,.RNAME,.LEV)
  1.  . ;
  1.  . I LEV D
  1.  .. S FNAME=$J("",7)_"Subfile: "_FNAME D WLIN(.FNAME,16)
  1.  .. S RNAME=$J("",8)_"Record: "_RNAME D WLIN(.RNAME,16)
  1.  . ;
  1.  . S FLDS="",J=0 F  S J=$O(^DD("KEY",KEY,2,J)) Q:'J  D
  1.  .. Q:'$D(^DD("KEY",KEY,2,J,0))  S FLD=$P(^(0),U),FIL=$P(^(0),U,2)
  1.  .. Q:'$D(^DD(FIL,FLD,0))  S FLDS=FLDS_$P(^(0),U)_" (#"_FLD_"), "
  1.  . D:FLDS]"" WLIN("  Key Field(s): "_$E(FLDS,1,$L(FLDS)-2),16)
  1.  ;
  1.  ;Print developer messages
  1.  S DDSI=0 F  S DDSI=$O(@DDSREFT@("MSG",DDSI)) Q:'DDSI  D  Q:DDSABT
  1.  . D:@DDSREFT@("MSG",DDSI)]"" WLIN(^(DDSI))
  1.  ;
  1.  D EOP
  1.  Q
  1.  ;
  1. WLIN(DDSX,DDSINDNT) ;Write a single line, wrap at word boundaries
  1.  N I
  1.  D WRAP^DIKCU2(.DDSX,IOM-1-$G(DDSINDNT),IOM-1)
  1.  S DDSX(0)=DDSX
  1.  F I=0:1 Q:'$D(DDSX(I))  D  Q:DDSABT
  1.  . I $Y+4>IOSL D EOP I 'Y S DDSABT=1 Q
  1.  . W !,$J("",$S(I:$G(DDSINDNT),1:0))_DDSX(I)
  1.  Q
  1. EOP ;Issue EOP prompt
  1.  N X
  1.  S DX=0,DY=IOSL-1 X IOXY
  1.  R "Press RETURN to continue: ",X:DTIME
  1.  S Y=X'[U&$T
  1.  I Y S (DX,DY)=0 X IOXY W $P(DDGLCLR,DDGLDEL,2) S $X=0,$Y=0
  1.  Q