| 1 | DIT ;SFISC/GFT-GET XFR ANSWERS ;4/6/94 13:03
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | 0 S DIC="^DOPT(""DIT""," G OPT:$D(^DOPT("DIT",2)) S ^(0)="TRANSFER OPTION^1.01" K ^("B")
|
|---|
| 5 | F X=1,2 S ^DOPT("DIT",X,0)=$P("TRANSFER^COMPARE/MERGE",U,X)_" FILE ENTRIES"
|
|---|
| 6 | S DIK=DIC D IXALL^DIK
|
|---|
| 7 | OPT W !! S DIC(0)="AEQZI" D ^DIC G Q:Y<0 I +Y=2 D ^DITM K DIC G 0
|
|---|
| 8 | D Q S DLAYGO=1 D W^DICRW G Q:$D(DTOUT) Q:Y<0 S DFL=$P(Y,U,2)_": " I '$D(DIC) D DIE^DIB Q:'$D(DG) S L=DG,Y=DLAYGO K DG,DIE,DQ G FROM
|
|---|
| 9 | S DIC("B")=+Y,L=DIC
|
|---|
| 10 | FROM S DMRG=1,DKP=1,(DDF(1),DDT(0))=+Y,DIC=1,DIC(0)="EQAZ",DIC("A")="TRANSFER FROM FILE: "
|
|---|
| 11 | S DIC("S")="S DIFILE=+Y,DIAC=""RD"" D ^DIAC I %"
|
|---|
| 12 | D ^DIC K DIC G Q:Y<0,Q:'$D(^(0,"GL")) S DTO=^("GL") I DUZ(0)'="@",$S($D(^VA(200,DUZ,"FOF",+Y,0)):1,1:$D(^DIC(3,DUZ,"FOF",+Y,0))) G DTR:+$P(^(0),U,3),Q
|
|---|
| 13 | I DUZ(0)'="@",$D(^DIC(+Y,0,"DEL")) F X=1:1 G Q:X>$L(^("DEL")) Q:DUZ(0)[$E(^("DEL"),X)
|
|---|
| 14 | DTR D PTS I +Y=DDF(1) G ^DIT0
|
|---|
| 15 | TWO S (DTO(0),F)=L,L(+Y)=DDT(0),L=0,DDF(1)=+Y,DFR(1)=DTO_"D0,",DHIT=DLAYGO-(Y#1),%=0
|
|---|
| 16 | W !! K ^UTILITY("DITR",$J),A I DLAYGO-1 W "DO YOU WANT TO TRANSFER THE '",$P(Y,U,2),"'",!,"DATA DICTIONARY INTO YOUR NEW FILE" D YN^DICN G Q:%<1 D ^DIT1:%=1
|
|---|
| 17 | K DITF,Y,B W ! G Q:'$D(L)
|
|---|
| 18 | D MAP I '$D(DITF) W $C(7),"FILES DON'T MATCH!" G Q
|
|---|
| 19 | W:$X>40 ! W:'$D(A) " WILL BE TRANSFERRED",!!
|
|---|
| 20 | S %=2,DMRG=0 I @("$O("_DTO(0)_"0))>0") W !,"WANT TO MERGE TRANSFERRED ENTRIES WITH ONES ALREADY THERE" D YN^DICN G Q:%<1 I %=1 S DMRG=1
|
|---|
| 21 | S (DIK,DIC)=DTO,DTO=1,L="TRANSFER ENTRIES",FLDS="",DHD="@",%ZIS="F"
|
|---|
| 22 | D S %=0 W !,"WANT EACH ENTRY TO BE DELETED AS IT'S TRANSFERRED" D YN^DICN S DHIT="S DI=99 D F^DITR"_$P(",^DIK",%,%=1) G Q:%<0 I '% D F G D
|
|---|
| 23 | S DISTOP=0,DIOEND="S DIK=DTO(0),DIK(0)=""B"" D KL^DIT,IXALL^DIK,Q^DIT" D EN1^DIP
|
|---|
| 24 | Q ;
|
|---|
| 25 | K ^UTILITY("DITR",$J),^UTILITY("DIT",$J),DIT,DIC,DA,DB1,DFR,DIK,L,FLDS,DHIT,DISTOP,DIOEND,%ZIS
|
|---|
| 26 | KL K DIU,DIV,DIG,DIH,DLAYGO,DITF,DFN,DMRG,DTO,DTN,DDF,DTL,DFL,DDT,A,B,DKP,W,X,FLDS,Y,Z Q
|
|---|
| 27 | ;
|
|---|
| 28 | MAP ;BUILD MAP OF FIELDS FROM 'FROM' TO 'TO' FILE
|
|---|
| 29 | N DFL S DFL=1
|
|---|
| 30 | MAP2 ;ENTRY POINT FROM ^DIT3
|
|---|
| 31 | K:L]"" L(L) S L=$O(L(0)) Q:L']""
|
|---|
| 32 | F Y=0:0 S Y=$O(^DD(L,Y)) G MAP2:Y="",MAP2:'$D(^(Y,0)) S %=^(0) I $P(%,U,2)'["C" S DIC=$P(%,U,1),X=$O(^DD(L(L),"B",DIC,0)) I X>0,'^(X),$P(^DD(L(L),X,0),U,2)'["C" D T
|
|---|
| 33 | Q
|
|---|
| 34 | T S Z=$P(^(0),U,4),V=$P($P(^(0),U,2),U,Z[";0"),^UTILITY("DITR",$J,L,Y)=$P(Z,";",2)_U_$P(Z,";",1) S:V ^(Y)=^(Y)_U_V,L(+$P(%,U,2))=+V I Z="0;1",DDF(DFL)=L S DITF=$P(%,U,4)
|
|---|
| 35 | Q:$D(A) W:$X ", " W:$L(DIC)+$X>66 ! W "'"_DIC_"' FIELDS" Q
|
|---|
| 36 | ;
|
|---|
| 37 | PTS ;
|
|---|
| 38 | S DL=0 F X=0:0 S X=$O(^DD(+Y,0,"PT",X)) Q:X'>0 F Z=.001:0 S Z=$O(^DD(+Y,0,"PT",X,Z)) Q:Z'>0 I $D(^DD(X,Z,0))#2 S %=^(0) I (U_$P(%,U,3)=DTO!($D(^DD(X,Z,"V","B",+Y)))),$P(%,U,2)'["I" S DL=DL+1,^UTILITY("DIT",$J,0,DL)=X_U_Z_U_$P(%,U,2)
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | F W !?7,"(TYPE '^' TO FORGET THE WHOLE THING!)",!
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | TRNMRG(DIFLG,DIFFNO,DITFNO,DIFIEN,DITIEN) ; SILENT TRANSFER/MERGE OF SINGLE RECORDS IN FILE OR SUBFILE
|
|---|
| 45 | ;DIFLG = FLAGS
|
|---|
| 46 | ;DIFFNO = TRANSFER 'FROM' FILE/SUBFILE NO. OR ROOT
|
|---|
| 47 | ;DITFNO = TRANSFER 'TO' FILE/SUBFILE NO.
|
|---|
| 48 | ;DIFIEN = TRANSFER 'FROM' IEN STRING
|
|---|
| 49 | ;DITIEN = TRANSFER 'TO' IEN STRING (PASS BY REFERENCE)
|
|---|
| 50 | G TRNMRG^DIT3
|
|---|
