Annotation of freem_fileman/DICA.m, revision 1.1
1.1 ! snw 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DICA.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman