Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIAX

DIAX.m

Go to the documentation of this file.
  1. DIAX ;SFISC/DCM-EXTRACT OPTIONS ;12/8/98 07:55
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. 0 S DIK="^DOPT(""DIAX""," G OPT:$D(^DOPT("DIAX",9))
  1. S ^(0)="EXTRACT OPTION^1.01^" K ^("B")
  1. F I=1:1:9 S ^DOPT("DIAX",I,0)=$P($T(@I),";;",2)
  1. D IXALL^DIK
  1. OPT W ! S DIC=DIK,DIC(0)="AEQIZ" D ^DIC K DIC,DIK
  1. I Y'<0 S DI=+Y K Y D EN G 0
  1. W ! K %,DIC,DIK,DI,DA,I,J,X,Y,DIAX Q
  1. ;
  1. EN S DIAX=1
  1. D @DI
  1. Q
  1. ;
  1. 1 ;;SELECT ENTRIES TO EXTRACT
  1. G 1^DIAR
  1. ;
  1. 2 ;;ADD/DELETE SELECTED ENTRIES
  1. S DIAR=2 G ENTE^DIARB
  1. ;
  1. 3 ;;PRINT SELECTED ENTRIES
  1. S DIAR=3 G OUT^DIARA
  1. ;
  1. 5 ;;CREATE EXTRACT TEMPLATE
  1. W !!,"This option lets you build a template where you specify fields to extract",!,"and their corresponding mapping in the destination file."
  1. W !!,"For more detailed description of requirements on the destination file,",!,"please see your VA FileMan User Manual."
  1. S DI=1 G EN^DIFGO
  1. ;
  1. 4 ;;MODIFY DESTINATION FILE
  1. 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"
  1. W !,"are selectable. However, only a few data types are acceptable for receiving",!,"extracted data."
  1. W !!,"Please see your User Manual for more guidance on building the destination file."
  1. D 41 G Q:'$D(DIAXDIC)
  1. D 61,Q
  1. Q
  1. 41 ;
  1. G ^DICATT
  1. 61 ;
  1. Q:$P(@(^DIC(DIAXDIC,0,"GL")_"0)"),U,4)
  1. 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"""
  1. S DIR("B")=$S($P($G(^DD(DIAXDIC,0,"DI")),U)["Y":"YES",1:"NO")
  1. D ^DIR Q:$D(DTOUT)!$D(DUOUT) S (DIARCH,DIE)=$S(Y:"Y",1:"N")
  1. 62 ;
  1. D FLAG(DIAXDIC,DIE,DIARCH)
  1. K DIAXDIC,DIE,DIARCH
  1. Q
  1. H6 W !!?5,"'YES' will not allow editing or deleting existing file entries or adding",!?11,"new file entries"
  1. W !?5,"'NO' will place no restrictions on the file"
  1. Q
  1. 6 ;;UPDATE DESTINATION FILE
  1. N DIAR,DIARC,DIARP,DIARB,DIE,DA,DR,DTOUT,DIAXFNO,%ZIS,POP,ZTRTN,ZTSAVE
  1. S DIAR=6 D FILE^DIARU G Q:'$D(DIARC)
  1. N DIARP,DIE,DA,DR
  1. W !!,"You MUST enter an EXTRACT template name. This EXTRACT template will be used",!,"to populate your destination file."
  1. 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)
  1. S DIARB=+$P(^DIAR(1.11,DIARC,0),U,3)
  1. D EN^DIAXM I $G(DIERR) G UNLK
  1. 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."
  1. W !!,"QUEUEING to this device will queue the Update process."
  1. N %ZIS,POP,ZTRTN,ZTSAVE,DIAXIOP
  1. S %ZIS="Q",%ZIS("A")="EXCEPTION REPORT DEVICE: ",%ZIS("B")="" D ^%ZIS G UNLK:POP S DIAXIOP=ION
  1. I $D(IO("Q")) S ZTRTN="DQ^DIAXU",(ZTSAVE("DIARP"),ZTSAVE("DIARB"),ZTSAVE("DIARC"))="",ZTSAVE("DIAXIOP")="",ZTIO="" D ^%ZTLOAD G UNLK
  1. D DIAX^DIAXU
  1. Q
  1. ;
  1. 7 ;;PURGE EXTRACTED ENTRIES
  1. S DIAR=90 G ENTD^DIARA
  1. ;
  1. 8 ;;CANCEL EXTRACT SELECTION
  1. S DIAR=99 G ENTC^DIARA
  1. ;
  1. 9 ;;VALIDATE EXTRACT TEMPLATE
  1. N X,DIC,Y
  1. S DIC="^DIPT(",DIC(0)="ASQEM",DIC("A")="Select EXTRACT TEMPLATE: ",DIC("S")="I $P(^(0),U,8)=2"
  1. D ^DIC Q:Y'>0
  1. S DIARP=+Y,DIAR=""
  1. D EN^DIAXM
  1. D Q G 9
  1. ;
  1. UNLK N DIAR S DIAR=""
  1. D UPDATE^DIARU
  1. Q D Q^DIARB
  1. Q
  1. ;
  1. FLAG(DIC,DIE,DIARCH) ;
  1. Q:'DIC Q:'$D(^DD(DIC,0))
  1. S $P(^DD(DIC,0,"DI"),U)=DIARCH,$P(^DD(DIC,0,"DI"),U,2)=DIE
  1. Q