DDMPSM ;SFISC/DPC-IMPORT SCREENMAN CALLS ;9/20/96 10:07
;;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.
;
FILESEL ;
; Called form Post-actin on change of Primary File prompt
D PUT^DDSVALF("TMP_NM",1,1,"")
I DDSOLD'="",$D(DDMPFDSL) S DDMPOLDF=DDSOLD,DDSBR="3^1^3"
E D
. K DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPCF,DDMPFDNM
. S DDMPF=X
. S DDMPFLNM=DDSEXT
. D UNED^DDSUTL("FLD_JUMP",1,1,$S(X:0,1:1))
. D UNED^DDSUTL("TMP_NM",1,1,$S(X:0,1:1))
. D REFRESH^DDSUTL
Q
;
TMPLSCR(DDMPSELF,DDSEXT,DUZ) ;
;called from TMP_NM field.
;DDMPSELF = currently selected primary file.
;DDMPEXT = External value of selected template.
I $P(^(0),U,4)'=DDMPSELF Q 0
I DUZ(0)["@" Q 1
N DDMPRDAC,DDMPI,DDMPOK
S DDMPRDAC=$P(^(0),U,3),DDMPOK=0
F DDMPI=1:1:$L(DDMPRDAC) I DUZ(0)[$E(DDMPRDAC,DDMPI) S DDMPOK=1 Q
Q DDMPOK
;
CHNGFILE ;
;Called for Post-action on pop-up file change verification page.
I X D ;code for changing selected file.
. K DDMPFDSL,DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPCF,DDMPFDNM
. S (DDMPOSET,DDMPFDCT)=0
. S DDMPF=$$GET^DDSVALF("F_SEL",1,1)
. S DDMPFLNM=$$GET^DDSVALF("F_SEL",1,1,"E")
. I DDMPF="" D UNED^DDSUTL("FLD_JUMP",1,1,1),UNED^DDSUTL("TMP_NM",1,1,1)
. S DDSBR="FLD_JUMP^1^1"
. ;D REFRESH^DDSUTL
E D
. D PUT^DDSVALF("F_SEL",1,1,DDMPOLDF,"I")
. S DDSBR="F_SEL^1^1"
Q
;
IXF ;
;Called from input transform of Field Selection field.
N D0,DA,DIC,DP,Y S DIC="^DD("_DDMPCF_",",DIC(0)="ENZ" D ^DIC
I Y'>0 K X
E S (X,DDMPX)=+$P(Y,"E"),DDMPFDNM=Y(0,0)
Q
;
FDPROC ;
;Called from post-action on change of Field Selection prompt.
N DDMP0P2
S DDMP0P2=$P(^DD(DDMPCF,DDMPX,0),U,2)
I +DDMP0P2 D
. S DDSBR="FLD"
. I 'DDMPFDCT D HLP^DDSUTL($C(7)_"You must select a field in the top level file before entering multiple.") Q
. N DDMPI,DDMPOK
. F DDMPI=1:1:DDMPFDCT I $P(DDMPFDSL(DDMPI),U,$L(DDMPFDSL(DDMPI),U))=DDMPCF S DDMPOK=1 Q
. I '$G(DDMPOK) D HLP^DDSUTL($C(7)_"You must select a field in a subfile before entering one of its multiples.") Q
. S DDMPFCAP=$$PATHNM(+DDMP0P2,DDMPFLNM)
. S DDMPCPTH=$S($L($G(DDMPCPTH)):DDMPCPTH_":",1:"")_DDMPX_U_DDMPCF
. S DDMPCF=+DDMP0P2
. S DDMPCPNM=$S($L($G(DDMPCPNM)):DDMPCPNM_":",1:"")_DDMPFDNM
E D
. S DDMPFDCT=DDMPFDCT+1
. S DDMPFDSL(DDMPFDCT)=$S($L($G(DDMPCPTH)):DDMPCPTH_":",1:"")_DDMPX_U_DDMPCF
. S DDMPFDSL("CAP",DDMPFDCT)=$S($L($G(DDMPCPNM)):DDMPCPNM_":",1:"")_DDMPFDNM
. S DDMPOSET=$S(DDMPFDCT>9:DDMPFDCT-9,1:0)
. S DDSBR=$S($G(DDMPSMFF("FIXED"))="YES":"LEN",1:"FLD")
Q
;
PATHNM(DDMPSFNO,DDMPFLNM) ;
N DDMPPATH S DDMPPATH=""
I $D(^DD(DDMPSFNO,0,"UP")) F D Q:'$D(^DD(DDMPSFNO,0,"UP"))
. S DDMPPATH=" : "_$P($P(^DD(DDMPSFNO,0),U),"SUB-FIELD")_"Subfile"_DDMPPATH
. S DDMPSFNO=^DD(DDMPSFNO,0,"UP")
Q $G(DDMPFLNM,$P(^DIC(DDMPSFNO,0),U))_DDMPPATH
;
UP1 ;
;Called from post-action on Field Selection prompt if null entered.
S DDMPFCAP=$P($G(DDMPFCAP)," : ",1,$L($G(DDMPFCAP)," : ")-1)
S DDMPCF=$P(DDMPCPTH,U,$L(DDMPCPTH,U))
S DDMPCPTH=$P(DDMPCPTH,":",1,$L(DDMPCPTH,":")-1)
S DDMPCPNM=$P(DDMPCPNM,":",1,$L(DDMPCPNM,":")-1)
Q
;
DELFLD ;
;Called from post-action on change of the "Do you want to delete" prompt
I DDMPFDCT=0 Q
N DDMPL S DDMPL=$L($G(DDMPFDSL(DDMPFDCT-1)),":")
I DDMPL=1 D
. S DDMPCF=DDMPF
. S DDMPFCAP=DDMPFLNM
. S (DDMPCPNM,DDMPCPTH)=""
E D
. S DDMPCF=$P(DDMPFDSL(DDMPFDCT-1),U,$L(DDMPFDSL(DDMPFDCT-1),U))
. S DDMPFCAP=$$PATHNM(+DDMPCF,DDMPFLNM)
. S DDMPCPTH=$P(DDMPFDSL(DDMPFDCT-1),":",1,DDMPL-1)
. S DDMPCPNM=$P(DDMPFDSL("CAP",DDMPFDCT-1),":",1,DDMPL-1)
K DDMPFDSL(DDMPFDCT),DDMPFDSL("CAP",DDMPFDCT),DDMPFDSL("LN",DDMPFDCT)
S DDMPFDCT=DDMPFDCT-1
I DDMPOSET S DDMPOSET=DDMPOSET-1
Q
;
;
VAL ;
;Called from form level validation.
N DDMPMSG
;1)Validate format of import.
I (($G(DDMPSMFF("FIXED"))="YES")&($G(DDMPSMFF("FDELIM"))'=""))!(($G(DDMPSMFF("FIXED"))'="YES")&($G(DDMPSMFF("FDELIM"))="")) D G VALERR
. D BLD^DIALOG(1821)
. S DDSERROR=2
. S DDSBR="FOR_FMT^1^1"
. D MSG^DIALOG("AE",.DDMPMSG)
;
;2) If file specified, move fields selected into DR(). Look for DIERRs created during move.
I $G(DDMPF)]"" D
. I $$GET^DDSVALF("TMP_NM",1,1)]"" D
. . S DDMPFDSL=$$GET^DDSVALF("TMP_NM",1,1,"E")
. . D TMPL2SQ^DDMP1(DDMPF,.DDMPFDSL)
. I '$D(DDMPFDSL(1)) D Q
. . S DDSERROR=$G(DDSERROR)+1
. . S DDMPMSG(DDSERROR)="You must specify some fields into which to import data."
. . S DDSBR="FLD_JUMP^1^1"
. K DDMPDR
. S DDMPFDSL=1
. N DDMPDIER S DDMPDIER=$G(DIERR)
. D TODR^DDMP1(DDMPF,.DDMPFDSL,.DDMPDR)
. I $G(DIERR)>DDMPDIER D
. . S DDSERROR=$G(DDSERROR)+DIERR
. . D MSG^DIALOG("AE",.DDMPMSG)
. . S DDSBR="2.2^1^2"
. . K DDMPDR
;
VALERR I $G(DDSERROR) D MSG^DDSUTL(.DDMPMSG) Q
Q
;
FF ;
;Called from post-action on change of the Foreign Format field.
N DDMPI
I X'="" D
. S DDMPSMFF=DDSEXT
. S DDMPSMFF("IEN")=X
. S DDMPSMFF("FDELIM")=$$GET1^DIQ(.44,X_",",1)
. S DDMPSMFF("FIXED")=$$GET1^DIQ(.44,X_",",5)
. S DDMPSMFF("QUOTED")=$$GET1^DIQ(.44,X_",",8)
. F DDMPI="FIX","FLD_DLM","QUOTE" D
. . D PUT^DDSVALF(DDMPI,1,1,"")
. . D UNED^DDSUTL(DDMPI,1,1,1)
E D
. K DDMPSMFF
. F DDMPI="FIX","FLD_DLM","QUOTE" D UNED^DDSUTL(DDMPI,1,1,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDMPSM 5501 printed Nov 22, 2024@17:52:43 Page 2
DDMPSM ;SFISC/DPC-IMPORT SCREENMAN CALLS ;9/20/96 10:07
+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 ;
FILESEL ;
+1 ; Called form Post-actin on change of Primary File prompt
+2 DO PUT^DDSVALF("TMP_NM",1,1,"")
+3 IF DDSOLD'=""
IF $DATA(DDMPFDSL)
SET DDMPOLDF=DDSOLD
SET DDSBR="3^1^3"
+4 IF '$TEST
Begin DoDot:1
+5 KILL DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPCF,DDMPFDNM
+6 SET DDMPF=X
+7 SET DDMPFLNM=DDSEXT
+8 DO UNED^DDSUTL("FLD_JUMP",1,1,$SELECT(X:0,1:1))
+9 DO UNED^DDSUTL("TMP_NM",1,1,$SELECT(X:0,1:1))
+10 DO REFRESH^DDSUTL
End DoDot:1
+11 QUIT
+12 ;
TMPLSCR(DDMPSELF,DDSEXT,DUZ) ;
+1 ;called from TMP_NM field.
+2 ;DDMPSELF = currently selected primary file.
+3 ;DDMPEXT = External value of selected template.
+4 IF $PIECE(^(0),U,4)'=DDMPSELF
QUIT 0
+5 IF DUZ(0)["@"
QUIT 1
+6 NEW DDMPRDAC,DDMPI,DDMPOK
+7 SET DDMPRDAC=$PIECE(^(0),U,3)
SET DDMPOK=0
+8 FOR DDMPI=1:1:$LENGTH(DDMPRDAC)
IF DUZ(0)[$EXTRACT(DDMPRDAC,DDMPI)
SET DDMPOK=1
QUIT
+9 QUIT DDMPOK
+10 ;
CHNGFILE ;
+1 ;Called for Post-action on pop-up file change verification page.
+2 ;code for changing selected file.
IF X
Begin DoDot:1
+3 KILL DDMPFDSL,DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPCF,DDMPFDNM
+4 SET (DDMPOSET,DDMPFDCT)=0
+5 SET DDMPF=$$GET^DDSVALF("F_SEL",1,1)
+6 SET DDMPFLNM=$$GET^DDSVALF("F_SEL",1,1,"E")
+7 IF DDMPF=""
DO UNED^DDSUTL("FLD_JUMP",1,1,1)
DO UNED^DDSUTL("TMP_NM",1,1,1)
+8 SET DDSBR="FLD_JUMP^1^1"
+9 ;D REFRESH^DDSUTL
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 DO PUT^DDSVALF("F_SEL",1,1,DDMPOLDF,"I")
+12 SET DDSBR="F_SEL^1^1"
End DoDot:1
+13 QUIT
+14 ;
IXF ;
+1 ;Called from input transform of Field Selection field.
+2 NEW D0,DA,DIC,DP,Y
SET DIC="^DD("_DDMPCF_","
SET DIC(0)="ENZ"
DO ^DIC
+3 IF Y'>0
KILL X
+4 IF '$TEST
SET (X,DDMPX)=+$PIECE(Y,"E")
SET DDMPFDNM=Y(0,0)
+5 QUIT
+6 ;
FDPROC ;
+1 ;Called from post-action on change of Field Selection prompt.
+2 NEW DDMP0P2
+3 SET DDMP0P2=$PIECE(^DD(DDMPCF,DDMPX,0),U,2)
+4 IF +DDMP0P2
Begin DoDot:1
+5 SET DDSBR="FLD"
+6 IF 'DDMPFDCT
DO HLP^DDSUTL($CHAR(7)_"You must select a field in the top level file before entering multiple.")
QUIT
+7 NEW DDMPI,DDMPOK
+8 FOR DDMPI=1:1:DDMPFDCT
IF $PIECE(DDMPFDSL(DDMPI),U,$LENGTH(DDMPFDSL(DDMPI),U))=DDMPCF
SET DDMPOK=1
QUIT
+9 IF '$GET(DDMPOK)
DO HLP^DDSUTL($CHAR(7)_"You must select a field in a subfile before entering one of its multiples.")
QUIT
+10 SET DDMPFCAP=$$PATHNM(+DDMP0P2,DDMPFLNM)
+11 SET DDMPCPTH=$SELECT($LENGTH($GET(DDMPCPTH)):DDMPCPTH_":",1:"")_DDMPX_U_DDMPCF
+12 SET DDMPCF=+DDMP0P2
+13 SET DDMPCPNM=$SELECT($LENGTH($GET(DDMPCPNM)):DDMPCPNM_":",1:"")_DDMPFDNM
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 SET DDMPFDCT=DDMPFDCT+1
+16 SET DDMPFDSL(DDMPFDCT)=$SELECT($LENGTH($GET(DDMPCPTH)):DDMPCPTH_":",1:"")_DDMPX_U_DDMPCF
+17 SET DDMPFDSL("CAP",DDMPFDCT)=$SELECT($LENGTH($GET(DDMPCPNM)):DDMPCPNM_":",1:"")_DDMPFDNM
+18 SET DDMPOSET=$SELECT(DDMPFDCT>9:DDMPFDCT-9,1:0)
+19 SET DDSBR=$SELECT($GET(DDMPSMFF("FIXED"))="YES":"LEN",1:"FLD")
End DoDot:1
+20 QUIT
+21 ;
PATHNM(DDMPSFNO,DDMPFLNM) ;
+1 NEW DDMPPATH
SET DDMPPATH=""
+2 IF $DATA(^DD(DDMPSFNO,0,"UP"))
FOR
Begin DoDot:1
+3 SET DDMPPATH=" : "_$PIECE($PIECE(^DD(DDMPSFNO,0),U),"SUB-FIELD")_"Subfile"_DDMPPATH
+4 SET DDMPSFNO=^DD(DDMPSFNO,0,"UP")
End DoDot:1
if '$DATA(^DD(DDMPSFNO,0,"UP"))
QUIT
+5 QUIT $GET(DDMPFLNM,$PIECE(^DIC(DDMPSFNO,0),U))_DDMPPATH
+6 ;
UP1 ;
+1 ;Called from post-action on Field Selection prompt if null entered.
+2 SET DDMPFCAP=$PIECE($GET(DDMPFCAP)," : ",1,$LENGTH($GET(DDMPFCAP)," : ")-1)
+3 SET DDMPCF=$PIECE(DDMPCPTH,U,$LENGTH(DDMPCPTH,U))
+4 SET DDMPCPTH=$PIECE(DDMPCPTH,":",1,$LENGTH(DDMPCPTH,":")-1)
+5 SET DDMPCPNM=$PIECE(DDMPCPNM,":",1,$LENGTH(DDMPCPNM,":")-1)
+6 QUIT
+7 ;
DELFLD ;
+1 ;Called from post-action on change of the "Do you want to delete" prompt
+2 IF DDMPFDCT=0
QUIT
+3 NEW DDMPL
SET DDMPL=$LENGTH($GET(DDMPFDSL(DDMPFDCT-1)),":")
+4 IF DDMPL=1
Begin DoDot:1
+5 SET DDMPCF=DDMPF
+6 SET DDMPFCAP=DDMPFLNM
+7 SET (DDMPCPNM,DDMPCPTH)=""
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET DDMPCF=$PIECE(DDMPFDSL(DDMPFDCT-1),U,$LENGTH(DDMPFDSL(DDMPFDCT-1),U))
+10 SET DDMPFCAP=$$PATHNM(+DDMPCF,DDMPFLNM)
+11 SET DDMPCPTH=$PIECE(DDMPFDSL(DDMPFDCT-1),":",1,DDMPL-1)
+12 SET DDMPCPNM=$PIECE(DDMPFDSL("CAP",DDMPFDCT-1),":",1,DDMPL-1)
End DoDot:1
+13 KILL DDMPFDSL(DDMPFDCT),DDMPFDSL("CAP",DDMPFDCT),DDMPFDSL("LN",DDMPFDCT)
+14 SET DDMPFDCT=DDMPFDCT-1
+15 IF DDMPOSET
SET DDMPOSET=DDMPOSET-1
+16 QUIT
+17 ;
+18 ;
VAL ;
+1 ;Called from form level validation.
+2 NEW DDMPMSG
+3 ;1)Validate format of import.
+4 IF (($GET(DDMPSMFF("FIXED"))="YES")&($GET(DDMPSMFF("FDELIM"))'=""))!(($GET(DDMPSMFF("FIXED"))'="YES")&($GET(DDMPSMFF("FDELIM"))=""))
Begin DoDot:1
+5 DO BLD^DIALOG(1821)
+6 SET DDSERROR=2
+7 SET DDSBR="FOR_FMT^1^1"
+8 DO MSG^DIALOG("AE",.DDMPMSG)
End DoDot:1
GOTO VALERR
+9 ;
+10 ;2) If file specified, move fields selected into DR(). Look for DIERRs created during move.
+11 IF $GET(DDMPF)]""
Begin DoDot:1
+12 IF $$GET^DDSVALF("TMP_NM",1,1)]""
Begin DoDot:2
+13 SET DDMPFDSL=$$GET^DDSVALF("TMP_NM",1,1,"E")
+14 DO TMPL2SQ^DDMP1(DDMPF,.DDMPFDSL)
End DoDot:2
+15 IF '$DATA(DDMPFDSL(1))
Begin DoDot:2
+16 SET DDSERROR=$GET(DDSERROR)+1
+17 SET DDMPMSG(DDSERROR)="You must specify some fields into which to import data."
+18 SET DDSBR="FLD_JUMP^1^1"
End DoDot:2
QUIT
+19 KILL DDMPDR
+20 SET DDMPFDSL=1
+21 NEW DDMPDIER
SET DDMPDIER=$GET(DIERR)
+22 DO TODR^DDMP1(DDMPF,.DDMPFDSL,.DDMPDR)
+23 IF $GET(DIERR)>DDMPDIER
Begin DoDot:2
+24 SET DDSERROR=$GET(DDSERROR)+DIERR
+25 DO MSG^DIALOG("AE",.DDMPMSG)
+26 SET DDSBR="2.2^1^2"
+27 KILL DDMPDR
End DoDot:2
End DoDot:1
+28 ;
VALERR IF $GET(DDSERROR)
DO MSG^DDSUTL(.DDMPMSG)
QUIT
+1 QUIT
+2 ;
FF ;
+1 ;Called from post-action on change of the Foreign Format field.
+2 NEW DDMPI
+3 IF X'=""
Begin DoDot:1
+4 SET DDMPSMFF=DDSEXT
+5 SET DDMPSMFF("IEN")=X
+6 SET DDMPSMFF("FDELIM")=$$GET1^DIQ(.44,X_",",1)
+7 SET DDMPSMFF("FIXED")=$$GET1^DIQ(.44,X_",",5)
+8 SET DDMPSMFF("QUOTED")=$$GET1^DIQ(.44,X_",",8)
+9 FOR DDMPI="FIX","FLD_DLM","QUOTE"
Begin DoDot:2
+10 DO PUT^DDSVALF(DDMPI,1,1,"")
+11 DO UNED^DDSUTL(DDMPI,1,1,1)
End DoDot:2
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 KILL DDMPSMFF
+14 FOR DDMPI="FIX","FLD_DLM","QUOTE"
DO UNED^DDSUTL(DDMPI,1,1,0)
End DoDot:1
+15 QUIT
