DDXP33 ;SFISC/DPC - CREATE EXPORT TEMPLATE (CONT) ;12:45 PM 7 Jun 1999
;;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.
;
FLDTEMP ;
S DDXPOUT=0
S DIC="^DIPT(",DIC(0)="QEASZ",DIC("S")="I $P(^(0),U,8)=7",DIC("A")="Enter SELECTED EXPORT FIELDS Template: ",D="F"_DDXPFINO W ! D IX^DIC K DIC,D
I Y=-1 S DDXPOUT=1 Q
S DDXPFDTM=+Y,DDXPFDNM=$P(Y,U,2)
N DDXPY
S DDXPY=Y(0)
D SHOWFLD G:DDXPOUT FLDTEMP
Q
SHOWFLD ;
W !!,"Do you want to see the fields stored in the "_DDXPFDNM_" template?"
S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
I $D(DIRUT) S DDXPOUT=1 Q
I Y D Q:DDXPOUT
. W ! S D0=DDXPFDTM D ^DIPT K D0
. W !,"Do you want to use this template?"
. S DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR W !
. I 'Y!$D(DIRUT) S DDXPOUT=1
. Q
S DDXPTMDL=0
I DUZ(0)[$E($P(DDXPY,U,6),1)!(DUZ(0)="@") D I $D(DIRUT) K DDXPY S DDXPOUT=1 Q
. W !!,"Do you want to delete the "_DDXPFDNM_" template"
. W !,"after the export template is created?"
. S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR W !
. S:Y DDXPTMDL=1
. K DDXPY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDXP33 1299 printed Oct 16, 2024@18:44:46 Page 2
DDXP33 ;SFISC/DPC - CREATE EXPORT TEMPLATE (CONT) ;12:45 PM 7 Jun 1999
+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 ;
FLDTEMP ;
+1 SET DDXPOUT=0
+2 SET DIC="^DIPT("
SET DIC(0)="QEASZ"
SET DIC("S")="I $P(^(0),U,8)=7"
SET DIC("A")="Enter SELECTED EXPORT FIELDS Template: "
SET D="F"_DDXPFINO
WRITE !
DO IX^DIC
KILL DIC,D
+3 IF Y=-1
SET DDXPOUT=1
QUIT
+4 SET DDXPFDTM=+Y
SET DDXPFDNM=$PIECE(Y,U,2)
+5 NEW DDXPY
+6 SET DDXPY=Y(0)
+7 DO SHOWFLD
if DDXPOUT
GOTO FLDTEMP
+8 QUIT
SHOWFLD ;
+1 WRITE !!,"Do you want to see the fields stored in the "_DDXPFDNM_" template?"
+2 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET DDXPOUT=1
QUIT
+4 IF Y
Begin DoDot:1
+5 WRITE !
SET D0=DDXPFDTM
DO ^DIPT
KILL D0
+6 WRITE !,"Do you want to use this template?"
+7 SET DIR(0)="Y"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
WRITE !
+8 IF 'Y!$DATA(DIRUT)
SET DDXPOUT=1
+9 QUIT
End DoDot:1
if DDXPOUT
QUIT
+10 SET DDXPTMDL=0
+11 IF DUZ(0)[$EXTRACT($PIECE(DDXPY,U,6),1)!(DUZ(0)="@")
Begin DoDot:1
+12 WRITE !!,"Do you want to delete the "_DDXPFDNM_" template"
+13 WRITE !,"after the export template is created?"
+14 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
WRITE !
+15 if Y
SET DDXPTMDL=1
+16 KILL DDXPY
End DoDot:1
IF $DATA(DIRUT)
KILL DDXPY
SET DDXPOUT=1
QUIT
+17 QUIT
