source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIEFW.m@ 619

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1DIEFW ;SFISC/DPC-FILER WP ;22MAR2006
2 ;;22.0;VA FileMan;**1,8,147**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4WP(DIEFF,DIEFIEN,DIEFFLD,DIEFWPFL,DIEFTSRC,DIEFOUT) ;
5WPX ;
6 S DIEFWPFL=$G(DIEFWPFL)
7 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
8 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
9 I DIEFIEN']"" D BLD^DIALOG(202,"IENS","IENS") G OUT
10 I '$$VERFLG^DIEFU(DIEFWPFL,"AZK") G OUT
11 I "@"'[DIEFTSRC I '$$VROOT^DIEFU(DIEFTSRC) G OUT
12 I '$$VFILE^DIEFU(DIEFF,"D") G OUT
13 I '$$VFIELD^DIEFU(DIEFF,DIEFFLD,"D") G OUT
14 I $P($G(^DD(+$P(^DD(DIEFF,DIEFFLD,0),U,2),.01,0)),U,2)'["W" N EI S EI("FILE")=DIEFF,EI("FIELD")=DIEFFLD D BLD^DIALOG(726,.EI,.EI) G OUT
15 I '$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D") G OUT
16 N DIEFNODE,DIEFSPOT S DIEFSPOT=" " D GLRF^DIOU(DIEFF,DIEFFLD,.DIEFNODE,.DIEFSPOT)
17 N DEPTH,I,D
18 S DEPTH=$L(DIEFIEN,",")-1
19 F I=DEPTH:-1:1 S D="D"_(DEPTH-I) N @D S @D=$P(DIEFIEN,",",I)
20 K DEPTH,D,I
21 N DIEFLOCK I DIEFWPFL["K" D G:'$D(DIEFLOCK) OUT
22 . S DIEFLOCK=DIEFNODE
23 . D LOCK^DILF(DIEFLOCK) E D ;**147
24 . . K DIEFLOCK
25 . . N EXT S EXT("FILE")=DIEFF,EXT("IENS")=DIEFIEN D BLD^DIALOG(110,"",.EXT)
26 D PUTWP(DIEFWPFL,DIEFTSRC,DIEFNODE)
27 I $D(DIEFLOCK) L -@DIEFLOCK
28OUT I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
29 Q
30 ;
31PUTWP(DIEFWPFL,DIEFTSRC,DIEFNODE) ;
32 N BEGIN
33 I "@"[DIEFTSRC K @DIEFNODE Q
34 I '($D(@DIEFTSRC)\10) D BLD^DIALOG(305,DIEFTSRC,DIEFTSRC) Q
35 I $G(DIEFWPFL)'["A" S BEGIN=1 K @DIEFNODE
36 E S BEGIN=$$NUMLNS(DIEFNODE)+1 K:BEGIN=1 @DIEFNODE
37 I $D(@DIEFTSRC@($O(@DIEFTSRC@(0)),0))#2 S DIEFWPFL=$G(DIEFWPFL)_"Z"
38 N LINECNT,INLINE S INLINE=0
39 F LINECNT=BEGIN:1 S INLINE=$O(@DIEFTSRC@(INLINE)) Q:INLINE'=+$P(INLINE,"E") D
40 . I $G(DIEFWPFL)'["Z" S @DIEFNODE@(LINECNT,0)=$G(@DIEFTSRC@(INLINE))
41 . E S @DIEFNODE@(LINECNT,0)=$G(@DIEFTSRC@(INLINE,0))
42 S LINECNT=LINECNT-1
43 S @DIEFNODE@(0)=U_U_LINECNT_U_LINECNT_U_DT
44 Q
45 ;
46NUMLNS(DIWPROOT) ;
47 N DIWPLN
48 S DIWPLN=$P($G(@DIWPROOT@(0)),U,3)
49 Q:DIWPLN DIWPLN
50 S DIWPLN=$O(@DIWPROOT@(""),-1)
51 Q +DIWPLN
Note: See TracBrowser for help on using the repository browser.