- DIEFW ;SFISC/DPC-FILER WP ;22MAR2006
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- WP(DIEFF,DIEFIEN,DIEFFLD,DIEFWPFL,DIEFTSRC,DIEFOUT) ;(FILE,IENS,FIELD,FLAGS,wp_root,msg_root)
- 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 D WP^DIET(DIEFF,DIEFFLD,DIEFIEN,DIEFNODE)
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIEFW 2299 printed Feb 19, 2025@00:13:24 Page 2
- DIEFW ;SFISC/DPC-FILER WP ;22MAR2006
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- WP(DIEFF,DIEFIEN,DIEFFLD,DIEFWPFL,DIEFTSRC,DIEFOUT) ;(FILE,IENS,FIELD,FLAGS,wp_root,msg_root)
- 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
- DO WP^DIET(DIEFF,DIEFFLD,DIEFIEN,DIEFNODE)
- +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