Return to DICA.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICA	;SEA/TOAD-VA FileMan, Updater, Engine ;12/1/94  08:52 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: ADD(DIFLAGS,DIFDA,DIEN,DIMSGA)	
    6: 	
    7: ADDX	; Branch in from UPDATE^DIE
    8: 	; ENTRY POINT--add a new entry to a file
    9: 	; subroutine, DIEN passed by reference
   10: 	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
   11: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
   12: 	K ^TMP("DIADD",$J)
   13: INPUT	
   14: 	; initialize input parameters & check
   15: 	N DIRULE S DIRULE="^TMP(""DICA"",$J)"
   16: 	N DIFDAO
   17: 	I $G(DIMSGA)'="" D
   18: 	. K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG")
   19: 	S DIFLAGS=$G(DIFLAGS)
   20: 	I $TR(DIFLAGS,"ESY")'="" D  Q
   21: 	. D ERR^DICA3(301,"","","",DIFLAGS),CLOSE
   22: 	S DIFDA=$G(DIFDA) I $D(@DIFDA)<10 D  Q
   23: 	. D ERR^DICA3(202,"","","","FDA"),CLOSE
   24: 	S DIFDAO=DIFDA
   25: 	S DIEN=$G(DIEN) I DIEN="" S DIEN="DIDUMMY" N DIDUMMY
   26: PRE	
   27: 	N DIOK S DIOK=1 D CHECK^DICA1(DIFLAGS,.DIFDA,DIEN,DIRULE,.DIOK)
   28: 	I $G(DIERR) D CLOSE Q
   29: 	I 'DIOK D ERR^DICA3(202,"","","","FDA"),CLOSE Q
   30: SEQ	
   31: 	N DIENTRY,DIFILE,DIOUT1,DINEXT
   32: 	S (DIOUT1,DINEXT)="" F  D  Q:DIOUT1
   33: 	. S DINEXT=$O(@DIRULE@("NEXT",DINEXT)) I DINEXT="" S DIOUT1=1 Q
   34: 	. X @DIRULE@("NEXT",DINEXT)
   35: FILES	. 
   36: 	. I $P($G(^DD($$FNO^DILIBF(DIFILE),0,"DI")),U,2)["Y" D  Q
   37: 	. . S DIOUT1=DIFLAGS'["Y"&'$D(DIOVRD)
   38: 	. . I DIOUT1 D ERR^DICA3(405,DIFILE,"","",DIFILE)
   39: ENTRIES	. 
   40: 	. N DIDA,DIENP,DIOP,DIROOT,DISEQ
   41: 	. S DIDA=$P(DIENTRY,",") I +DIDA=DIDA Q
   42: 	. S DIENP=$$IEN(DIENTRY,"",DIRULE)
   43: 	. S DIOP=$E(DIDA,1,2) I DIOP'="?+" S DIOP=$E(DIOP)
   44: 	. S DISEQ=$P(DIDA,DIOP,2)
   45: FINDING	.
   46: 	. I DIOP["?" S DIOUT2=0 D  I DIOUT2 Q
   47: 	. . N DIFIND,DIFORMAT,DIGET,DIVALUE
   48: 	. . S DIFORMAT=$S(DIFLAGS["E":"",1:"Q")
   49: 	. . S DIGET=DIFDA
   50: 	. . I DIFLAGS["E",DIOP="?" S DIGET=DIFDAO
   51: 	. . S DIVALUE=$G(@DIGET@(DIFILE,DIENTRY,.01))
   52: 	. . S DIFIND=$$FIND1^DIC(DIFILE,DIENP,DIFORMAT,DIVALUE)
   53: 	. . I $D(DIERR) S DIOUT1=1,DIOUT2=1 Q
   54: 	. . I DIOP="?+",'DIFIND Q
   55: 	. . I 'DIFIND S DIOUT1=1,DIOUT2=1 D  Q
   56: 	. . . D ERR^DICA3(703,DIFILE,DIENTRY,"",DIVALUE)
   57: 	. . S @DIEN@(DISEQ)=DIFIND
   58: 	. . S @DIRULE@("IEN",DISEQ)=DIFIND
   59: 	. . D SAVE S DIOUT2=1
   60: ADDING	. 
   61: 	. N DIENEW,DIKEY
   62: 	. I $L(DIENP,",")>2 S DIOK=$$VMINUS9^DIEFU(DIFILE,DIENP) I 'DIOK D  Q
   63: 	. . S DIOUT1=1
   64: 	. . D ERR^DICA3(602,DIFILE,$P(DIENP,",",$L(DIENP,",")-1))
   65: 	. S DIROOT=$$ROOT^DIQGU(DIFILE,DIENP)
   66: 	. D DA^DILF(DIENTRY,.DIENEW)
   67: A1	. S DIENEW=$$IEN(DIENTRY,$G(@DIEN@(DISEQ)),DIRULE)
   68: 	. S DIKEY=$G(@DIFDA@(DIFILE,DIENTRY,.01)) I DIKEY="" D  Q
   69: 	. . S DIOUT1=1 D ERR^DICA3(202,"","","","FDA")
   70: 	. S DIOK=$$LAYGO(DIFILE,.DIENEW,DIKEY)
   71: 	. I 'DIOK S DIOUT1=1 D  Q
   72: 	. . I '$G(DIERR) D ERR^DICA3(405,DIFILE,"","",DIFILE) Q
   73: 	. . N DIENS S DIENS="New entry"
   74: 	. . I $L(DIENEW,",")>2 S DIENS=DIENS_" under record: "_DIENEW
   75: 	. . N DI1 S DI1="LAYGO Node on the new value '"_DIKEY_"'"
   76: 	. . D ERR^DICA3(120,DIFILE,DIENS,.01,DI1)
   77: 	. D CREATE^DICA3(DIFILE,.DIENEW,DIROOT,DIKEY)
   78: 	. S DIENEW=+DIENEW
   79: 	. I 'DIENEW S DIOUT1=1 Q
   80: 	. L -@(DIROOT_"DIENEW)")
   81: 	. S @DIEN@(DISEQ)=DIENEW
   82: 	. S @DIRULE@("IEN",DISEQ)=DIENEW
   83: 	. D SAVE
   84: 	
   85: FILER	; file the data for the new records
   86: 	I '$D(DIERR),$D(@DIFDA) D
   87: 	. D FILE^DIEF($S(DIFLAGS["S":"S",1:""),DIFDA,"",DIEN)
   88: 	I '$D(DIERR),DIFLAGS'["S" K @DIFDAO
   89: 	I $D(DIERR)!(DIFLAGS["S"),DIFLAGS'["E" D
   90: 	. M @DIFDA=^TMP("DIADD",$J) K ^TMP("DIADD",$J)
   91: 	D CLOSE
   92: 	Q
   93: 	
   94: LAYGO(DIFILE,DIEN,DIKEY)	
   95: 	; ADDING--return if LAYGO permitted
   96: 	; function, all by value
   97: 	N DA,DIOK,DINODE,DIOUTS,X,Y,Y1
   98: 	S DIOK=1,DINODE="",DIOUTS=0 F  D  I DIOUTS!'DIOK Q
   99: 	. S DINODE=$O(^DD(DIFILE,.01,"LAYGO",DINODE))
  100: 	. I DINODE'>0 S DIOUTS=1 Q
  101: 	. I $D(^DD(DIFILE,.01,"LAYGO",DINODE,0))[0 Q
  102: 	. S X=DIKEY M DA=DIEN S Y=$P(DA,","),Y1=DA,DA=$P(DA,",")
  103: 	. I 1 X ^DD(DIFILE,.01,"LAYGO",DINODE,0) S DIOK=$T&'$G(DIERR)
  104: 	Q DIOK
  105: 	
  106: SAVE	I DIFLAGS'["E" D
  107: 	. S ^TMP("DIADD",$J,DIFILE,DIENTRY,.01)=@DIFDA@(DIFILE,DIENTRY,.01)
  108: 	K @DIFDA@(DIFILE,DIENTRY,.01)
  109: 	Q
  110: 	
  111: IEN(DIENTRY,DIENF,DIRULE)	
  112: 	; ADDING/FINDING--return translated IEN String
  113: 	; function, DIENTRY passed by value
  114: 	N DIC,DIENEW,DIOP,DIP,DIPNEW,DISEQ
  115: 	S DIENEW=""
  116: 	S DIENF=$G(DIENF)
  117: 	S DIP="" F DIC=1:1 D  I DIP="" Q
  118: 	. S DIP=$P(DIENTRY,",",DIC) I DIP="" Q
  119: 	. D
  120: 	. . I +DIP=DIP S DIPNEW=DIP Q
  121: IEN1	. . I DIC=1 S DIPNEW=DIENF Q
  122: 	. . S DIOP=$E(DIP,1,2) I DIOP'="?+" S DIOP=$E(DIOP)
  123: 	. . S DISEQ=$P(DIP,DIOP,2,9999)
  124: 	. . S DIPNEW=@DIRULE@("IEN",DISEQ)
  125: 	. S $P(DIENEW,",",DIC)=DIPNEW
  126: 	I DIENEW'="" S DIENEW=DIENEW_","
  127: 	Q DIENEW
  128: 	
  129: CLOSE	I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
  130: 	K @DIRULE
  131: 	Q