Routine: DDMPU

DDMPU ;SFISC/DPC-IMPORT USER INTERFACE, TEMPLATE CREATE ;9/12/96  17:07

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

EN ;Entry point for Import Data option.

 D CLEAN^DIEFU

 N DIQUIET,DIFM S (DIQUIET,DIFM)=1

 N DA

 N DDMPHOST,DDMPSELF,DDMPFLAG,DDMPDR,DDSSAVE,DDMPSMFF,DDMPHOST,DDMPIORE,DDMPFDSL,DDMPTMPL

 D  Q:'$G(DDSSAVE)

 . N DDSPARM,DDSFILE,DR

 . N DDMPF,DDMPCF,DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPFDCT,DDMPFDNM,DDMPFLNM,DDMPOSET,DDMPX,DDMPFRP4,DDMPOLDF

 . S DDSFILE=.46,DR="[DDMP SPECIFY IMPORT]",DDSPARM="S" D ^DDS

 W @IOF

 I '$D(DDMPSELF) S DDMPFLAG="F"

 I $G(DDMPIORE)="E" S DDMPFLAG=$G(DDMPFLAG)_"E"

 I '($G(DDMPTMPL)]""),$D(DDMPSELF) D

 . N DIR,DIRUT,Y

 . S DIR(0)="Y"

 . S DIR("A")="Do you want to store the selected fields in an Import Template"

 . D ^DIR

 . I Y D MKTMPL(DDMPSELF,.DDMPFDSL,.DDMPDR)

 N DIR,DIRUT,Y S DIR(0)="Y"

 S DIR("A")="Do you want to proceed with the import"

 S DIR("?",1)="If you answer 'YES', the import will occur now."

 S DIR("?")="If you answer 'NO', you will need to respecify the import criteria."

 W ! D ^DIR

 I 'Y!$G(DIRUT) W !!,"Okay, you can do the import later." Q

 D FILE^DDMP($G(DDMPSELF),.DDMPDR,$G(DDMPFLAG),.DDMPHOST,.DDMPSMFF)

 W !!

 I $G(DIERR) D

 . W "Following error messages were generated when import failed."

 . D MSG^DIALOG("","","",3)

 E  I '$G(ZTSK) W "Done."

MKTMPL(DDMPF,DDMPFLDS,DDMPDR) ; Create Import Template.

 N DDMPTPNM,DDMPTPNO,DDMPRCNO,DDMPOUT,DDMPSQ,DIR,DIRUT,Y

 F  D  Q:$G(DDMPOUT)!($G(DDMPTPNM)]"")

 . S DIR(0)="FA^3:30^K:(X?1P.E) X"

 . S DIR("?")="Enter name for your import template.  It should be 3-30 characters and it should not start with a punctuation character"

 . S DIR("A")="Name of Import Template:  "

 . W ! D ^DIR

 . I Y']""!$G(DIRUT) S DDMPOUT=1 Q

 . S DDMPTPNM=Y

 . S DDMPTPNO=$O(^DIST(.46,"F"_DDMPF,DDMPTPNM,""))

 . I DDMPTPNO D DUPNAME(DDMPF,.DDMPTPNM,DDMPTPNO) Q:DDMPTPNM=""

 . S DIR("A")="  Are you adding '"_DDMPTPNM_"' as a new Import Template"

 . S DIR(0)="Y"

 . D ^DIR

 . I 'Y S DDMPTPNM="" Q

 . K ^TMP($J,"DDMPFDA")

 . S ^TMP($J,"DDMPFDA",.46,"+1,",.01)=DDMPTPNM

 . S ^TMP($J,"DDMPFDA",.46,"+1,",4)=DDMPF

 . S ^TMP($J,"DDMPFDA",.46,"+1,",5)=DUZ

 . S ^TMP($J,"DDMPFDA",.46,"+1,",2)=DT

 . S:DUZ(0)'="@" (^TMP($J,"DDMPFDA",.46,"+1,",3),^TMP($J,"DDMPFDA",.46,"+1,",6))=DUZ(0)

 . F DDMPSQ=1:1  Q:'$D(DDMPFLDS(DDMPSQ))  D

 . . N DDMPIENS,DDMPLVLS

 . . S DDMPIENS="+"_(DDMPSQ+1)_",+1,"

 . . S DDMPLVLS=$L(DDMPFLDS(DDMPSQ),":")

 . . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,.01)=DDMPSQ

 . . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,1)=$P($P(DDMPFLDS(DDMPSQ),":",DDMPLVLS),U,2)

 . . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,2)=+$P(DDMPFLDS(DDMPSQ),":",DDMPLVLS)

 . . S:$D(DDMPFLDS("LN",DDMPSQ)) ^TMP($J,"DDMPFDA",.463,DDMPIENS,3)=DDMPFLDS("LN",DDMPSQ)

 . . S:DDMPLVLS>1 ^TMP($J,"DDMPFDA",.463,DDMPIENS,10)=$P(DDMPFLDS(DDMPSQ),":",1,DDMPLVLS-1)

 . . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,20)=DDMPFLDS("CAP",DDMPSQ)

 . N DDMPERR S DDMPERR=$G(DIERR)

 . D UPDATE^DIE("","^TMP($J,""DDMPFDA"")","DDMPRCNO")

 . I DDMPERR'=$G(DIERR) W !,"An error occurred during the filing of the import template." S DDMPOUT=1 Q

 . D RECALL^DILFD(.46,DDMPRCNO(1)_",",DUZ)

 . I DUZ(0)="@" S $P(^DIST(.46,DDMPRCNO(1),0),U,3)="@",$P(^(0),U,6)="@"

 I $G(DDMPOUT) W !,"No import template will be created."

