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