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

DIT0.m

Go to the documentation of this file.
  1. DIT0 ;SFISC/GFT,XAK-PREPARE TO XFR ;15FEB2013
  1. ;;22.2;VA FileMan;**14**;Jan 05, 2016;Build 8
  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. N Y,DIC,DIT0KILL S DIT=DDF(1),DIC=L,DIC(0)="EQLAM",X="DATA INTO WHICH " D LK
  1. G Q:Y<0 S DFR=+Y,DTO(1)=DIC_+Y_",",DIC(0)="EQAM",X="FROM ",DIC("S")="I Y-"_+Y D LK G Q:Y<0
  1. S S (D0,DA)=+Y W ! D G Q:%<0 S (DH,DIT0KILL)=2-% I '% D F^DIT G S
  1. .I $D(^DD(DIT,.01,"DEL",1,0)) X ^(0) I S %=2 Q
  1. .S %=2 W " WANT TO DELETE THIS ENTRY AFTER IT'S TRANSFERRED" D YN^DICN
  1. S ^UTILITY("DIT",$J,+Y)=DFR_";"_$E(DIC,2,999)
  1. S DTO=0,DIK=DIC,DFR(1)=DIC_DA_"," K DIC D WAIT^DICD
  1. GO D GO^DITR
  1. K DA S DA=D0,DIT=DH D KL^DIT,^DIK:$G(DIT0KILL) S DA=DFR K DFR D IX1^DIK ;DELETE OLD ENTRY, CONDITIONALLY ;p14
  1. S DH=DIT D ASK^DITP,PTS^DITP:%=1
  1. Q G Q^DIT
  1. ;
  1. LK S DIC("A")="TRANSFER "_X_DFL G ^DIC
  1. ;
  1. EN ; PROGRAMMER CALL
  1. ; DIT("F") = GLOBAL ROOT OR FILE # OF FILE TO TRANSFER FROM
  1. ; DIT("T") = GLOBAL ROOT OR FILE # OF FILE TO TRANSFER TO
  1. ; DA("F") = ENTRY # IN FILE TO TRANSFER FROM
  1. ; DA("T") = ENTRY # IN FILE TO TRANSFER TO
  1. ;
  1. N DIT0KILL
  1. I '$D(DIT("F"))!'$D(DIT("T"))!'$D(DA("F"))!'$D(DA("T")) G FIN
  1. S DDF(1)=DIT("F"),DDT(0)=DIT("T")
  1. I 'DDF(1) S DDF(1)=$S($D(@(DDF(1)_"0)"))#2:+$P(^(0),U,2),1:0) G FIN:'DDF(1) S DFR(1)=DIT("F")
  1. I 'DDT(0) S DDT(0)=$S($D(@(DDT(0)_"0)"))#2:+$P(^(0),U,2),1:0) G FIN:'DDT(0) S DTO(1)=DIT("T") G C
  1. G FIN:'$D(^DIC(+DDF(1),0,"GL")) S DFR(1)=^("GL")
  1. G FIN:'$D(^DIC(+DDT(0),0,"GL")) S DTO(1)=^("GL")
  1. C S DB=DA("F"),(DB1,DFR)=DA("T"),DIK=DTO(1)
  1. I $D(DA(1)) F I=1:1 G:'$D(DA(I)) SET S DRF(I)=$P(DA(I),",",1)_",1,",DOT(I)=$P(DA(I),",",2)_",1,"
  1. DON K DRF,DOT S DFR(1)=DFR(1)_DB_",",DTO(1)=DTO(1)_DB1_",",DKP=1,DMRG=1,DTO=0,DH=0,DIT0KILL=0 G GO
  1. SET F I=I-1:-1 G:I'>0 DON S DFR(1)=DFR(1)_DRF(I),DTO(1)=DTO(1)_DOT(I)
  1. FIN ;
  1. K DDF,DFR,DDT,DTO
  1. Q