Return to DICA.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DICA	;SEA/TOAD-VA FileMan, Updater, Engine ;12/1/94  08:52 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	
ADD(DIFLAGS,DIFDA,DIEN,DIMSGA)	
	
ADDX	; Branch in from UPDATE^DIE
	; ENTRY POINT--add a new entry to a file
	; subroutine, DIEN passed by reference
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
	K ^TMP("DIADD",$J)
INPUT	
	; initialize input parameters & check
	N DIRULE S DIRULE="^TMP(""DICA"",$J)"
	N DIFDAO
	I $G(DIMSGA)'="" D
	. K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG")
	S DIFLAGS=$G(DIFLAGS)
	I $TR(DIFLAGS,"ESY")'="" D  Q
	. D ERR^DICA3(301,"","","",DIFLAGS),CLOSE
	S DIFDA=$G(DIFDA) I $D(@DIFDA)<10 D  Q
	. D ERR^DICA3(202,"","","","FDA"),CLOSE
	S DIFDAO=DIFDA
	S DIEN=$G(DIEN) I DIEN="" S DIEN="DIDUMMY" N DIDUMMY
PRE	
	N DIOK S DIOK=1 D CHECK^DICA1(DIFLAGS,.DIFDA,DIEN,DIRULE,.DIOK)
	I $G(DIERR) D CLOSE Q
	I 'DIOK D ERR^DICA3(202,"","","","FDA"),CLOSE Q
SEQ	
	N DIENTRY,DIFILE,DIOUT1,DINEXT
	S (DIOUT1,DINEXT)="" F  D  Q:DIOUT1
	. S DINEXT=$O(@DIRULE@("NEXT",DINEXT)) I DINEXT="" S DIOUT1=1 Q
	. X @DIRULE@("NEXT",DINEXT)
