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