Return to DIFROMS4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIFROMS4	;SFISC/DCL- DATA FROM DISTRIBUTION ARRAY;03:10 PM  14 Sep 1994;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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: 	G:$G(DIFRFILE) FILE
   10: 	S DIFRFILE=0 F  S DIFRFILE=$O(@DIFRFIA@(DIFRFILE)) Q:DIFRFILE'>0  D FILE
   11: 	Q
   12: FCHK	I '$D(@DIFRFIA@(DIFRFILE)) D ERR(5) Q  ;  * * * PHASING OUT * * *
   13: FILE	N DIFRS,DIFRSCR,DIFRDA,DIFRND0,DIFROOT,DIFR01,DIFR02,DIFRRLR
   14: 	N DIFRQ,DIFRTART,D,DDF,DDT,DTO,DFR,D0,DA,DKP,DIFRFRV,DIFRFRV1,DIFRFRV2
   15: 	N DTL,DMRG,DIU,DIK,DIIX,DIC,DFL,D0,D1,A,B,%H,V,W,X,Y,Z
   16: 	N DIFRDKP,DIFRDKPD,DIFRDKPR,DIFRDKPS,DIFRNOAD,DIFRX
   17: 	I '$D(@DIFRFIA) D ERR(2) Q
   18: 	I $G(@DIFRFIA@(DIFRFILE,DIFRFILE)) D  Q
   19: 	.N DIFRERR S DIFRERR(1)=DIFRFILE
   20: 	.D BLD^DIALOG(9515,.DIFRERR)
   21: 	.Q
   22: 	S DIFROOT=@DIFRFIA@(DIFRFILE,0),DIFRDA=0
   23: 	S DIFR01=@DIFRFIA@(DIFRFILE,0,1),DIFR02=$G(^(2))
   24: 	I $P(DIFR02,"^",8)="" S $P(DIFR02,"^",8)=$$TL^DIFROMSP(DIFRFILE,"",DIFRSA)
   25: 	S DIFRRLR=$G(@DIFRFIA@(DIFRFILE,0,"RLRI"))  ;  * * * phasing out * * *
   26: 	S:DIFRRLR="" DIFRRLR=$NA(@DIFRSA@("DATA",DIFRFILE))
   27: 	I $D(@DIFRRLR)'>9 D ERR(4) Q
   28: 	S (D,DDF(1),DDT(0))=DIFRFILE
   29: 	;
   30: 	;   Recover from a failure in Replace Mode RE-INSTALL on target system
   31: 	I $D(@DIFRSA@("TMP")) D  K @DIFRSA@("TMP")
   32: 	.N DFR,DA,D0,DTO,DKP,Z
   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
   37: 	.Q
   38: 	;
   39: 	F  S DIFRDA=$O(@DIFRRLR@(DIFRDA)) Q:DIFRDA'>0  D
   40: 	.S DTO=0,DMRG=1,DTO(0)=DIFROOT
   41: 	.S DFR(1)=$$OREF^DILF($NA(@DIFRSA@("DATA")))_"DDF(1),D0,"
   42: 	.S DKP=$S($TR($P(DIFR01,"^",8),"O","o")="o":0,1:1)
   43: 	.S (DIFRDKPD,DIFRDKPR)=$S($TR($P(DIFR01,"^",8),"R","r")="r":1,1:0)
   44: 	.S (DIFRND0,DIFRDKP)=0
   45: 	.S:+DIFR02 (DIFRDKPD,DIFRDKPR)=0  ;if file is new Replace not needed
   46: 	.S DIFRDKPS=$P(DIFR02,"^",8)  ;save local data
   47: 	.S DIFRFRV=$TR($P(DIFR01,"^",5),"Y","y")="y"
   48: 	.S D0=DIFRDA,Z=@DIFRSA@("DATA",DIFRFILE,DIFRDA,0)
   49: 	.K @DIFRSA@("TMP")
   50: 	.D I^DITR
   51: 	.Q:$D(@DIFRSA@("TMP"))'>9
   52: 	.;           re-index entry so old data can find it, in DITR1
   53: 	.D:DIFRND0
   54: 	..N %,A,B,D0,DA,DIK,DDF,DDT,DFL,DFN,DFR,DKPKDMGR,DTL,DTN,DTO,I,V,W,X,Y,Z
   55: 	..S DA=DIFRND0,DIK=DIFROOT
   56: 	..D IX1^DIK
   57: 	..Q
   58: 	.;           preserve data in local fields from old entry
   59: 	.S DIFRDKP=1,DIFRFRV=0
   60: 	.N DFR,DA,D0
   61: 	.;S DFR(1)="^TMP(""DIFRDKPD"",$J,DIFRFILE,D0,"
   62: 	.S DFR(1)=$$OREF^DILF(DIFRSA)_"""TMP"",DIFRFILE,D0,"
   63: 	.S D0=$O(@DIFRSA@("TMP",DIFRFILE,0)) Q:'$D(^(D0,0))  S Z=^(0)
   64: 	.D I^DITR
   65: 	.Q
   66: 	K DDF,DDT,DDO,DFR,DFN,DTN,@DIFRSA@("TMP")
   67: 	; DO A CHECK HERE LIKE Q:'$D(DIFQ) LATER ON
   68: 	S DIK=DIFROOT,DIK(0)="AB"
   69: 	D IXALL^DIK:$O(@(DIK_"0)"))
   70: 	Q
   71: ERR(X)	N Y S Y=$P($T(ERR+X),";",5) Q:'Y  D BLD^DIALOG(Y) Q
   72: 	;;FIA Node Is Set To "No Data";1;9509
   73: 	;;FIA Array Does Not Exist;2;9501
   74: 	;;;3;
   75: 	;;Records Do Not Exist;4;9510
   76: 	;;FIA File Number Invalid;5;9502
   77: 	;; *PARTIAL DD*, Data Transport Not Allowed