Return to DIDU.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIDU	;SEA/TOAD-VA FileMan: DD Tools, Format ;12/1/94  16:35
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIMSGA)	
    6: XTRNLX	; Branch from DILFD or DIQGU
    7: 	; ENTRY POINT--convert DINTERNL to external format
    8: 	; func, all passed by value
    9: 	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
   10: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
   11: INPUT	
   12: 	I $G(DINTERNL)="" Q ""
   13: 	S DIMSGA=$G(DIMSGA) I DIMSGA'="" D
   14: 	. K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG")
   15: 	S DIFILE=$G(DIFILE)
   16: 	I DIFILE'>0 D ERR(DIMSGA,202,"","","","FILE") Q ""
   17: 	S DIFLAGS=$G(DIFLAGS)
   18: 	I DIFLAGS'?.1(1"F",1"L",1"U") D ERR(DIMSGA,301,"","","",DIFLAGS) Q ""
   19: 	S DIFIELD=$G(DIFIELD)
   20: 	I DIFIELD'>0 D ERR(DIMSGA,202,"","","","FIELD") Q ""
   21: PREP	
   22: 	N DICHAIN,DIDONE,DIEN,DIEXTRNL
   23: 	N DIHEAD,DINEXT,DINODE,DIOUT,DIROOT,DITYPE,DIXFORM
   24: 	S DICHAIN=0,DIDONE=0,DIEN="",DIEXTRNL=""
   25: 	S DIHEAD="",DINEXT="",DIOUT=0,DIXFORM=""
   26: 	N DIPREV S DIPREV=""
   27: 	N DIPREVF S DIPREVF=""
   28: 	I '$D(^DD(DIFILE)) D ERR(DIMSGA,401,DIFILE) Q ""
   29: 	S DINODE=$G(^DD(DIFILE,DIFIELD,0))
   30: 	I DINODE="" D ERR(DIMSGA,501,DIFILE,"",DIFIELD,DIFIELD) Q ""
   31: 	S DITYPE=$P(DINODE,U,2)
   32: RESOLVE	
   33: 	F  D  I DIDONE!$G(DIERR)!DIOUT Q
   34: XFORM	.
   35: 	. I DIFLAGS["U",DIXFORM'="",DITYPE'["P",DITYPE'["V" S DITYPE=DITYPE_"O"
   36: 	. I DITYPE["O" D  I DIDONE!$G(DIERR) Q
   37: 	. . I DIFLAGS["F",DICHAIN Q
   38: 	. . I DIFLAGS["L",DITYPE["P"!(DITYPE["V") Q
   39: 	. . I DIXFORM=""!(DIFLAGS'["U") S DIXFORM=$G(^DD(DIFILE,DIFIELD,2))
   40: 	. . I DIXFORM="" Q
   41: 	. . I DIFLAGS["U",DITYPE["P"!(DITYPE["V") Q
   42: 	. . N Y S Y=DINTERNL
   43: 	. . X DIXFORM
   44: 	. . I $G(DIERR) D ERR^DICF6(120,DIFILE,DIEN,"","Output Transform") Q
   45: 	. . S DIEXTRNL=Y
   46: 	. . S DIDONE=1
   47: CHAIN	.
   48: 	. I DITYPE S DIOUT=1 Q
   49: 	. I DITYPE'["P",DITYPE'["V" S DIOUT=1 Q
   50: 	. I 'DINTERNL D  Q
   51: 	. . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"pointer") Q
   52: 	. . D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"pointer")
   53: 	. I DITYPE["P" S DIROOT=$P(DINODE,U,3),DINEXT=+$P($P(DINODE,U,2),"P",2)
   54: 	. I DITYPE["V" S DIROOT=$P(DINTERNL,";",2),DINEXT=""
   55: 10	. S DIHEAD=$G(@(U_DIROOT_"0)")) ;***** Naked Set *****
   56: 	. I DIHEAD="" D  Q
   57: 	. . D HEADER(DIFILE,DIEN,DIFIELD,DITYPE,DICHAIN,DINTERNL,DINEXT)
   58: 	. I DITYPE["V" S DINEXT=$P(DIHEAD,U,2) I +DINEXT'=DINEXT D  Q
   59: 	. . D ERR(DIMSGA,404,"","","",$$CREF^DILF(U_DIROOT))
   60: 	. I '$D(^(+DINTERNL)) D  Q  ;***** Naked *****
   61: 	. . N DI S DI="pointer to File #"
   62: 	. . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,DI_DINEXT) Q
   63: 	. . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,DI_DINEXT)
   64: 20	. S DIEN=+DINTERNL
   65: 	. S DIPREV=DIFILE,DIFILE=DINEXT
   66: 	. S DINTERNL=$P($G(^(DIEN,0)),U) ;***** Naked *****
   67: 	. I DINTERNL="" D ERR(DIMSGA,603,DIFILE,"",.01,DIEN) Q
   68: 	. S DINODE=$G(^DD(DIFILE,.01,0))
   69: 	. S DITYPE=$P(DINODE,U,2)
   70: 30	. I DITYPE="" D ERR(DIMSGA,510,DIFILE,"",.01) Q
   71: 	. S DIPREVF=DIFIELD,DIFIELD=.01
   72: 	. S DICHAIN=1
   73: 	I DIDONE Q DIEXTRNL
   74: BAD	
   75: 	I $G(DIERR) Q ""
   76: 	I DITYPE["C" D ERRPTR("Computed") Q ""
   77: 	I DITYPE["W" D ERRPTR("Word Processing") Q ""
   78: 	I DITYPE S DITYPE=$P($G(^DD(+DITYPE,.01,0)),U,2) D  Q ""
   79: 	. I DITYPE["W" D ERRPTR("Word Processing") Q
   80: 	. D ERRPTR("Multiple") Q
   81: CODES	
   82: 	I DITYPE["S" D  Q DIEXTRNL
   83: 	. N DICODES S DICODES=";"_$P(DINODE,U,3)
   84: 	. N DISTART S DISTART=$F(DICODES,";"_DINTERNL_":")
   85: 	. I 'DISTART S DIEXTRNL="" D  Q
   86: 	. . I 'DICHAIN D ERR(DIMSGA,730,DIFILE,"",DIFIELD,DINTERNL,"code") Q
   87: 	. . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,"code")
   88: 	. S DIEXTRNL=$P($E(DICODES,DISTART,$L(DICODES)),";")
   89: OTHER	
   90: 	I DITYPE["D",DINTERNL D  Q DIEXTRNL
   91: 	. S DIEXTRNL=$$FMTE^DILIBF(DINTERNL,"1U")
   92: 	. I DIEXTRNL'="" Q
   93: 	. I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"date") Q
   94: 	. D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"date")
   95: 	Q DINTERNL
   96: 	
   97: HEADER(DIFILE,DIEN,DIFIELD,DITYPE,DICHAIN,DINTERNL,DINEXT)	
   98: 	; CHAIN--pick a header error and log it
   99: 	; proc, all by val
  100: 	I DITYPE["P" D  Q
  101: 	. I 'DINEXT!'$D(^DD(DINEXT)) D ERR(DIMSGA,537,DIFILE,"",DIFIELD) Q
  102: 	. D ERR(DIMSGA,403,DINEXT)
  103: 	; otherwise, it's a variable pointer
  104: 	I DICHAIN D ERR(DIMSGA,648,DIFILE,"",DIFIELD,DIEN,DINTERNL) Q
  105: 	D ERR(DIMSGA,348,"","","",DINTERNL)
  106: 	Q
  107: 	
  108: ERR(DIMSGA,DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3)	
  109: 	; error logging procedure
  110: 	N DIPE
  111: 	N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
  112: 	D BLD^DIALOG(DIERN,.DIPE,.DIPE,DIMSGA,"F")
  113: 	Q
  114: 	
  115: ERRPTR(DITYPE)	
  116: 	; error logging shell for errors 520 & 537
  117: 	I DICHAIN D ERR(DIMSGA,537,DIPREV,"",DIPREVF) Q
  118: 	D ERR(DIMSGA,520,DIFILE,"",DIFIELD,DITYPE)
  119: 	Q