DUPNAME(DDMPF,DDMPTPNM,DDMPTPNO) ;selected template exists.

 ;If Import template name remains in DDMPTPNM after subroutine,

 ;user has chosen to delete existing template.

 W !!,"Import Template "_DDMPTPNM_" already exists."

 N DDMPDLOK S DDMPDLOK=0

 I DUZ(0)="@" D

 . S DDMPDLOK=$$CKDLT

 E  D

 . N DDMPWRAC,I

 . S DDMPWRAC=$$GET1^DIQ(.46,DDMPTPNO_",",6)

 . F I=1:1:$L(DDMPWRAC) I DUZ(0)[$E(DDMPWRAC,I) S DDMPDLOK=$$CKDLT Q

 I DDMPDLOK D

 . N DIK,DA S DIK="^DIST(.46,",DA=DDMPTPNO D ^DIK

 . W !,"Existing Import Template "_DDMPTPNM_" has been deleted."

 E  S DDMPTPNM="" W !!,"Choose another template name."

CKDLT() ;

 ;user has write access to the template.  Do they want to delete it?

 N DIR,DIRUT

 S DIR(0)="Y"

 S DIR("A")="Do you want to replace the existing template with a new one"

 S DIR("?",1)="If you answer 'YES', the existing template will be deleted."

 S DIR("?")="Answer YES or NO."

 D ^DIR

 I 'Y!$G(DIRUT) Q 0

Q 1

DDMPU     ;SFISC/DPC-IMPORT USER INTERFACE, TEMPLATE CREATE ;9/12/96  17:07

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

EN        ;Entry point for Import Data option.

 +1        DO CLEAN^DIEFU

 +2        NEW DIQUIET,DIFM

           SET (DIQUIET,DIFM)=1

 +3        NEW DA

 +4        NEW DDMPHOST,DDMPSELF,DDMPFLAG,DDMPDR,DDSSAVE,DDMPSMFF,DDMPHOST,DDMPIORE,DDMPFDSL,DDMPTMPL

 +5        Begin DoDot:1

 +6            NEW DDSPARM,DDSFILE,DR

 +7            NEW DDMPF,DDMPCF,DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPFDCT,DDMPFDNM,DDMPFLNM,DDMPOSET,DDMPX,DDMPFRP4,DDMPOLDF

 +8            SET DDSFILE=.46

               SET DR="[DDMP SPECIFY IMPORT]"

               SET DDSPARM="S"

               DO ^DDS

           End DoDot:1

           IF '$GET(DDSSAVE)

               QUIT

 +9        WRITE @IOF

 +10       IF '$DATA(DDMPSELF)

               SET DDMPFLAG="F"

 +11       IF $GET(DDMPIORE)="E"

               SET DDMPFLAG=$GET(DDMPFLAG)_"E"

 +12       IF '($GET(DDMPTMPL)]"")

               IF $DATA(DDMPSELF)

                   Begin DoDot:1

 +13                   NEW DIR,DIRUT,Y

 +14                   SET DIR(0)="Y"

 +15                   SET DIR("A")="Do you want to store the selected fields in an Import Template"

 +16                   DO ^DIR

 +17                   IF Y

                           DO MKTMPL(DDMPSELF,.DDMPFDSL,.DDMPDR)

                   End DoDot:1

 +18       NEW DIR,DIRUT,Y

           SET DIR(0)="Y"

 +19       SET DIR("A")="Do you want to proceed with the import"

 +20       SET DIR("?",1)="If you answer 'YES', the import will occur now."

 +21       SET DIR("?")="If you answer 'NO', you will need to respecify the import criteria."

 +22       WRITE !

           DO ^DIR

 +23       IF 'Y!$GET(DIRUT)

               WRITE !!,"Okay, you can do the import later."

               QUIT

 +24       DO FILE^DDMP($GET(DDMPSELF),.DDMPDR,$GET(DDMPFLAG),.DDMPHOST,.DDMPSMFF)

 +25       WRITE !!

 +26       IF $GET(DIERR)

               Begin DoDot:1

 +27               WRITE "Following error messages were generated when import failed."

 +28               DO MSG^DIALOG("","","",3)

               End DoDot:1

 +29      IF '$TEST

               IF '$GET(ZTSK)

                   WRITE "Done."

 +30       QUIT

 +31      ;

MKTMPL(DDMPF,DDMPFLDS,DDMPDR) ; Create Import Template.

 +1        NEW DDMPTPNM,DDMPTPNO,DDMPRCNO,DDMPOUT,DDMPSQ,DIR,DIRUT,Y

 +2        FOR

               Begin DoDot:1

 +3                SET DIR(0)="FA^3:30^K:(X?1P.E) X"

 +4                SET DIR("?")="Enter name for your import template.  It should be 3-30 characters and it should not start with a punctuation character"

 +5                SET DIR("A")="Name of Import Template:  "

 +6                WRITE !

                   DO ^DIR

 +7                IF Y']""!$GET(DIRUT)

                       SET DDMPOUT=1

                       QUIT

 +8                SET DDMPTPNM=Y

 +9                SET DDMPTPNO=$ORDER(^DIST(.46,"F"_DDMPF,DDMPTPNM,""))

 +10               IF DDMPTPNO

                       DO DUPNAME(DDMPF,.DDMPTPNM,DDMPTPNO)

                       IF DDMPTPNM=""

                           QUIT

 +11               SET DIR("A")="  Are you adding '"_DDMPTPNM_"' as a new Import Template"

 +12               SET DIR(0)="Y"

 +13               DO ^DIR

 +14               IF 'Y

                       SET DDMPTPNM=""

                       QUIT

 +15               KILL ^TMP($JOB,"DDMPFDA")

 +16               SET ^TMP($JOB,"DDMPFDA",.46,"+1,",.01)=DDMPTPNM

 +17               SET ^TMP($JOB,"DDMPFDA",.46,"+1,",4)=DDMPF

 +18               SET ^TMP($JOB,"DDMPFDA",.46,"+1,",5)=DUZ

 +19               SET ^TMP($JOB,"DDMPFDA",.46,"+1,",2)=DT

 +20               IF DUZ(0)'="@"

                       SET (^TMP($JOB,"DDMPFDA",.46,"+1,",3),^TMP($JOB,"DDMPFDA",.46,"+1,",6))=DUZ(0)

 +21               FOR DDMPSQ=1:1

                       IF '$DATA(DDMPFLDS(DDMPSQ))

                           QUIT

                       Begin DoDot:2

 +22                       NEW DDMPIENS,DDMPLVLS

 +23                       SET DDMPIENS="+"_(DDMPSQ+1)_",+1,"

 +24                       SET DDMPLVLS=$LENGTH(DDMPFLDS(DDMPSQ),":")

 +25                       SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,.01)=DDMPSQ

 +26                       SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,1)=$PIECE($PIECE(DDMPFLDS(DDMPSQ),":",DDMPLVLS),U,2)

 +27                       SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,2)=+$PIECE(DDMPFLDS(DDMPSQ),":",DDMPLVLS)

 +28                       IF $DATA(DDMPFLDS("LN",DDMPSQ))

                               SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,3)=DDMPFLDS("LN",DDMPSQ)

 +29                       IF DDMPLVLS>1

                               SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,10)=$PIECE(DDMPFLDS(DDMPSQ),":",1,DDMPLVLS-1)

 +30                       SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,20)=DDMPFLDS("CAP",DDMPSQ)

                       End DoDot:2

 +31               NEW DDMPERR

                   SET DDMPERR=$GET(DIERR)

 +32               DO UPDATE^DIE("","^TMP($J,""DDMPFDA"")","DDMPRCNO")

 +33               IF DDMPERR'=$GET(DIERR)

                       WRITE !,"An error occurred during the filing of the import template."

                       SET DDMPOUT=1

                       QUIT

 +34               DO RECALL^DILFD(.46,DDMPRCNO(1)_",",DUZ)

 +35               IF DUZ(0)="@"

                       SET $PIECE(^DIST(.46,DDMPRCNO(1),0),U,3)="@"

                       SET $PIECE(^(0),U,6)="@"

               End DoDot:1

               IF $GET(DDMPOUT)!($GET(DDMPTPNM)]"")

                   QUIT

 +36       IF $GET(DDMPOUT)

               WRITE !,"No import template will be created."

 +37       QUIT

 +38      ;

