Annotation of freem_fileman/DIEF.m, revision 1.1.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>