Annotation of freem_fileman/DIEF.m, revision 1.1

1.1     ! snw         1: DIEF   ;SFISC/DPC-FILER DRIVER ;11/9/94  13:10
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: FILE(DIEFFLAG,DIEFAR,DIEFOUT,DIEFADAR) ;
        !             5: FILEX  ;
        !             6:        N DIEFF,DIEFCNOD,DIEFNODE,DIEFSPOT,DIEFDAS,DIEFIEN,DIEFRFLD,DIEFFLD,DIEFFVAL,DIEFOVAL,DIEFNVAL,DIEFTSRC,DIEFLOCK,DIEFECNT
        !             7:        S DIEFFLAG=$G(DIEFFLAG)
        !             8:        I '$D(DIQUIET) N DIQUIET S DIQUIET=1
        !             9:        I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
        !            10:        I '$$VERFLG^DIEFU(DIEFFLAG,"ISKEO") G OUT
        !            11:        I '$$VROOT^DIEFU(DIEFAR) G OUT
        !            12:        I '($D(@DIEFAR)\10) D BLD^DIALOG(305,DIEFAR,DIEFAR) G OUT
        !            13:        I DIEFFLAG["K" N DIEFNOLK,DIEFLCKS D LOCK I DIEFNOLK D:$D(DIEFLOCK) UNLOCK G OUT
        !            14:        D DRIVER
        !            15:        I $D(DIEFLOCK) D UNLOCK
        !            16:        I DIEFFLAG'["S",'$G(DIERR) K @DIEFAR
        !            17: OUT    I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
        !            18:        Q
        !            19: LOCK   ;
        !            20:        S (DIEFNOLK,DIEFLCKS)=0,DIEFF=""
        !            21:        F  S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF=""  D  Q:DIEFNOLK
        !            22:        . I '$$VFILE^DIEFU(DIEFF,"D") S DIEFNOLK=1 Q
        !            23:        . S DIEFDAS=""
        !            24:        . F  S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS=""  D  Q:DIEFNOLK
        !            25:        . . I '$$GOODIEN(DIEFDAS) S DIEFNOLK=1 Q
        !            26:        . . N DIEFDA D DA^DIEFU(DIEFDAS,.DIEFDA)
        !            27:        . . S DIEFLCKS=DIEFLCKS+1
        !            28:        . . S DIEFLOCK(DIEFLCKS)=$$ROOT^DIQGU(DIEFF,.DIEFDA)_DIEFDA_")"
        !            29:        . . L +@DIEFLOCK(DIEFLCKS):1 E  D
        !            30:        . . . S DIEFNOLK=1
        !            31:        . . . N E S E("FILE")=DIEFF,E("IENS")=DIEFDAS D BLD^DIALOG(110,"",.E)
        !            32:        Q
        !            33: UNLOCK ;
        !            34:        N I
        !            35:        F I=1:1:DIEFLCKS L -@DIEFLOCK(I)
        !            36:        Q
        !            37: DRIVER ;
        !            38:        S DIEFF=""
        !            39:        F  S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF=""  D
        !            40:        . I DIEFFLAG'["K",'$$VFILE^DIEFU(DIEFF,"D") Q
        !            41:        . S DIEFDAS=""
        !            42:        . F  S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS=""  D
        !            43:        . . S DIEFIEN=DIEFDAS
        !            44:        . . I ($E(DIEFIEN)="?"!($E(DIEFIEN)="+")),$G(DIEFADAR)]"" S DIEFIEN=$$ADDCONV^DIEF1(DIEFIEN,DIEFADAR)
        !            45:        . . I '$$GOODIEN(DIEFIEN) Q
        !            46:        . . N DA,I,DEPTH,D
        !            47:        . . S DEPTH=$L(DIEFIEN,",")-1
        !            48:        . . F I=1:1:DEPTH S D="D"_(DEPTH-I) N @D S (DA(I-1),@D)=$P(DIEFIEN,",",I)
        !            49:        . . S DA=DA(0) K DA(0)
        !            50:        . . I '$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D") Q
        !            51:        . . N DOREPL S DIEFRFLD="",DOREPL=0
        !            52:        . . F  S DIEFRFLD=$O(@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)) Q:DIEFRFLD=""  D 
        !            53:        . . . N DIEFNG
        !            54:        . . . S DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFRFLD) I 'DIEFFLD Q
        !            55:        . . . I DIEFFLD=.001 D BLD^DIALOG(520,".001",".001") Q
        !            56:        . . . S DIEFNVAL=@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)
        !            57:        . . . I DIEFFLAG["E" D VAL Q:$D(DIEFNG)
        !            58:        . . . I DIEFFLD=.01,"@"[DIEFNVAL D PT01DEL Q
        !            59:        . . . S DIEFSPOT=" " D GLRF^DIOU(DIEFF,DIEFFLD,.DIEFNODE,.DIEFSPOT)
        !            60:        . . . I DIEFNODE'=$G(DIEFCNOD) D:DOREPL REPLACE S DIEFCNOD=DIEFNODE D RETRIEVE
        !            61:        . . . I DIEFNVAL="@" S DIEFNVAL=""
        !            62:        . . . D PUTDATA^DIEF1 Q:$D(DIEFNG)
        !            63:        . . . I DIEFNVAL'=$G(DIEFOVAL) D XRFAUD
        !            64:        . . D REPLACE:DOREPL K DIEFCNOD
        !            65:        Q
        !            66: PT01DEL        ;
        !            67:        I '$D(^DD(DIEFF,0,"UP")) D  Q
        !            68:        . N INT,EXT
        !            69:        . S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
        !            70:        . D BLD^DIALOG(712,.INT,.EXT)
        !            71:        S DIEFECNT=$G(DIERR)
        !            72:        N DIK S DIK=$$ROOT^DIQGU(DIEFF,.DA) D ^DIK
        !            73:        I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
        !            74:        Q
        !            75: VAL    ;
        !            76:        N DIEFTYPE,DIEFINT
        !            77:        D DTYP^DIOU(DIEFF,DIEFFLD,.DIEFTYPE) Q:DIEFTYPE=5
        !            78:        D VAL^DIEV(DIEFF,DIEFIEN,DIEFFLD,"",DIEFNVAL,.DIEFINT)
        !            79:        I DIEFINT'=U S DIEFNVAL=DIEFINT Q
        !            80:        S DIEFNG=1
        !            81:        Q
        !            82: REPLACE        ;
        !            83:        S @DIEFCNOD=DIEFFVAL,DOREPL=0
        !            84:        Q
        !            85: RETRIEVE       ;
        !            86:        S DIEFFVAL=$G(@DIEFCNOD)
        !            87:        Q
        !            88:        ;
        !            89: XRFAUD ;
        !            90:        I $D(^DD(DIEFF,"IX",DIEFFLD)) D REPLACE:$G(DOREPL),IX,RETRIEVE:$D(DOREPL)
        !            91:        I $D(^DD(DIEFF,"AUDIT",DIEFFLD)) D AUDIT
        !            92:        Q
        !            93: IX     ;
        !            94:        N X,DIEFSORK
        !            95:        I DIEFOVAL'="" S DIEFSORK=2 D FIRE
        !            96:        I "@"'[DIEFNVAL S DIEFSORK=1 D FIRE
        !            97:        Q
        !            98: FIRE   ;
        !            99:        N DIEFI S DIEFI=0
        !           100:        F  S DIEFI=$O(^DD(DIEFF,DIEFFLD,1,DIEFI)) Q:DIEFI=""  D
        !           101:        . N I,Y,DIG,DIH,DIU,DIV,XMB,XMY
        !           102:        . S X=$S(DIEFSORK=1:DIEFNVAL,1:DIEFOVAL)
        !           103:        . N DIEFECNT S DIEFECNT=$G(DIERR)
        !           104:        . X ^(DIEFI,DIEFSORK) ;Naked indicator set in For loop, FIRE+2
        !           105:        . I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
        !           106:        Q
        !           107: AUDIT  ;
        !           108:        N X,DP,DG,DIIX N DIANUM,C,Y
        !           109:        S DP=DIEFF,DG=1
        !           110:        I DIEFOVAL]"" S X=DIEFOVAL,DIIX="2^"_DIEFFLD D AUDIT^DIET
        !           111:        I "@"'[DIEFNVAL,(DIEFOVAL]""!(^DD(DIEFF,DIEFFLD,"AUDIT")'="e")) S X=DIEFNVAL,DIIX="3^"_DIEFFLD D AUDIT^DIET
        !           112:        Q
        !           113:        ;
        !           114: GOODIEN(DIEFIEN)       ;
        !           115:        I '+DIEFIEN!($E(DIEFIEN,$L(DIEFIEN))'=",") D  Q 0
        !           116:        . D BLD^DIALOG(203,"IENS","IENS")
        !           117:        Q 1

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>