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

DICA.m

Go to the documentation of this file. 
  1. DICA ;SEA/TOAD-VA FileMan, Updater, Engine ;1:33 PM  18 Nov 1999 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**1,4,17**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. ADD(DIFLAGS,DIFDA,DIEN,DIMSGA) ;
  1.  ;
  1. ADDX ; Branch in from UPDATE^DIE
  1.  ; ENTRY POINT--add a new entry to a file
  1.  ; subroutine, DIEN passed by reference
  1.  I '$D(DIQUIET) N DIQUIET S DIQUIET=1
  1.  I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1.  N DICLERR S DICLERR=$G(DIERR) K DIERR
  1. INPUT ;
  1.  ; initialize input parameters & check
  1.  N DIRULE S DIRULE=$$GETTMP^DIKC1("DICA")
  1.  N DIFDAO
  1.  S DIFLAGS=$G(DIFLAGS)
  1.  I $TR(DIFLAGS,"EKSUY")'="" D  Q
  1.  . D ERR^DICA3(301,"","","",DIFLAGS),CLOSE
  1.  S DIFDA=$G(DIFDA) I $D(@DIFDA)<10 D  Q
  1.  . D ERR^DICA3(202,"","","","FDA"),CLOSE
  1.  S DIFDAO=DIFDA
  1.  S DIEN=$G(DIEN) I DIEN="" S DIEN="DIDUMMY" N DIDUMMY
  1. PRE ;
  1.  N DIOK S DIOK=1 D CHECK^DICA1(DIFLAGS,.DIFDA,DIEN,DIRULE,.DIOK)
  1.  I $G(DIERR) D CLOSE Q
  1.  I 'DIOK D ERR^DICA3(202,"","","","FDA"),CLOSE Q
  1. SEQ ;
  1.  N DICHECK,DIENTRY,DIFILE,DIOUT1,DINEXT
  1.  S (DIOUT1,DINEXT)="" F  D  Q:DIOUT1
  1.  . S DINEXT=$O(@DIRULE@("NEXT",DINEXT)) I DINEXT="" S DIOUT1=1 Q
  1.  . X @DIRULE@("NEXT",DINEXT)
  1. FILES . ;
  1.  . I $P($G(^DD($$FNO^DILIBF(DIFILE),0,"DI")),U,2)["Y" D  Q:DIOUT1
  1.  . . S DIOUT1=DIFLAGS'["Y"&'$D(DIOVRD)
  1.  . . I DIOUT1 D ERR^DICA3(405,DIFILE,"","",DIFILE)
  1. ENTRIES . ;
  1.  . N DIDA,DIENP,DIOP,DIROOT,DISEQ
  1.  . S DIDA=$P(DIENTRY,",") I +DIDA=DIDA Q
  1.  . S DIENP=$$IEN(DIENTRY,"",DIRULE)
  1.  . S DIOP=$E(DIDA,1,2) I DIOP'="?+" S DIOP=$E(DIOP)
  1.  . S DISEQ=$P(DIDA,DIOP,2)
  1. FINDING . ;
  1.  . ; Finding (?) or LAYGO/FInding (?+) nodes
  1.  . I DIOP["?" D  Q
  1.  . . I DIOP="?+",DIENP[",," S @DIRULE@("NEXTADD",DINEXT)=@DIRULE@("NEXT",DINEXT) Q
  1.  . . N DIFIND,DIFORMAT,DIGET,DIINDEX,DIVALUE
  1.  . . S DIFORMAT="B"_$S(DIFLAGS["E":"",1:"Q")_$S(DIOP="?+":"X",1:"")
  1.  . . S DIGET=DIFDA
  1.  . . I DIFLAGS["E",DIOP["?" S DIGET=DIFDAO
  1.  . . I DIFLAGS["K",$D(^TMP("DIKK",$J,"P",DIFILE))#2 D
  1.  . . . D GETKVALS(.DIVALUE,.DIINDEX)
  1.  . . E  S DIVALUE=$G(@DIGET@(DIFILE,DIENTRY,.01))
  1.  . . S DIFIND=$$FIND1^DIC(DIFILE,DIENP,DIFORMAT,.DIVALUE,$G(DIINDEX))
  1.  . . I $G(DIERR) S DIOUT1=1 Q
  1.  . . I DIOP="?+",'DIFIND S @DIRULE@("NEXTADD",DINEXT)=@DIRULE@("NEXT",DINEXT) Q
  1.  . . I 'DIFIND S DIOUT1=1 D  Q
  1.  . . . I $D(DIVALUE)=10 N I,Q S DIVALUE="",(I,Q)=0 F  S I=$O(DIVALUE(I)) Q:'I  D  Q:Q
  1.  . . . . Q:DIVALUE(I)=""
  1.  . . . . S:DIVALUE]"" DIVALUE=DIVALUE_";"
  1.  . . . . I $L(DIVALUE)+$L(DIVALUE(I))>252 D
  1.  . . . . . S DIVALUE=$E(DIVALUE,1,252)_$E(DIVALUE(I),1,252-$L(DIVALUE))_"..."
  1.  . . . . . S Q=1
  1.  . . . . E  S DIVALUE=$G(DIVALUE)_$E(DIVALUE(I),1,251)
  1.  . . . D ERR^DICA3(703,DIFILE,DIENTRY,"",DIVALUE)
  1.  . . S @DIEN@(DISEQ)=DIFIND
  1.  . . I DIOP="?+" S @DIEN@(DISEQ,0)="?"
  1.  . . S @DIRULE@("IEN",DISEQ)=DIFIND
  1.  . . I DIFLAGS["K",$D(^TMP("DIKK",$J,"P",DIFILE)) D SAVEK Q
  1.  . . D SAVE
  1.  . ; Adding (+) nodes
  1.  . I '$G(DICHECK) S DICHECK=1 D ADDLF S:DIENP[",," DIENP=$$IEN(DIENTRY,"",DIRULE) I $G(DIERR) S DIOUT1=1 Q
  1.  . D ADDING
  1.  ;
  1. FILER ; file the data for the new records
  1.  I '$G(DIERR),$D(@DIFDA) D
  1.  . I '$G(DICHECK) D ADDLF Q:$G(DIERR)!'$D(@DIFDA)
  1.  . D FILE^DIEF($E("S",DIFLAGS["S")_"U",DIFDA,"",DIEN)
  1.  I '$G(DIERR),DIFLAGS'["S" K @DIFDAO
  1.  I $G(DIERR)!(DIFLAGS["S"),DIFLAGS'["E" D
  1.  . M @DIFDA=@DIRULE@("SAVE")
  1.  D CLOSE
  1.  Q
  1.  ;
  1. ADDING ;
  1.  N DIENEW,DIKEY
  1.  I $L(DIENP,",")>2 S DIOK=$$VMINUS9^DIEFU(DIFILE,DIENP) I 'DIOK D  Q
  1.  . S DIOUT1=1
  1.  . D ERR^DICA3(602,DIFILE,$P(DIENP,",",$L(DIENP,",")-1))
  1.  S DIROOT=$$ROOT^DIQGU(DIFILE,DIENP)
  1.  D DA^DILF(DIENTRY,.DIENEW)
  1. A1 S DIENEW=$$IEN(DIENTRY,$G(@DIEN@(DISEQ)),DIRULE)
  1.  S DIKEY=$G(@DIFDA@(DIFILE,DIENTRY,.01)) I DIKEY="" D  Q
  1.  . S DIOUT1=1 D ERR^DICA3(202,"","","","FDA")
  1.  S DIOK=$$LAYGO(DIFILE,.DIENEW,DIKEY)
  1.  I 'DIOK S DIOUT1=1 D  Q
  1.  . I '$G(DIERR) D ERR^DICA3(405,DIFILE,"","",DIFILE) Q
  1.  . N DIENS S DIENS="New entry"
  1.  . I $L(DIENEW,",")>2 S DIENS=DIENS_" under record: "_DIENEW
  1.  . N DI1 S DI1="LAYGO Node on the new value '"_DIKEY_"'"
  1.  . D ERR^DICA3(120,DIFILE,DIENS,.01,DI1)
  1.  D CREATE^DICA3(DIFILE,.DIENEW,DIROOT,DIKEY)
  1.  S DIENEW=+DIENEW
  1.  I 'DIENEW S DIOUT1=1 Q
  1.  L -@(DIROOT_"DIENEW)")
  1.  S @DIEN@(DISEQ)=DIENEW
  1.  I DIOP="?+" S @DIEN@(DISEQ,0)="+"
  1.  S @DIRULE@("IEN",DISEQ)=DIENEW
  1.  D SAVE
  1.  Q
  1.  ;
  1. LAYGO(DIFILE,DIEN,DIKEY) ;
  1.  ; ADDING--return if LAYGO permitted
  1.  ; function, all by value
  1.  N DA,DIOK,DINODE,DIOUTS,X,Y,Y1
  1.  S DIOK=1,DINODE="",DIOUTS=0 F  D  I DIOUTS!'DIOK Q
  1.  . S DINODE=$O(^DD(DIFILE,.01,"LAYGO",DINODE))
  1.  . I DINODE'>0 S DIOUTS=1 Q
  1.  . I $D(^DD(DIFILE,.01,"LAYGO",DINODE,0))[0 Q
  1.  . S X=DIKEY M DA=DIEN S Y=$P(DA,","),Y1=DA,DA=$P(DA,",")
  1.  . I 1 X ^DD(DIFILE,.01,"LAYGO",DINODE,0) S DIOK=$T&'$G(DIERR)
  1.  Q DIOK
  1.  ;
  1. SAVE I DIFLAGS'["E" D
  1.  . S @DIRULE@("SAVE",DIFILE,DIENTRY,.01)=@DIFDA@(DIFILE,DIENTRY,.01)
  1.  K @DIFDA@(DIFILE,DIENTRY,.01)
  1.  Q
  1.  ;
  1. SAVEK ; Remove primary key field from FDA; save in ^TMP first if necessary
  1.  N DIFLD
  1.  S DIFLD=0
  1.  F  S DIFLD=$O(^TMP("DIKK",$J,"P",DIFILE,DIFILE,DIFLD)) Q:'DIFLD  D
  1.  . Q:'^TMP("DIKK",$J,"P",DIFILE,DIFILE,DIFLD)
  1.  . Q:$D(@DIGET@(DIFILE,DIENTRY,DIFLD))[0
  1.  . S:DIFLAGS'["E" @DIRULE@("SAVE",DIFILE,DIENTRY,DIFLD)=@DIFDA@(DIFILE,DIENTRY,DIFLD)
  1.  . K @DIFDA@(DIFILE,DIENTRY,DIFLD)
  1.  Q
  1.  ;
  1. IEN(DIENTRY,DIENF,DIRULE) ;
  1.  ; ADDING/FINDING--return translated IEN String
  1.  ; function, DIENTRY passed by value
  1.  N DIC,DIENEW,DIOP,DIP,DIPNEW,DISEQ
  1.  S DIENEW=""
  1.  S DIENF=$G(DIENF)
  1.  S DIP="" F DIC=1:1 D  I DIP="" Q
  1.  . S DIP=$P(DIENTRY,",",DIC) I DIP="" Q
  1.  . D
  1.  . . I +DIP=DIP S DIPNEW=DIP Q
  1. IEN1 . . I DIC=1 S DIPNEW=DIENF Q
  1.  . . S DIOP=$E(DIP,1,2) I DIOP'="?+" S DIOP=$E(DIOP)
  1.  . . S DISEQ=$P(DIP,DIOP,2,9999)
  1.  . . S DIPNEW=$G(@DIRULE@("IEN",DISEQ))
  1.  . S $P(DIENEW,",",DIC)=DIPNEW
  1.  I DIENEW'="" S DIENEW=DIENEW_","
  1.  Q DIENEW
  1.  ;
  1. CLOSE I DICLERR'=""!$G(DIERR) D
  1.  . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
  1.  I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
  1.  K @DIRULE,^TMP("DIKK",$J)
  1.  Q
  1.  ;
  1. GETKVALS(DIVALUE,DIINDEX) ; Get primary key values and uniq index
  1.  N DIFLD,DIKEY,DISQ
  1.  K DIVALUE
  1.  S DIKEY=$P(^TMP("DIKK",$J,"P",DIFILE),U),DIINDEX=$P(^(DIFILE),U,4)
  1.  Q:DIINDEX=""!'DIKEY
  1.  ;
  1.  S DIFLD=0
  1.  F  S DIFLD=$O(^TMP("DIKK",$J,"P",DIFILE,DIFILE,DIFLD)) Q:'DIFLD  D
  1.  . S DISQ=^TMP("DIKK",$J,"P",DIFILE,DIFILE,DIFLD) Q:'DISQ
  1.  . Q:$D(@DIGET@(DIFILE,DIENTRY,DIFLD))[0
  1.  . S DIVALUE(DISQ)=@DIGET@(DIFILE,DIENTRY,DIFLD)
  1.  Q
  1.  ;
  1. ADDLF ; Check key integrity
  1.  I $D(^TMP("DIKK",$J,"L")),'$$CHECK^DIEVK(DIFDA,DIFLAGS,DIEN) Q
  1.  ;
  1.  ; Add records for LAYGO/Finding nodes which were not found
  1.  N DINEXT
  1.  S (DINEXT,DIOUT1)=""
  1.  F  S DINEXT=$O(@DIRULE@("NEXTADD",DINEXT)) Q:DINEXT=""  D  Q:DIOUT1
  1.  . N DIENP,DIFILE,DIENTRY,DIOP,DIROOT,DISEQ
  1.  . X @DIRULE@("NEXTADD",DINEXT)
  1.  . S DIENP=$$IEN(DIENTRY,"",DIRULE)
  1.  . S DIOP="?+"
  1.  . S DISEQ=$P($P(DIENTRY,","),DIOP,2)
  1.  . D ADDING
  1.  Q