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

DICA1.m

Go to the documentation of this file. 
  1. DICA1 ;SEA/TOAD-VA FileMan: Updater, Pre-Processor ;11:46 AM  11 May 1999 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**1**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. CHECK(DIFLAGS,DIFDA,DINUMS,DIRULE,DIOK) ;
  1.  ; ENTRY POINT--check out the FDA
  1.  ; subroutine, DIFLAGS passed by value
  1.  N DIC,DIEN,DIFILE,DIFLD,DIN,DINODE,DINT,DINUM,DIOP
  1.  N DIOUT1,DIOUT2,DIOUT3,DIRID,DIRIGHT,DISEQ,DITYPE,DIVAL
  1.  N DIKEYEX
  1. FILES ;
  1.  S DIFILE=0,DIOUT1=0 F  D  Q:DIOUT1!$G(DIERR)
  1.  . S DIFILE=$O(@DIFDA@(DIFILE))
  1.  . I 'DIFILE S DIOUT1=1 Q
  1.  . S DINODE=$G(^DD(DIFILE,.01,0))
  1.  . I DINODE="" D  Q
  1.  . . D ERR^DICA3($S('$D(^DD(DIFILE)):401,1:406),DIFILE)
  1.  . I $P(DINODE,U,2)["W" D  Q
  1.  . . D ERR^DICA3(407,DIFILE)
  1.  . S DIRID=$$RID^DICU(DIFILE)
  1.  . ;
  1.  . ;If we're using primary keys for lookup, get key info
  1.  . S DIKEYEX=$D(^DD("KEY","F",DIFILE))
  1.  . I $G(DIFLAGS)["K",DIKEYEX D GETPKEY^DIEVK1(DIFILE)
  1.  . ;
  1. IENS . ;
  1.  . S DIEN="",DIOUT2=0 F  D  Q:DIOUT2!$G(DIERR)
  1.  . . S DIEN=$O(@DIFDA@(DIFILE,DIEN))
  1.  . . I DIEN="" S DIOUT2=1 Q
  1.  . . N DIDA D IEN^DICA2(.DIFILE,DIEN,.DIDA,DIRULE,.DIOK) Q:$G(DIERR)
  1.  . . I 'DIOK S DIOUT1=1,DIOUT2=1 D  Q
  1.  . . . I $E(DIEN,$L(DIEN))'="," D ERR^DICA3(304,"",DIEN) Q
  1.  . . . D ERR^DICA3(202,"","","","IENS")
  1.  . . Q:'$$RID(DIFILE,DIEN,DIFDA,DIRID,DIFLAGS,DIKEYEX)
  1.  . . I $D(@DIFDA@(DIFILE,DIEN,.001))#2 D
  1.  . . . N DIENS S DIENS=@DIFDA@(DIFILE,DIEN,.001)
  1.  . . . I $D(@DINUMS@(@DIRULE@("NUM")))[0 D
  1.  . . . . S @DINUMS@(@DIRULE@("NUM"))=DIENS
  1.  . . . S @DIRULE@("SAVE",$J,DIFILE,DIEN,.001)=DIENS
  1.  . . . K @DIFDA@(DIFILE,DIEN,.001)
  1. VALUES . . ;
  1.  . . I DIFLAGS'["E",$G(DIFLAGS)["U"!'DIKEYEX Q
  1.  . . S DIFLD="",DIOUT3=0 F  D  Q:DIOUT3!$G(DIERR)
  1.  . . . S DIFLD=$O(@DIFDA@(DIFILE,DIEN,DIFLD))
  1.  . . . I DIFLD="" S DIOUT3=1 Q
  1.  . . . I $G(DIFLAGS)'["U",DIKEYEX D BLDFLD^DIEVK1(DIFILE,DIEN,DIFLD) Q:DIFLAGS'["E"
  1.  . . . I $E(DIEN)="?",$E(DIEN,2)'="+" Q:DIFLD=.01&(DIFLAGS'["K")  I DIFLAGS["K",$D(^TMP("DIKK",$J,"P",DIFILE,DIFILE,DIFLD))#2 Q
  1.  . . . S DIVAL=$G(@DIFDA@(DIFILE,DIEN,DIFLD))
  1.  . . . D DTYP^DIOU(DIFILE,DIFLD,.DITYPE)
  1.  . . . I DITYPE=5 S DINT=DIVAL
  1. CONVERT . . . ;
  1.  . . . I DITYPE'=5 D  Q:$G(DIERR)
  1.  . . . . I DIEN["?"!(DIEN["+") D  Q:$G(DIERR)
  1.  . . . . . I "@"[DIVAL D  Q
  1.  . . . . . . I DIEN["?",$P($G(^DD(DIFILE,DIFLD,0)),U,2)["R" D  Q
  1.  . . . . . . . D ERR712(DIFILE,DIFLD)
  1.  . . . . . . S DINT=DIVAL
  1.  . . . . . I DIFLAGS["K",$E(DIEN)'="+",$P($G(^DD(DIFILE,DIFLD,0)),U,5,999)["DINUM",$D(^TMP("DIKK",$J,"P",DIFILE)),$D(^(DIFILE,DIFLD))[0 D  Q
  1.  . . . . . . D ERR^DICA3(520,DIFILE,"",DIFLD,"DINUMed")
  1.  . . . . . N DA M DA=DIDA
  1.  . . . . . N DIARG S DIARG="D0"
  1.  . . . . . N DIMAX S DIMAX=$O(DA(""),-1)
  1.  . . . . . N DIVAR F DIVAR=1:1:DIMAX S DIARG=DIARG_",D"_DIVAR
  1.  . . . . . N @DIARG F DIVAR=0:1:DIMAX-1 S @("D"_DIVAR)=DA(DIMAX-DIVAR)
  1.  . . . . . S:DIMAX @("D"_DIMAX)=DA
  1.  . . . . . N DIDA D CHK^DIE(DIFILE,DIFLD,"N",DIVAL,.DINT)
  1.  . . . . E  D  Q:$G(DIERR)
  1.  . . . . . N DIVALFLG S DIVALFLG="RU"_$E("Y",DIFLAGS["Y")
  1.  . . . . . D VAL^DIE(DIFILE,DIEN,DIFLD,DIVALFLG,DIVAL,.DINT)
  1.  . . . . Q:$D(DINUM)[0
  1.  . . . . S @DINUMS@(@DIRULE@("NUM"))=DINUM K DINUM
  1.  . . . S @DIRULE@("FDA",DIFILE,DIEN,DIFLD)=DINT
  1. CLEANUP ;
  1.  I $G(DIERR)!'DIOK K @DIRULE Q
  1.  K @DIRULE@("L"),@DIRULE@("NUM"),@DIRULE@("OP"),@DIRULE@("ROOT")
  1.  K @DIRULE@("SEQ"),@DIRULE@("TEMP"),@DIRULE@("UP")
  1.  S DIN=$NA(@DIRULE@("ORDER")),DIC=0,@DIRULE@("THE END")=""
  1.  F  S DIN=$Q(@DIN) Q:DIN=""!($P(DIN,",",3)'="""ORDER""")  D
  1.  . S DIC=DIC+1,@DIRULE@("NEXT",DIC)=@DIN
  1.  K @DIRULE@("ORDER"),@DIRULE@("THE END")
  1.  I DIFLAGS["E" S DIFDA=$NA(@DIRULE@("FDA"))
  1.  Q
  1.  ;
  1. RID(DIFILE,DIEN,DIFDA,DIRID,DIFLAGS,DIKEYEX) ;
  1.  N DIC,DIK,DIOK,DIP,DIR
  1.  ;
  1.  ;Check required ids
  1.  S DIP=$P(DIEN,","),DIOK=1
  1.  F DIC=1:1 S DIR=$P(DIRID,U,DIC) Q:DIR=""  D
  1.  . I DIR=.01 D
  1.  . . I DIP'?1P.E
  1.  . . E  I DIP["+" D:"@"[$G(@DIFDA@(DIFILE,DIEN,.01))
  1.  . . . S DIOK=0 D ERR^DICA3(352,DIFILE,DIEN)
  1.  . . E  I DIFLAGS'["K" D:"@"[$G(@DIFDA@(DIFILE,DIEN,.01))
  1.  . . . S DIOK=0 D ERR^DICA3(351,DIFILE,DIEN)
  1.  . E  I DIP["+" D:"@"[$G(@DIFDA@(DIFILE,DIEN,DIR))
  1.  . . S DIOK=0 D ERR^DICA3(311,DIFILE,DIEN,DIR)
  1.  . E  D:"@"[$G(@DIFDA@(DIFILE,DIEN,DIR),0)
  1.  . . S DIOK=0 D ERR712(DIFILE,DIR)
  1.  ;
  1.  ;Check that the FDA contains the appropriate key fields
  1.  Q:'$G(DIKEYEX,1) DIOK
  1.  ;
  1.  ;If appropriate, ensure all primary and secondary keys are provided
  1.  I DIFLAGS'["U",DIP["+" D
  1.  . S DIR=0 F  S DIR=$O(^DD("KEY","F",DIFILE,DIR)) Q:'DIR  D
  1.  . . D:"@"[$G(@DIFDA@(DIFILE,DIEN,DIR))
  1.  . . . S DIK=0 F  S DIK=$O(^DD("KEY","F",DIFILE,DIR,DIK)) Q:'DIK  D
  1.  . . . . S DIOK=0 D ERR744^DIEVK1(DIFILE,DIR,DIK,DIEN)
  1.  ;
  1.  ;If appropriate, ensure at least one key field is provided
  1.  E  I $G(DIFLAGS)["K",$E(DIEN)="?",$E(DIEN,2)'="+"!($G(DIFLAGS)["U") D
  1.  . S:'$$KFLD^DIEVK1(DIFILE,DIEN,DIFDA) DIOK=0
  1.  Q DIOK
  1.  ;
  1. ERR712(DIFILE,DIFIELD) ;
  1.  N DIFILNAM S DIFILNAM=$O(^DD(DIFILE,0,"NM","")) S:DIFILNAM?." " DIFILNAM="#"_DIFILE
  1.  N DIFLDNAM S DIFLDNAM=$$FLDNM^DIEFU(DIFILE,DIFIELD)
  1.  D ERR^DICA3(712,DIFILE,"",DIFIELD,DIFLDNAM,DIFILNAM)
  1.  Q