1 | DIAX ;SFISC/DCM-EXTRACT OPTIONS ;12/8/98 07:55
|
---|
2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | 0 S DIK="^DOPT(""DIAX""," G OPT:$D(^DOPT("DIAX",9))
|
---|
5 | S ^(0)="EXTRACT OPTION^1.01^" K ^("B")
|
---|
6 | F I=1:1:9 S ^DOPT("DIAX",I,0)=$P($T(@I),";;",2)
|
---|
7 | D IXALL^DIK
|
---|
8 | OPT W ! S DIC=DIK,DIC(0)="AEQIZ" D ^DIC K DIC,DIK
|
---|
9 | I Y'<0 S DI=+Y K Y D EN G 0
|
---|
10 | W ! K %,DIC,DIK,DI,DA,I,J,X,Y,DIAX Q
|
---|
11 | ;
|
---|
12 | EN S DIAX=1
|
---|
13 | D @DI
|
---|
14 | Q
|
---|
15 | ;
|
---|
16 | 1 ;;SELECT ENTRIES TO EXTRACT
|
---|
17 | G 1^DIAR
|
---|
18 | ;
|
---|
19 | 2 ;;ADD/DELETE SELECTED ENTRIES
|
---|
20 | S DIAR=2 G ENTE^DIARB
|
---|
21 | ;
|
---|
22 | 3 ;;PRINT SELECTED ENTRIES
|
---|
23 | S DIAR=3 G OUT^DIARA
|
---|
24 | ;
|
---|
25 | 5 ;;CREATE EXTRACT TEMPLATE
|
---|
26 | W !!,"This option lets you build a template where you specify fields to extract",!,"and their corresponding mapping in the destination file."
|
---|
27 | W !!,"For more detailed description of requirements on the destination file,",!,"please see your VA FileMan User Manual."
|
---|
28 | S DI=1 G EN^DIFGO
|
---|
29 | ;
|
---|
30 | 4 ;;MODIFY DESTINATION FILE
|
---|
31 | W !!,"This option allows you to build a file which will store data extracted from",!,"other files. When creating fields in the destination file, all data types"
|
---|
32 | W !,"are selectable. However, only a few data types are acceptable for receiving",!,"extracted data."
|
---|
33 | W !!,"Please see your User Manual for more guidance on building the destination file."
|
---|
34 | D 41 G Q:'$D(DIAXDIC)
|
---|
35 | D 61,Q
|
---|
36 | Q
|
---|
37 | 41 ;
|
---|
38 | G ^DICATT
|
---|
39 | 61 ;
|
---|
40 | Q:$P(@(^DIC(DIAXDIC,0,"GL")_"0)"),U,4)
|
---|
41 | K DIR S DIR("A")="ARCHIVE FILE",DIR(0)="YO",DIR("??")="^W !?5,""'YES' will not allow modifications or deletions of data or data dictionary"",!?5,""'NO' will place no restrictions on the file"""
|
---|
42 | S DIR("B")=$S($P($G(^DD(DIAXDIC,0,"DI")),U)["Y":"YES",1:"NO")
|
---|
43 | D ^DIR Q:$D(DTOUT)!$D(DUOUT) S (DIARCH,DIE)=$S(Y:"Y",1:"N")
|
---|
44 | 62 ;
|
---|
45 | D FLAG(DIAXDIC,DIE,DIARCH)
|
---|
46 | K DIAXDIC,DIE,DIARCH
|
---|
47 | Q
|
---|
48 | H6 W !!?5,"'YES' will not allow editing or deleting existing file entries or adding",!?11,"new file entries"
|
---|
49 | W !?5,"'NO' will place no restrictions on the file"
|
---|
50 | Q
|
---|
51 | 6 ;;UPDATE DESTINATION FILE
|
---|
52 | N DIAR,DIARC,DIARP,DIARB,DIE,DA,DR,DTOUT,DIAXFNO,%ZIS,POP,ZTRTN,ZTSAVE
|
---|
53 | S DIAR=6 D FILE^DIARU G Q:'$D(DIARC)
|
---|
54 | N DIARP,DIE,DA,DR
|
---|
55 | W !!,"You MUST enter an EXTRACT template name. This EXTRACT template will be used",!,"to populate your destination file."
|
---|
56 | S DIE="^DIAR(1.11,",DA=DIARC,DR="3;I X=""^"" S Y="";S DIARP=X;S DIAXFNO=+$P(^DIPT(DIARP,0),U,9);17////^S X=DIAXFNO" D ^DIE G UNLK:$D(DTOUT)!'$D(DIARP)
|
---|
57 | S DIARB=+$P(^DIAR(1.11,DIARC,0),U,3)
|
---|
58 | D EN^DIAXM I $G(DIERR) G UNLK
|
---|
59 | W $C(7),!,"If entries cannot be moved to the destination file, an exception report",!,"will be printed.",!!,"Select a device where to print the exception report."
|
---|
60 | W !!,"QUEUEING to this device will queue the Update process."
|
---|
61 | N %ZIS,POP,ZTRTN,ZTSAVE,DIAXIOP
|
---|
62 | S %ZIS="Q",%ZIS("A")="EXCEPTION REPORT DEVICE: ",%ZIS("B")="" D ^%ZIS G UNLK:POP S DIAXIOP=ION
|
---|
63 | I $D(IO("Q")) S ZTRTN="DQ^DIAXU",(ZTSAVE("DIARP"),ZTSAVE("DIARB"),ZTSAVE("DIARC"))="",ZTSAVE("DIAXIOP")="",ZTIO="" D ^%ZTLOAD G UNLK
|
---|
64 | D DIAX^DIAXU
|
---|
65 | Q
|
---|
66 | ;
|
---|
67 | 7 ;;PURGE EXTRACTED ENTRIES
|
---|
68 | S DIAR=90 G ENTD^DIARA
|
---|
69 | ;
|
---|
70 | 8 ;;CANCEL EXTRACT SELECTION
|
---|
71 | S DIAR=99 G ENTC^DIARA
|
---|
72 | ;
|
---|
73 | 9 ;;VALIDATE EXTRACT TEMPLATE
|
---|
74 | N X,DIC,Y
|
---|
75 | S DIC="^DIPT(",DIC(0)="ASQEM",DIC("A")="Select EXTRACT TEMPLATE: ",DIC("S")="I $P(^(0),U,8)=2"
|
---|
76 | D ^DIC Q:Y'>0
|
---|
77 | S DIARP=+Y,DIAR=""
|
---|
78 | D EN^DIAXM
|
---|
79 | D Q G 9
|
---|
80 | ;
|
---|
81 | UNLK N DIAR S DIAR=""
|
---|
82 | D UPDATE^DIARU
|
---|
83 | Q D Q^DIARB
|
---|
84 | Q
|
---|
85 | ;
|
---|
86 | FLAG(DIC,DIE,DIARCH) ;
|
---|
87 | Q:'DIC Q:'$D(^DD(DIC,0))
|
---|
88 | S $P(^DD(DIC,0,"DI"),U)=DIARCH,$P(^DD(DIC,0,"DI"),U,2)=DIE
|
---|
89 | Q
|
---|