| 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
 | 
|---|