FILES	. 
	. I $P($G(^DD($$FNO^DILIBF(DIFILE),0,"DI")),U,2)["Y" D  Q
	. . S DIOUT1=DIFLAGS'["Y"&'$D(DIOVRD)
	. . I DIOUT1 D ERR^DICA3(405,DIFILE,"","",DIFILE)
ENTRIES	. 
	. N DIDA,DIENP,DIOP,DIROOT,DISEQ
	. S DIDA=$P(DIENTRY,",") I +DIDA=DIDA Q
	. S DIENP=$$IEN(DIENTRY,"",DIRULE)
	. S DIOP=$E(DIDA,1,2) I DIOP'="?+" S DIOP=$E(DIOP)
	. S DISEQ=$P(DIDA,DIOP,2)
FINDING	.
	. I DIOP["?" S DIOUT2=0 D  I DIOUT2 Q
	. . N DIFIND,DIFORMAT,DIGET,DIVALUE
	. . S DIFORMAT=$S(DIFLAGS["E":"",1:"Q")
	. . S DIGET=DIFDA
	. . I DIFLAGS["E",DIOP="?" S DIGET=DIFDAO
	. . S DIVALUE=$G(@DIGET@(DIFILE,DIENTRY,.01))
	. . S DIFIND=$$FIND1^DIC(DIFILE,DIENP,DIFORMAT,DIVALUE)
	. . I $D(DIERR) S DIOUT1=1,DIOUT2=1 Q
	. . I DIOP="?+",'DIFIND Q
	. . I 'DIFIND S DIOUT1=1,DIOUT2=1 D  Q
	. . . D ERR^DICA3(703,DIFILE,DIENTRY,"",DIVALUE)
	. . S @DIEN@(DISEQ)=DIFIND
	. . S @DIRULE@("IEN",DISEQ)=DIFIND
	. . D SAVE S DIOUT2=1
ADDING	. 
	. N DIENEW,DIKEY
	. I $L(DIENP,",")>2 S DIOK=$$VMINUS9^DIEFU(DIFILE,DIENP) I 'DIOK D  Q
	. . S DIOUT1=1
	. . D ERR^DICA3(602,DIFILE,$P(DIENP,",",$L(DIENP,",")-1))
	. S DIROOT=$$ROOT^DIQGU(DIFILE,DIENP)
	. D DA^DILF(DIENTRY,.DIENEW)
A1	. S DIENEW=$$IEN(DIENTRY,$G(@DIEN@(DISEQ)),DIRULE)
	. S DIKEY=$G(@DIFDA@(DIFILE,DIENTRY,.01)) I DIKEY="" D  Q
	. . S DIOUT1=1 D ERR^DICA3(202,"","","","FDA")
	. S DIOK=$$LAYGO(DIFILE,.DIENEW,DIKEY)
	. I 'DIOK S DIOUT1=1 D  Q
	. . I '$G(DIERR) D ERR^DICA3(405,DIFILE,"","",DIFILE) Q
	. . N DIENS S DIENS="New entry"
	. . I $L(DIENEW,",")>2 S DIENS=DIENS_" under record: "_DIENEW
	. . N DI1 S DI1="LAYGO Node on the new value '"_DIKEY_"'"
	. . D ERR^DICA3(120,DIFILE,DIENS,.01,DI1)
	. D CREATE^DICA3(DIFILE,.DIENEW,DIROOT,DIKEY)
	. S DIENEW=+DIENEW
	. I 'DIENEW S DIOUT1=1 Q
	. L -@(DIROOT_"DIENEW)")
	. S @DIEN@(DISEQ)=DIENEW
	. S @DIRULE@("IEN",DISEQ)=DIENEW
	. D SAVE
	
FILER	; file the data for the new records
	I '$D(DIERR),$D(@DIFDA) D
	. D FILE^DIEF($S(DIFLAGS["S":"S",1:""),DIFDA,"",DIEN)
	I '$D(DIERR),DIFLAGS'["S" K @DIFDAO
	I $D(DIERR)!(DIFLAGS["S"),DIFLAGS'["E" D
	. M @DIFDA=^TMP("DIADD",$J) K ^TMP("DIADD",$J)
	D CLOSE
	Q
	
LAYGO(DIFILE,DIEN,DIKEY)	
	; ADDING--return if LAYGO permitted
	; function, all by value
	N DA,DIOK,DINODE,DIOUTS,X,Y,Y1
	S DIOK=1,DINODE="",DIOUTS=0 F  D  I DIOUTS!'DIOK Q
	. S DINODE=$O(^DD(DIFILE,.01,"LAYGO",DINODE))
	. I DINODE'>0 S DIOUTS=1 Q
	. I $D(^DD(DIFILE,.01,"LAYGO",DINODE,0))[0 Q
	. S X=DIKEY M DA=DIEN S Y=$P(DA,","),Y1=DA,DA=$P(DA,",")
	. I 1 X ^DD(DIFILE,.01,"LAYGO",DINODE,0) S DIOK=$T&'$G(DIERR)
	Q DIOK
	
SAVE	I DIFLAGS'["E" D
	. S ^TMP("DIADD",$J,DIFILE,DIENTRY,.01)=@DIFDA@(DIFILE,DIENTRY,.01)
	K @DIFDA@(DIFILE,DIENTRY,.01)
	Q
	
IEN(DIENTRY,DIENF,DIRULE)	
	; ADDING/FINDING--return translated IEN String
	; function, DIENTRY passed by value
	N DIC,DIENEW,DIOP,DIP,DIPNEW,DISEQ
	S DIENEW=""
	S DIENF=$G(DIENF)
	S DIP="" F DIC=1:1 D  I DIP="" Q
	. S DIP=$P(DIENTRY,",",DIC) I DIP="" Q
	. D
	. . I +DIP=DIP S DIPNEW=DIP Q
IEN1	. . I DIC=1 S DIPNEW=DIENF Q
	. . S DIOP=$E(DIP,1,2) I DIOP'="?+" S DIOP=$E(DIOP)
	. . S DISEQ=$P(DIP,DIOP,2,9999)
	. . S DIPNEW=@DIRULE@("IEN",DISEQ)
	. S $P(DIENEW,",",DIC)=DIPNEW
	I DIENEW'="" S DIENEW=DIENEW_","
	Q DIENEW
	
CLOSE	I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
	K @DIRULE
	Q