source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICA3.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1DICA3 ;SEA/TOAD-VA FileMan: Updater, Adder ;22MAR2006
2 ;;22.0;VA FileMan;**147**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CREATE(DIFILE,DIEN,DIROOT,DIVALUE) ;
6 N DIENP S DIENP=","_$P(DIEN,",",2,999)
7 S DIEN=$P(DIEN,",")
8 N DINEXT S DINEXT=$P($G(@(DIROOT_"0)")),U,3)
9 I DINEXT="" D I $G(DIERR) S DIEN="" Q
10 . N DIHEADER S DIHEADER=$$HEADER^DIDU2(.DIFILE,DIENP)
11 . I '$G(DIERR) S @(DIROOT_"0)")=DIHEADER
12GETNUM ;
13 N DINUM S DINUM=DIEN'="" I 'DINUM S DIEN=DINEXT\1
14 N DIFAIL,DIOUT S DIFAIL=0,DIOUT=0 F D I DIOUT!DIFAIL Q
15 . I 'DINUM S DIEN=DIEN+1
16 . D LOCK^DILF(DIROOT_"DIEN)") ;**147
17 . I '$T S DIFAIL=DINUM Q:'DIFAIL D ERR(110,DIFILE,DIEN_DIENP) Q
18 . I $D(@(DIROOT_"DIEN)")) L -@(DIROOT_"DIEN)") D Q
19 . . S DIFAIL=DINUM I 'DIFAIL Q
20 . . D ERR(302,DIFILE,DIEN_DIENP)
21 . S DIOUT=1
22 I DIFAIL S DIEN="" Q
23SETREC ;
24 N DICAFILE M DICAFILE=DIFILE N DIFILE
25 S @(DIROOT_"DIEN,0)")=DIVALUE
26 D LOCK^DILF(DIROOT_"0)") ;**147
27 S $P(^(0),U,3,4)=DIEN_U_($P(@(DIROOT_"0)"),U,4)+1)
28 I L -@(DIROOT_"0)")
29 S DIEN=DIEN_DIENP
30 D XA^DIEFU(DICAFILE,DIEN,.01,DIVALUE,"")
31 D INDEX^DIKC(DICAFILE,DIEN,.01,"","SC")
32 Q
33 ;
34PROOT(DIFILE,DIEN) ;
35 ; ENTRY POINT--return the global root of a subfile's parent
36 ; extrinsic function, all passed by value
37 N DIENP S DIENP=$P(DIEN,",",2,999)
38 Q $NA(@$$ROOT^DILFD($$PARENT(DIFILE),DIENP,1)@(+DIENP))
39 ;
40PARENT(DIFILE) ;
41 ; ENTRY POINT--return the file number of a subfile's parent
42 ; extrinsic function, all passed by value
43 Q $G(^DD(DIFILE,0,"UP"))
44 ;
45SUBFILE(DIFILE) ;
46 ; ENTRY POINT--return whether the file is a subfile
47 ; extrinsic function, passed by value
48 Q $D(^DD(DIFILE,0,"UP"))#2
49 ;
50ERR(DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3) ;
51 ; error logging procedure
52 N DIPE
53 N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
54 D BLD^DIALOG(DIERN,.DIPE,.DIPE)
55 Q
Note: See TracBrowser for help on using the repository browser.