DUPNAME(DDMPF,DDMPTPNM,DDMPTPNO) ;selected template exists.

 +1       ;If Import template name remains in DDMPTPNM after subroutine,

 +2       ;user has chosen to delete existing template.

 +3        WRITE !!,"Import Template "_DDMPTPNM_" already exists."

 +4        NEW DDMPDLOK

           SET DDMPDLOK=0

 +5        IF DUZ(0)="@"

               Begin DoDot:1

 +6                SET DDMPDLOK=$$CKDLT

               End DoDot:1

 +7       IF '$TEST

               Begin DoDot:1

 +8                NEW DDMPWRAC,I

 +9                SET DDMPWRAC=$$GET1^DIQ(.46,DDMPTPNO_",",6)

 +10               FOR I=1:1:$LENGTH(DDMPWRAC)

                       IF DUZ(0)[$EXTRACT(DDMPWRAC,I)

                           SET DDMPDLOK=$$CKDLT

                           QUIT

               End DoDot:1

 +11       IF DDMPDLOK

               Begin DoDot:1

 +12               NEW DIK,DA

                   SET DIK="^DIST(.46,"

                   SET DA=DDMPTPNO

                   DO ^DIK

 +13               WRITE !,"Existing Import Template "_DDMPTPNM_" has been deleted."

               End DoDot:1

 +14      IF '$TEST

               SET DDMPTPNM=""

               WRITE !!,"Choose another template name."

 +15       QUIT

 +16      ;

CKDLT()   ;

 +1       ;user has write access to the template.  Do they want to delete it?

 +2        NEW DIR,DIRUT

 +3        SET DIR(0)="Y"

 +4        SET DIR("A")="Do you want to replace the existing template with a new one"

 +5        SET DIR("?",1)="If you answer 'YES', the existing template will be deleted."

 +6        SET DIR("?")="Answer YES or NO."

 +7        DO ^DIR

 +8        IF 'Y!$GET(DIRUT)

               QUIT 0

 +9        QUIT 1

DDMPU.m