source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIFROMS4.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1DIFROMS4 ;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
6EN ;
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
14FCHK I '$D(@DIFRFIA@(DIFRFILE)) D ERR(5) Q ; * * * PHASING OUT * * *
15FILE 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 ;
66KILL 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 ;
69REINDEX ; REINDEX ENTRY
70 Q:DIFRND0'>0
71 N DIK,DA S DA=DIFRND0,DIK=DIFROOT,DIK(0)="AB"
72 D IX1^DIK Q
73 ;
74ERR(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
Note: See TracBrowser for help on using the repository browser.