DIEFW ;SFISC/DPC-FILER WP ;22MAR2006
;;22.0;VA FileMan;**1,8,147**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
WP(DIEFF,DIEFIEN,DIEFFLD,DIEFWPFL,DIEFTSRC,DIEFOUT) ;
WPX ;
S DIEFWPFL=$G(DIEFWPFL)
I '$D(DIQUIET) N DIQUIET S DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
I DIEFIEN']"" D BLD^DIALOG(202,"IENS","IENS") G OUT
I '$$VERFLG^DIEFU(DIEFWPFL,"AZK") G OUT
I "@"'[DIEFTSRC I '$$VROOT^DIEFU(DIEFTSRC) G OUT
I '$$VFILE^DIEFU(DIEFF,"D") G OUT
I '$$VFIELD^DIEFU(DIEFF,DIEFFLD,"D") G OUT
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
I '$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D") G OUT
N DIEFNODE,DIEFSPOT S DIEFSPOT=" " D GLRF^DIOU(DIEFF,DIEFFLD,.DIEFNODE,.DIEFSPOT)
N DEPTH,I,D
S DEPTH=$L(DIEFIEN,",")-1
F I=DEPTH:-1:1 S D="D"_(DEPTH-I) N @D S @D=$P(DIEFIEN,",",I)
K DEPTH,D,I
N DIEFLOCK I DIEFWPFL["K" D G:'$D(DIEFLOCK) OUT
. S DIEFLOCK=DIEFNODE
. D LOCK^DILF(DIEFLOCK) E D ;**147
. . K DIEFLOCK
. . N EXT S EXT("FILE")=DIEFF,EXT("IENS")=DIEFIEN D BLD^DIALOG(110,"",.EXT)
D PUTWP(DIEFWPFL,DIEFTSRC,DIEFNODE)
I $D(DIEFLOCK) L -@DIEFLOCK
OUT I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
Q
;
PUTWP(DIEFWPFL,DIEFTSRC,DIEFNODE) ;
N BEGIN
I "@"[DIEFTSRC K @DIEFNODE Q
I '($D(@DIEFTSRC)\10) D BLD^DIALOG(305,DIEFTSRC,DIEFTSRC) Q
I $G(DIEFWPFL)'["A" S BEGIN=1 K @DIEFNODE
E S BEGIN=$$NUMLNS(DIEFNODE)+1 K:BEGIN=1 @DIEFNODE
I $D(@DIEFTSRC@($O(@DIEFTSRC@(0)),0))#2 S DIEFWPFL=$G(DIEFWPFL)_"Z"
N LINECNT,INLINE S INLINE=0
F LINECNT=BEGIN:1 S INLINE=$O(@DIEFTSRC@(INLINE)) Q:INLINE'=+$P(INLINE,"E") D
. I $G(DIEFWPFL)'["Z" S @DIEFNODE@(LINECNT,0)=$G(@DIEFTSRC@(INLINE))
. E S @DIEFNODE@(LINECNT,0)=$G(@DIEFTSRC@(INLINE,0))
S LINECNT=LINECNT-1
S @DIEFNODE@(0)=U_U_LINECNT_U_LINECNT_U_DT
Q
;
NUMLNS(DIWPROOT) ;
N DIWPLN
S DIWPLN=$P($G(@DIWPROOT@(0)),U,3)
Q:DIWPLN DIWPLN
S DIWPLN=$O(@DIWPROOT@(""),-1)
Q +DIWPLN
DIEFW ;SFISC/DPC-FILER WP ;22MAR2006
+1 ;;22.0;VA FileMan;**1,8,147**;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
WP(DIEFF,DIEFIEN,DIEFFLD,DIEFWPFL,DIEFTSRC,DIEFOUT) ;
WPX ;
+1 SET DIEFWPFL=$GET(DIEFWPFL)
+2 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+3 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
DO INIZE^DIEFU
+4 IF DIEFIEN']""
DO BLD^DIALOG(202,"IENS","IENS")
GOTO OUT
+5 IF '$$VERFLG^DIEFU(DIEFWPFL,"AZK")
GOTO OUT
+6 IF "@"'[DIEFTSRC
IF '$$VROOT^DIEFU(DIEFTSRC)
GOTO OUT
+7 IF '$$VFILE^DIEFU(DIEFF,"D")
GOTO OUT
+8 IF '$$VFIELD^DIEFU(DIEFF,DIEFFLD,"D")
GOTO OUT
+9 IF $PIECE($GET(^DD(+$PIECE(^DD(DIEFF,DIEFFLD,0),U,2),.01,0)),U,2)'["W"
NEW EI
SET EI("FILE")=DIEFF
SET EI("FIELD")=DIEFFLD
DO BLD^DIALOG(726,.EI,.EI)
GOTO OUT
+10 IF '$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D")
GOTO OUT
+11 NEW DIEFNODE,DIEFSPOT
SET DIEFSPOT=" "
DO GLRF^DIOU(DIEFF,DIEFFLD,.DIEFNODE,.DIEFSPOT)
+12 NEW DEPTH,I,D
+13 SET DEPTH=$LENGTH(DIEFIEN,",")-1
+14 FOR I=DEPTH:-1:1
SET D="D"_(DEPTH-I)
NEW @D
SET @D=$PIECE(DIEFIEN,",",I)
+15 KILL DEPTH,D,I
+16 NEW DIEFLOCK
IF DIEFWPFL["K"
Begin DoDot:1
+17 SET DIEFLOCK=DIEFNODE
+18 ;**147
DO LOCK^DILF(DIEFLOCK)
IF '$TEST
Begin DoDot:2
+19 KILL DIEFLOCK
+20 NEW EXT
SET EXT("FILE")=DIEFF
SET EXT("IENS")=DIEFIEN
DO BLD^DIALOG(110,"",.EXT)
End DoDot:2
End DoDot:1
IF '$DATA(DIEFLOCK)
GOTO OUT
+21 DO PUTWP(DIEFWPFL,DIEFTSRC,DIEFNODE)
+22 IF $DATA(DIEFLOCK)
LOCK -@DIEFLOCK
OUT IF $GET(DIEFOUT)]""
DO CALLOUT^DIEFU(DIEFOUT)
+1 QUIT
+2 ;
PUTWP(DIEFWPFL,DIEFTSRC,DIEFNODE) ;
+1 NEW BEGIN
+2 IF "@"[DIEFTSRC
KILL @DIEFNODE
QUIT
+3 IF '($DATA(@DIEFTSRC)\10)
DO BLD^DIALOG(305,DIEFTSRC,DIEFTSRC)
QUIT
+4 IF $GET(DIEFWPFL)'["A"
SET BEGIN=1
KILL @DIEFNODE
+5 IF '$TEST
SET BEGIN=$$NUMLNS(DIEFNODE)+1
IF BEGIN=1
KILL @DIEFNODE
+6 IF $DATA(@DIEFTSRC@($ORDER(@DIEFTSRC@(0)),0))#2
SET DIEFWPFL=$GET(DIEFWPFL)_"Z"
+7 NEW LINECNT,INLINE
SET INLINE=0
+8 FOR LINECNT=BEGIN:1
SET INLINE=$ORDER(@DIEFTSRC@(INLINE))
IF INLINE'=+$PIECE(INLINE,"E")
QUIT
Begin DoDot:1
+9 IF $GET(DIEFWPFL)'["Z"
SET @DIEFNODE@(LINECNT,0)=$GET(@DIEFTSRC@(INLINE))
+10 IF '$TEST
SET @DIEFNODE@(LINECNT,0)=$GET(@DIEFTSRC@(INLINE,0))
End DoDot:1
+11 SET LINECNT=LINECNT-1
+12 SET @DIEFNODE@(0)=U_U_LINECNT_U_LINECNT_U_DT
+13 QUIT
+14 ;
NUMLNS(DIWPROOT) ;
+1 NEW DIWPLN
+2 SET DIWPLN=$PIECE($GET(@DIWPROOT@(0)),U,3)
+3 IF DIWPLN
QUIT DIWPLN
+4 SET DIWPLN=$ORDER(@DIWPROOT@(""),-1)
+5 QUIT +DIWPLN
