190 lines
6.4 KiB
Mathematica
190 lines
6.4 KiB
Mathematica
DICA ;SEA/TOAD-VA FileMan, Updater, Engine ;1:33 PM 18 Nov 1999
|
|
;;22.0;VA FileMan;**1,4,17**;Mar 30, 1999
|
|
;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
|
|
N DICLERR S DICLERR=$G(DIERR) K DIERR
|
|
INPUT ;
|
|
; initialize input parameters & check
|
|
N DIRULE S DIRULE=$$GETTMP^DIKC1("DICA")
|
|
N DIFDAO
|
|
S DIFLAGS=$G(DIFLAGS)
|
|
I $TR(DIFLAGS,"EKSUY")'="" 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 DICHECK,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:DIOUT1
|
|
. . 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 . ;
|
|
. ; Finding (?) or LAYGO/FInding (?+) nodes
|
|
. I DIOP["?" D Q
|
|
. . I DIOP="?+",DIENP[",," S @DIRULE@("NEXTADD",DINEXT)=@DIRULE@("NEXT",DINEXT) Q
|
|
. . N DIFIND,DIFORMAT,DIGET,DIINDEX,DIVALUE
|
|
. . S DIFORMAT="B"_$S(DIFLAGS["E":"",1:"Q")_$S(DIOP="?+":"X",1:"")
|
|
. . S DIGET=DIFDA
|
|
. . I DIFLAGS["E",DIOP["?" S DIGET=DIFDAO
|
|
. . I DIFLAGS["K",$D(^TMP("DIKK",$J,"P",DIFILE))#2 D
|
|
. . . D GETKVALS(.DIVALUE,.DIINDEX)
|
|
. . E S DIVALUE=$G(@DIGET@(DIFILE,DIENTRY,.01))
|
|
. . S DIFIND=$$FIND1^DIC(DIFILE,DIENP,DIFORMAT,.DIVALUE,$G(DIINDEX))
|
|
. . I $G(DIERR) S DIOUT1=1 Q
|
|
. . I DIOP="?+",'DIFIND S @DIRULE@("NEXTADD",DINEXT)=@DIRULE@("NEXT",DINEXT) Q
|
|
. . I 'DIFIND S DIOUT1=1 D Q
|
|
. . . I $D(DIVALUE)=10 N I,Q S DIVALUE="",(I,Q)=0 F S I=$O(DIVALUE(I)) Q:'I D Q:Q
|
|
. . . . Q:DIVALUE(I)=""
|
|
. . . . S:DIVALUE]"" DIVALUE=DIVALUE_";"
|
|
. . . . I $L(DIVALUE)+$L(DIVALUE(I))>252 D
|
|
. . . . . S DIVALUE=$E(DIVALUE,1,252)_$E(DIVALUE(I),1,252-$L(DIVALUE))_"..."
|
|
. . . . . S Q=1
|
|
. . . . E S DIVALUE=$G(DIVALUE)_$E(DIVALUE(I),1,251)
|
|
. . . D ERR^DICA3(703,DIFILE,DIENTRY,"",DIVALUE)
|
|
. . S @DIEN@(DISEQ)=DIFIND
|
|
. . I DIOP="?+" S @DIEN@(DISEQ,0)="?"
|
|
. . S @DIRULE@("IEN",DISEQ)=DIFIND
|
|
. . I DIFLAGS["K",$D(^TMP("DIKK",$J,"P",DIFILE)) D SAVEK Q
|
|
. . D SAVE
|
|
. ; Adding (+) nodes
|
|
. I '$G(DICHECK) S DICHECK=1 D ADDLF S:DIENP[",," DIENP=$$IEN(DIENTRY,"",DIRULE) I $G(DIERR) S DIOUT1=1 Q
|
|
. D ADDING
|
|
;
|
|
FILER ; file the data for the new records
|
|
I '$G(DIERR),$D(@DIFDA) D
|
|
. I '$G(DICHECK) D ADDLF Q:$G(DIERR)!'$D(@DIFDA)
|
|
. D FILE^DIEF($E("S",DIFLAGS["S")_"U",DIFDA,"",DIEN)
|
|
I '$G(DIERR),DIFLAGS'["S" K @DIFDAO
|
|
I $G(DIERR)!(DIFLAGS["S"),DIFLAGS'["E" D
|
|
. M @DIFDA=@DIRULE@("SAVE")
|
|
D CLOSE
|
|
Q
|
|
;
|
|
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
|
|
I DIOP="?+" S @DIEN@(DISEQ,0)="+"
|
|
S @DIRULE@("IEN",DISEQ)=DIENEW
|
|
D SAVE
|
|
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 @DIRULE@("SAVE",DIFILE,DIENTRY,.01)=@DIFDA@(DIFILE,DIENTRY,.01)
|
|
K @DIFDA@(DIFILE,DIENTRY,.01)
|
|
Q
|
|
;
|
|
SAVEK ; Remove primary key field from FDA; save in ^TMP first if necessary
|
|
N DIFLD
|
|
S DIFLD=0
|
|
F S DIFLD=$O(^TMP("DIKK",$J,"P",DIFILE,DIFILE,DIFLD)) Q:'DIFLD D
|
|
. Q:'^TMP("DIKK",$J,"P",DIFILE,DIFILE,DIFLD)
|
|
. Q:$D(@DIGET@(DIFILE,DIENTRY,DIFLD))[0
|
|
. S:DIFLAGS'["E" @DIRULE@("SAVE",DIFILE,DIENTRY,DIFLD)=@DIFDA@(DIFILE,DIENTRY,DIFLD)
|
|
. K @DIFDA@(DIFILE,DIENTRY,DIFLD)
|
|
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=$G(@DIRULE@("IEN",DISEQ))
|
|
. S $P(DIENEW,",",DIC)=DIPNEW
|
|
I DIENEW'="" S DIENEW=DIENEW_","
|
|
Q DIENEW
|
|
;
|
|
CLOSE I DICLERR'=""!$G(DIERR) D
|
|
. S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
|
|
I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
|
|
K @DIRULE,^TMP("DIKK",$J)
|
|
Q
|
|
;
|
|
GETKVALS(DIVALUE,DIINDEX) ; Get primary key values and uniq index
|
|
N DIFLD,DIKEY,DISQ
|
|
K DIVALUE
|
|
S DIKEY=$P(^TMP("DIKK",$J,"P",DIFILE),U),DIINDEX=$P(^(DIFILE),U,4)
|
|
Q:DIINDEX=""!'DIKEY
|
|
;
|
|
S DIFLD=0
|
|
F S DIFLD=$O(^TMP("DIKK",$J,"P",DIFILE,DIFILE,DIFLD)) Q:'DIFLD D
|
|
. S DISQ=^TMP("DIKK",$J,"P",DIFILE,DIFILE,DIFLD) Q:'DISQ
|
|
. Q:$D(@DIGET@(DIFILE,DIENTRY,DIFLD))[0
|
|
. S DIVALUE(DISQ)=@DIGET@(DIFILE,DIENTRY,DIFLD)
|
|
Q
|
|
;
|
|
ADDLF ; Check key integrity
|
|
I $D(^TMP("DIKK",$J,"L")),'$$CHECK^DIEVK(DIFDA,DIFLAGS,DIEN) Q
|
|
;
|
|
; Add records for LAYGO/Finding nodes which were not found
|
|
N DINEXT
|
|
S (DINEXT,DIOUT1)=""
|
|
F S DINEXT=$O(@DIRULE@("NEXTADD",DINEXT)) Q:DINEXT="" D Q:DIOUT1
|
|
. N DIENP,DIFILE,DIENTRY,DIOP,DIROOT,DISEQ
|
|
. X @DIRULE@("NEXTADD",DINEXT)
|
|
. S DIENP=$$IEN(DIENTRY,"",DIRULE)
|
|
. S DIOP="?+"
|
|
. S DISEQ=$P($P(DIENTRY,","),DIOP,2)
|
|
. D ADDING
|
|
Q
|