freem_fileman/USER/DIDU.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DIDU.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (5 weeks, 5 days ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

DIDU ;SEA/TOAD-VA FileMan: DD Tools, Format ;12/1/94 16:35 ;;21.0;VA FileMan;;Dec 28, 1994 ;Per VHA Directive 10-93-142, this routine should not be modified. EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIMSGA) XTRNLX ; Branch from DILFD or DIQGU ; ENTRY POINT--convert DINTERNL to external format ; func, all passed by value I '$D(DIQUIET) N DIQUIET S DIQUIET=1 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU INPUT I $G(DINTERNL)="" Q "" S DIMSGA=$G(DIMSGA) I DIMSGA'="" D . K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG") S DIFILE=$G(DIFILE) I DIFILE'>0 D ERR(DIMSGA,202,"","","","FILE") Q "" S DIFLAGS=$G(DIFLAGS) I DIFLAGS'?.1(1"F",1"L",1"U") D ERR(DIMSGA,301,"","","",DIFLAGS) Q "" S DIFIELD=$G(DIFIELD) I DIFIELD'>0 D ERR(DIMSGA,202,"","","","FIELD") Q "" PREP N DICHAIN,DIDONE,DIEN,DIEXTRNL N DIHEAD,DINEXT,DINODE,DIOUT,DIROOT,DITYPE,DIXFORM S DICHAIN=0,DIDONE=0,DIEN="",DIEXTRNL="" S DIHEAD="",DINEXT="",DIOUT=0,DIXFORM="" N DIPREV S DIPREV="" N DIPREVF S DIPREVF="" I '$D(^DD(DIFILE)) D ERR(DIMSGA,401,DIFILE) Q "" S DINODE=$G(^DD(DIFILE,DIFIELD,0)) I DINODE="" D ERR(DIMSGA,501,DIFILE,"",DIFIELD,DIFIELD) Q "" S DITYPE=$P(DINODE,U,2) RESOLVE F D I DIDONE!$G(DIERR)!DIOUT Q XFORM . . I DIFLAGS["U",DIXFORM'="",DITYPE'["P",DITYPE'["V" S DITYPE=DITYPE_"O" . I DITYPE["O" D I DIDONE!$G(DIERR) Q . . I DIFLAGS["F",DICHAIN Q . . I DIFLAGS["L",DITYPE["P"!(DITYPE["V") Q . . I DIXFORM=""!(DIFLAGS'["U") S DIXFORM=$G(^DD(DIFILE,DIFIELD,2)) . . I DIXFORM="" Q . . I DIFLAGS["U",DITYPE["P"!(DITYPE["V") Q . . N Y S Y=DINTERNL . . X DIXFORM . . I $G(DIERR) D ERR^DICF6(120,DIFILE,DIEN,"","Output Transform") Q . . S DIEXTRNL=Y . . S DIDONE=1 CHAIN . . I DITYPE S DIOUT=1 Q . I DITYPE'["P",DITYPE'["V" S DIOUT=1 Q . I 'DINTERNL D Q . . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"pointer") Q . . D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"pointer") . I DITYPE["P" S DIROOT=$P(DINODE,U,3),DINEXT=+$P($P(DINODE,U,2),"P",2) . I DITYPE["V" S DIROOT=$P(DINTERNL,";",2),DINEXT="" 10 . S DIHEAD=$G(@(U_DIROOT_"0)")) ;***** Naked Set ***** . I DIHEAD="" D Q . . D HEADER(DIFILE,DIEN,DIFIELD,DITYPE,DICHAIN,DINTERNL,DINEXT) . I DITYPE["V" S DINEXT=$P(DIHEAD,U,2) I +DINEXT'=DINEXT D Q . . D ERR(DIMSGA,404,"","","",$$CREF^DILF(U_DIROOT)) . I '$D(^(+DINTERNL)) D Q ;***** Naked ***** . . N DI S DI="pointer to File #" . . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,DI_DINEXT) Q . . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,DI_DINEXT) 20 . S DIEN=+DINTERNL . S DIPREV=DIFILE,DIFILE=DINEXT . S DINTERNL=$P($G(^(DIEN,0)),U) ;***** Naked ***** . I DINTERNL="" D ERR(DIMSGA,603,DIFILE,"",.01,DIEN) Q . S DINODE=$G(^DD(DIFILE,.01,0)) . S DITYPE=$P(DINODE,U,2) 30 . I DITYPE="" D ERR(DIMSGA,510,DIFILE,"",.01) Q . S DIPREVF=DIFIELD,DIFIELD=.01 . S DICHAIN=1 I DIDONE Q DIEXTRNL BAD I $G(DIERR) Q "" I DITYPE["C" D ERRPTR("Computed") Q "" I DITYPE["W" D ERRPTR("Word Processing") Q "" I DITYPE S DITYPE=$P($G(^DD(+DITYPE,.01,0)),U,2) D Q "" . I DITYPE["W" D ERRPTR("Word Processing") Q . D ERRPTR("Multiple") Q CODES I DITYPE["S" D Q DIEXTRNL . N DICODES S DICODES=";"_$P(DINODE,U,3) . N DISTART S DISTART=$F(DICODES,";"_DINTERNL_":") . I 'DISTART S DIEXTRNL="" D Q . . I 'DICHAIN D ERR(DIMSGA,730,DIFILE,"",DIFIELD,DINTERNL,"code") Q . . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,"code") . S DIEXTRNL=$P($E(DICODES,DISTART,$L(DICODES)),";") OTHER I DITYPE["D",DINTERNL D Q DIEXTRNL . S DIEXTRNL=$$FMTE^DILIBF(DINTERNL,"1U") . I DIEXTRNL'="" Q . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"date") Q . D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"date") Q DINTERNL HEADER(DIFILE,DIEN,DIFIELD,DITYPE,DICHAIN,DINTERNL,DINEXT) ; CHAIN--pick a header error and log it ; proc, all by val I DITYPE["P" D Q . I 'DINEXT!'$D(^DD(DINEXT)) D ERR(DIMSGA,537,DIFILE,"",DIFIELD) Q . D ERR(DIMSGA,403,DINEXT) ; otherwise, it's a variable pointer I DICHAIN D ERR(DIMSGA,648,DIFILE,"",DIFIELD,DIEN,DINTERNL) Q D ERR(DIMSGA,348,"","","",DINTERNL) Q ERR(DIMSGA,DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3) ; error logging procedure N DIPE N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI)) D BLD^DIALOG(DIERN,.DIPE,.DIPE,DIMSGA,"F") Q ERRPTR(DITYPE) ; error logging shell for errors 520 & 537 I DICHAIN D ERR(DIMSGA,537,DIPREV,"",DIPREVF) Q D ERR(DIMSGA,520,DIFILE,"",DIFIELD,DITYPE) Q