source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIAX.m@ 1450

Last change on this file since 1450 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1DIAX ;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.
40 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
8OPT 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 ;
12EN S DIAX=1
13 D @DI
14 Q
15 ;
161 ;;SELECT ENTRIES TO EXTRACT
17 G 1^DIAR
18 ;
192 ;;ADD/DELETE SELECTED ENTRIES
20 S DIAR=2 G ENTE^DIARB
21 ;
223 ;;PRINT SELECTED ENTRIES
23 S DIAR=3 G OUT^DIARA
24 ;
255 ;;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 ;
304 ;;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
3741 ;
38 G ^DICATT
3961 ;
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")
4462 ;
45 D FLAG(DIAXDIC,DIE,DIARCH)
46 K DIAXDIC,DIE,DIARCH
47 Q
48H6 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
516 ;;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 ;
677 ;;PURGE EXTRACTED ENTRIES
68 S DIAR=90 G ENTD^DIARA
69 ;
708 ;;CANCEL EXTRACT SELECTION
71 S DIAR=99 G ENTC^DIARA
72 ;
739 ;;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 ;
81UNLK N DIAR S DIAR=""
82 D UPDATE^DIARU
83Q D Q^DIARB
84 Q
85 ;
86FLAG(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
Note: See TracBrowser for help on using the repository browser.