| 1 | TMGDIT ;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 |
|
|---|
| 5 | ;"Copied from FM, for decompiling and modifications
|
|---|
| 6 | ;"Revised interface added at end.
|
|---|
| 7 |
|
|---|
| 8 | 0 S DIC="^DOPT(""DIT"","
|
|---|
| 9 | G OPT:$D(^DOPT("DIT",2))
|
|---|
| 10 | S ^(0)="TRANSFER OPTION^1.01"
|
|---|
| 11 | K ^("B")
|
|---|
| 12 | F X=1,2 S ^DOPT("DIT",X,0)=$P("TRANSFER^COMPARE/MERGE",U,X)_" FILE ENTRIES"
|
|---|
| 13 | S DIK=DIC
|
|---|
| 14 | D IXALL^DIK
|
|---|
| 15 | OPT W !!
|
|---|
| 16 | S DIC(0)="AEQZI"
|
|---|
| 17 | ;"//ktD ^DIC ;"do menu asking for options --> Y=1^Transfer...
|
|---|
| 18 | S Y=1 ;"//kt added
|
|---|
| 19 | G Q:Y<0
|
|---|
| 20 | I +Y=2 D ^DITM K DIC G 0 ;"2 --> compare/merge 2 entries
|
|---|
| 21 | D Q ;"cleanup local variables.
|
|---|
| 22 | S DLAYGO=1 ;"allow addition of new file, if wanted
|
|---|
| 23 | D W^DICRW ;"ask 'INPUT TO WHAT FILE?' Y --> 200^NEW PERSON...
|
|---|
| 24 | G Q:$D(DTOUT)
|
|---|
| 25 | Q:Y<0
|
|---|
| 26 | S DFL=$P(Y,U,2)_": "
|
|---|
| 27 | I '$D(DIC) do Q:'$D(DG) G FROM
|
|---|
| 28 | . D DIE^DIB
|
|---|
| 29 | . Q:'$D(DG)
|
|---|
| 30 | . S L=DG,Y=DLAYGO
|
|---|
| 31 | . K DG,DIE,DQ
|
|---|
| 32 | S DIC("B")=+Y ;"save destination file number
|
|---|
| 33 | S L=DIC
|
|---|
| 34 | ;
|
|---|
| 35 | FROM S DMRG=1,DKP=1,(DDF(1),DDT(0))=+Y,DIC=1,DIC(0)="EQAZ",DIC("A")="TRANSFER FROM FILE: "
|
|---|
| 36 | S DIC("S")="S DIFILE=+Y,DIAC=""RD"" D ^DIAC I %"
|
|---|
| 37 | D ^DIC ;"ask 'Transfer FROM which file? Y --> 200^Newperson...
|
|---|
| 38 | K DIC
|
|---|
| 39 | G Q:Y<0
|
|---|
| 40 | G Q:'$D(^(0,"GL"))
|
|---|
| 41 | S DTO=^("GL") ;"DTO = root of source file
|
|---|
| 42 | 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
|
|---|
| 43 | I DUZ(0)'="@",$D(^DIC(+Y,0,"DEL")) F X=1:1 G Q:X>$L(^("DEL")) Q:DUZ(0)[$E(^("DEL"),X)
|
|---|
| 44 | DTR D PTS ;"get pointers into ^UTILITY("DIT",$J,0,#)=File^Field^FieldDefInfo
|
|---|
| 45 | I +Y=DDF(1)
|
|---|
| 46 | G ^TMGDIT0 ;"prepare to transfer
|
|---|
| 47 | ;"
|
|---|
| 48 | ;"=============================================================
|
|---|
| 49 | TWO S (DTO(0),F)=L,L(+Y)=DDT(0),L=0,DDF(1)=+Y,DFR(1)=DTO_"D0,",DHIT=DLAYGO-(Y#1),%=0
|
|---|
| 50 | W !!
|
|---|
| 51 | K ^UTILITY("DITR",$J),A
|
|---|
| 52 | I DLAYGO-1 do G Q:%<1
|
|---|
| 53 | . W "DO YOU WANT TO TRANSFER THE '",$P(Y,U,2),"'",!
|
|---|
| 54 | . W "DATA DICTIONARY INTO YOUR NEW FILE"
|
|---|
| 55 | . D YN^DICN
|
|---|
| 56 | . QUIT:%<1
|
|---|
| 57 | . D ^DIT1:%=1
|
|---|
| 58 |
|
|---|
| 59 | K DITF,Y,B
|
|---|
| 60 | W !
|
|---|
| 61 | G Q:'$D(L)
|
|---|
| 62 | D MAP
|
|---|
| 63 | I '$D(DITF) W $C(7),"FILES DON'T MATCH!" G Q
|
|---|
| 64 | W:$X>40 ! W:'$D(A) " WILL BE TRANSFERRED",!!
|
|---|
| 65 | S %=2,DMRG=0
|
|---|
| 66 | 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
|
|---|
| 67 | S (DIK,DIC)=DTO,DTO=1,L="TRANSFER ENTRIES",FLDS="",DHD="@",%ZIS="F"
|
|---|
| 68 | D S %=0
|
|---|
| 69 | W !,"WANT EACH ENTRY TO BE DELETED AS IT'S TRANSFERRED"
|
|---|
| 70 | D YN^DICN
|
|---|
| 71 | S DHIT="S DI=99 D F^DITR"_$P(",^DIK",%,%=1)
|
|---|
| 72 | G Q:%<0
|
|---|
| 73 | I '% D F G D
|
|---|
| 74 | S DISTOP=0
|
|---|
| 75 | s DIOEND="S DIK=DTO(0),DIK(0)=""B"" D KL^DIT,IXALL^DIK,Q^DIT"
|
|---|
| 76 | D EN1^DIP
|
|---|
| 77 | Q ;
|
|---|
| 78 | K ^UTILITY("DITR",$J),^UTILITY("DIT",$J),DIT,DIC,DA,DB1,DFR,DIK,L,FLDS,DHIT,DISTOP,DIOEND,%ZIS
|
|---|
| 79 | KL K DIU,DIV,DIG,DIH,DLAYGO,DITF,DFN,DMRG,DTO,DTN,DDF,DTL,DFL,DDT,A,B,DKP,W,X,FLDS,Y,Z
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | MAP ;"BUILD MAP OF FIELDS FROM 'FROM' TO 'TO' FILE
|
|---|
| 83 | N DFL
|
|---|
| 84 | S DFL=1
|
|---|
| 85 | MAP2 ;"ENTRY POINT FROM ^DIT3
|
|---|
| 86 | K:L]"" L(L)
|
|---|
| 87 | S L=$O(L(0))
|
|---|
| 88 | Q:L']""
|
|---|
| 89 | 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
|
|---|
| 90 | Q
|
|---|
| 91 | ;"
|
|---|
| 92 | T S Z=$P(^(0),U,4)
|
|---|
| 93 | S V=$P($P(^(0),U,2),U,Z[";0")
|
|---|
| 94 | S ^UTILITY("DITR",$J,L,Y)=$P(Z,";",2)_U_$P(Z,";",1)
|
|---|
| 95 | S:V ^(Y)=^(Y)_U_V,L(+$P(%,U,2))=+V
|
|---|
| 96 | I Z="0;1",DDF(DFL)=L
|
|---|
| 97 | S DITF=$P(%,U,4)
|
|---|
| 98 | Q:$D(A)
|
|---|
| 99 | W:$X ", "
|
|---|
| 100 | W:$L(DIC)+$X>66 !
|
|---|
| 101 | W "'"_DIC_"' FIELDS"
|
|---|
| 102 | Q
|
|---|
| 103 | ;
|
|---|
| 104 | PTS ;
|
|---|
| 105 | ;"Loads up ^UTILITY('DIT',$J) with pointers out (I think)
|
|---|
| 106 | ;"Input: Y as filenumber
|
|---|
| 107 | S DL=0
|
|---|
| 108 | F X=0:0 S X=$O(^DD(+Y,0,"PT",X)) Q:X'>0 do
|
|---|
| 109 | . F Z=.001:0 S Z=$O(^DD(+Y,0,"PT",X,Z)) Q:Z'>0 do
|
|---|
| 110 | . . I '$D(^DD(X,Z,0))#2 quit
|
|---|
| 111 | . . S %=^(0)
|
|---|
| 112 | . . I '(U_$P(%,U,3)=DTO!($D(^DD(X,Z,"V","B",+Y)))) quit
|
|---|
| 113 | . . I $P(%,U,2)'["I" do
|
|---|
| 114 | . . . S DL=DL+1
|
|---|
| 115 | . . . S ^UTILITY("DIT",$J,0,DL)=X_U_Z_U_$P(%,U,2)
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
| 118 | F W !?7,"(TYPE '^' TO FORGET THE WHOLE THING!)",!
|
|---|
| 119 | Q
|
|---|
| 120 | ;
|
|---|
| 121 | ;"=============================================================
|
|---|
| 122 | ;"=============================================================
|
|---|
| 123 | TRNMRG(DIFLG,DIFFNO,DITFNO,DIFIEN,DITIEN)
|
|---|
| 124 | ;"Purpose: SILENT TRANSFER/MERGE OF SINGLE RECORDS IN FILE OR SUBFILE
|
|---|
| 125 | ;"Input:
|
|---|
| 126 | ;" DIFLG = FLAGS
|
|---|
| 127 | ;" DIFFNO = TRANSFER 'FROM' FILE/SUBFILE NO. OR ROOT
|
|---|
| 128 | ;" DITFNO = TRANSFER 'TO' FILE/SUBFILE NO.
|
|---|
| 129 | ;" DIFIEN = TRANSFER 'FROM' IEN STRING
|
|---|
| 130 | ;" DITIEN = TRANSFER 'TO' IEN STRING (PASS BY REFERENCE)
|
|---|
| 131 | ;"
|
|---|
| 132 | ;"//kt According to post from George Timpson, here is the
|
|---|
| 133 | ;" definations for FLAGS:
|
|---|
| 134 | ;" "M" Merge the two entries. -- If a field exists on the target
|
|---|
| 135 | ;" record, do not write over it)
|
|---|
| 136 | ;" "O" Overwrite the merge 'TO' entry. (if a field exists on the
|
|---|
| 137 | ;" merge 'from' record, it overwrites the same field on the target record)
|
|---|
| 138 | ;" "A" Add the new record. This does not look for a match, but always
|
|---|
| 139 | ;" adds the merge 'from' record as a new entry in the target file.
|
|---|
| 140 | ;" "R" Replace. (Used only for package installation). In ^DIT
|
|---|
| 141 | ;" and ^DIT3, this works the same as 'O'. In replace mode, if a match
|
|---|
| 142 | ;" is found between a record coming in with the installation and a
|
|---|
| 143 | ;" record on the target system, the record on the target system is
|
|---|
| 144 | ;" deleted, except for any locally developed fields. We haven't yet
|
|---|
| 145 | ;" worked out the details of how this will be done. We may be setting
|
|---|
| 146 | ;" a new internal flags to pass to ^DITR, based on this flag containing
|
|---|
| 147 | ;" an "R". It seems to me that ^DITR would be the place to delete the
|
|---|
| 148 | ;" existing record, if a match is found.
|
|---|
| 149 | ;" "X" If this optional flag is included, the routine will run the SET
|
|---|
| 150 | ;" cross-reference logic on the merged 'TO' record, after it has been
|
|---|
| 151 | ;" installed.
|
|---|
| 152 |
|
|---|
| 153 | G TRNMRG^DIT3
|
|---|
| 154 |
|
|---|
| 155 | ;"=============================================================
|
|---|
| 156 | ;"=============================================================
|
|---|
| 157 |
|
|---|
| 158 | XFERREC(File,FromIEN,ToIEN)
|
|---|
| 159 | ;"Purpose:
|
|---|
| 160 | ;"Input: FromFile -- IEN of file of source
|
|---|
| 161 |
|
|---|
| 162 | new DIC
|
|---|
| 163 | D Q2 ;"cleanup local variables.
|
|---|
| 164 | set File=+$get(File)
|
|---|
| 165 | if File'>0 quit
|
|---|
| 166 | set ToIEN=+$get(ToIEN) ;"not supporting IENS right now.
|
|---|
| 167 | if ToIEN'>0 quit
|
|---|
| 168 | set FromIEN=+$get(FromIEN)
|
|---|
| 169 | if FromIEN'>0 quit
|
|---|
| 170 | S L=$get(^DIC(File,0,"GL"))
|
|---|
| 171 | if L="" quit
|
|---|
| 172 |
|
|---|
| 173 | S DMRG=1,DKP=1
|
|---|
| 174 | S (DDF(1),DDT(0))=File
|
|---|
| 175 | S DTO=L ;"DTO = root of source file
|
|---|
| 176 | ;"D PTS ;"get pointers into ^UTILITY("DIT",$J,0,#)=File^Field^FieldDefInfo
|
|---|
| 177 |
|
|---|
| 178 | ;"=============================================
|
|---|
| 179 |
|
|---|
| 180 | K DIC
|
|---|
| 181 | S DIC=L
|
|---|
| 182 | set Y=ToIEN ;"//kt
|
|---|
| 183 |
|
|---|
| 184 | S DFR=ToIEN
|
|---|
| 185 | S DTO(1)=L_ToIEN_"," ;"DTO is DESTINATION info array
|
|---|
| 186 | set Y=FromIEN ;"//kt
|
|---|
| 187 |
|
|---|
| 188 | S ^UTILITY("DIT",$J,FromIEN)=ToIEN_";"_$E(L,2,999)
|
|---|
| 189 | S DTO=0
|
|---|
| 190 | S (D0,DA)=+Y
|
|---|
| 191 | S DIK=L
|
|---|
| 192 | S DFR(1)=L_DA_","
|
|---|
| 193 | K DIC
|
|---|
| 194 |
|
|---|
| 195 | GO D GO^DITR ;"Find fields to XRef
|
|---|
| 196 |
|
|---|
| 197 | D KL^TMGDIT
|
|---|
| 198 | S DA=ToIEN
|
|---|
| 199 | K DFR
|
|---|
| 200 | D IX1^DIK ;"input: DIK (Root of file), DA (used as IEN)
|
|---|
| 201 |
|
|---|
| 202 | Q2 G Q^TMGDIT
|
|---|
| 203 | ;
|
|---|
