| 1 | DIFROMS4 ;SFISC/DCL- DATA FROM DISTRIBUTION ARRAY ;5/24/00 15:22
|
|---|
| 2 | ;;22.0;VA FileMan;**41**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | EN ;
|
|---|
| 7 | I '$D(@DIFRFIA) D ERR(2) Q
|
|---|
| 8 | ;N DIFRFILP S DIFRFILP=$D(DIFRFILP)#2
|
|---|
| 9 | N %,%H,A,B,D,D0,D1,DA,DDF,DDT,DFL,DFN,DFR,DIC,DIFL,DIIX,DIK,DINUM,DIU
|
|---|
| 10 | N DKP,DMRG,DTL,DTN,DTO,I,V,W,X,Y,Z
|
|---|
| 11 | G:$G(DIFRFILE) FILE
|
|---|
| 12 | S DIFRFILE=0 F S DIFRFILE=$O(@DIFRFIA@(DIFRFILE)) Q:DIFRFILE'>0 D FILE
|
|---|
| 13 | Q
|
|---|
| 14 | FCHK I '$D(@DIFRFIA@(DIFRFILE)) D ERR(5) Q ; * * * PHASING OUT * * *
|
|---|
| 15 | FILE N DIFRDA,DIFRND0,DIFROOT,DIFR01,DIFR02,DIFRRLR,DIFRFRV
|
|---|
| 16 | N DIFRDKP,DIFRDKPD,DIFRDKPR,DIFRDKPS
|
|---|
| 17 | D KILL
|
|---|
| 18 | I '$D(@DIFRFIA) D ERR(2) Q
|
|---|
| 19 | I $G(@DIFRFIA@(DIFRFILE,DIFRFILE)) D Q
|
|---|
| 20 | .N DIFRERR S DIFRERR(1)=DIFRFILE
|
|---|
| 21 | .D BLD^DIALOG(9515,.DIFRERR)
|
|---|
| 22 | .Q
|
|---|
| 23 | S DIFROOT=@DIFRFIA@(DIFRFILE,0),DIFRDA=0
|
|---|
| 24 | S DIFR01=@DIFRFIA@(DIFRFILE,0,1),DIFR02=$G(^(2))
|
|---|
| 25 | I $P(DIFR02,"^",8)="" S $P(DIFR02,"^",8)=$$TL^DIFROMSP(DIFRFILE,"",DIFRSA)
|
|---|
| 26 | S DIFRRLR=$G(@DIFRFIA@(DIFRFILE,0,"RLRI")) ; * * * phasing out * * *
|
|---|
| 27 | S:DIFRRLR="" DIFRRLR=$NA(@DIFRSA@("DATA",DIFRFILE))
|
|---|
| 28 | I $D(@DIFRRLR)'>9 D ERR(4) Q
|
|---|
| 29 | ;
|
|---|
| 30 | ; Recover from a failure in Replace Mode RE-INSTALL on target system
|
|---|
| 31 | I $D(@DIFRSA@("TMP")) D K @DIFRSA@("TMP")
|
|---|
| 32 | .S (D,DDF(1),DDT(0))=DIFRFILE
|
|---|
| 33 | .S DTO=0,DMRG=1,DTO(0)=DIFROOT,DKP=$S($TR($P(DIFR01,"^",8),"O","o")="o":0,1:1)
|
|---|
| 34 | .S DFR(1)=$$OREF^DILF(DIFRSA)_"""TMP"",DIFRFILE,D0,"
|
|---|
| 35 | .S D0=$O(@DIFRSA@("TMP",DIFRFILE,0)) Q:'$D(^(D0,0)) S Z=^(0)
|
|---|
| 36 | .D I^DITR,REINDEX
|
|---|
| 37 | .D KILL Q
|
|---|
| 38 | ;
|
|---|
| 39 | F S DIFRDA=$O(@DIFRRLR@(DIFRDA)) Q:DIFRDA'>0 D
|
|---|
| 40 | .S (D,DDF(1),DDT(0))=DIFRFILE
|
|---|
| 41 | .S DTO=0,DMRG=1,DTO(0)=DIFROOT
|
|---|
| 42 | .S DFR(1)=$$OREF^DILF($NA(@DIFRSA@("DATA")))_"DDF(1),D0,"
|
|---|
| 43 | .S DKP=$S($TR($P(DIFR01,"^",8),"O","o")="o":0,1:1)
|
|---|
| 44 | .S (DIFRDKPD,DIFRDKPR)=$S($TR($P(DIFR01,"^",8),"R","r")="r":1,1:0)
|
|---|
| 45 | .S (DIFRND0,DIFRDKP)=0
|
|---|
| 46 | .S:+DIFR02 (DIFRDKPD,DIFRDKPR)=0 ;if file is new Replace not needed
|
|---|
| 47 | .S DIFRDKPS=$P(DIFR02,"^",8) ;save local data
|
|---|
| 48 | .S DIFRFRV=$TR($P(DIFR01,"^",5),"Y","y")="y"
|
|---|
| 49 | .S D0=DIFRDA,Z=@DIFRSA@("DATA",DIFRFILE,DIFRDA,0)
|
|---|
| 50 | .K @DIFRSA@("TMP")
|
|---|
| 51 | .D I^DITR,REINDEX
|
|---|
| 52 | .; If no data in local fields, quit.
|
|---|
| 53 | .I $D(@DIFRSA@("TMP"))'>9 D KILL Q
|
|---|
| 54 | .; restore data in local fields from old entry
|
|---|
| 55 | .S DIFRDKP=1,DIFRFRV=0
|
|---|
| 56 | .K DFR,DA,D0
|
|---|
| 57 | .;S DFR(1)="^TMP(""DIFRDKPD"",$J,DIFRFILE,D0,"
|
|---|
| 58 | .S DFR(1)=$$OREF^DILF(DIFRSA)_"""TMP"",DIFRFILE,D0,"
|
|---|
| 59 | .S D0=$O(@DIFRSA@("TMP",DIFRFILE,0)) Q:'$D(^(D0,0)) S Z=^(0)
|
|---|
| 60 | .D I^DITR,REINDEX,KILL
|
|---|
| 61 | .Q
|
|---|
| 62 | K @DIFRSA@("TMP")
|
|---|
| 63 | ; DO A CHECK HERE LIKE Q:'$D(DIFQ) LATER ON
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | KILL K %,%H,A,B,D,D0,D1,DA,DDF,DDT,DFL,DFN,DFR,DIC,DIFL,DIIX,DIK,DINUM,DIU
|
|---|
| 67 | K DKP,DMRG,DTL,DTN,DTO,I,V,W,X,Y,Z Q
|
|---|
| 68 | ;
|
|---|
| 69 | REINDEX ; REINDEX ENTRY
|
|---|
| 70 | Q:DIFRND0'>0
|
|---|
| 71 | N DIK,DA S DA=DIFRND0,DIK=DIFROOT,DIK(0)="AB"
|
|---|
| 72 | D IX1^DIK Q
|
|---|
| 73 | ;
|
|---|
| 74 | ERR(X) N Y S Y=$P($T(ERR+X),";",5) Q:'Y D BLD^DIALOG(Y) Q
|
|---|
| 75 | ;;FIA Node Is Set To "No Data";1;9509
|
|---|
| 76 | ;;FIA Array Does Not Exist;2;9501
|
|---|
| 77 | ;;;3;
|
|---|
| 78 | ;;Records Do Not Exist;4;9510
|
|---|
| 79 | ;;FIA File Number Invalid;5;9502
|
|---|
| 80 | ;;Partial DD. No sending of data allowed for file |1|;1;9515
|
|---|
