Return to DIFROMS4.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFROMS4.m, revision 1.1

1.1     ! snw         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