Return to DIT3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIT3.m, revision 1.1

1.1     ! snw         1: DIT3   ;SFISC/TKW - SILENT TRANSFER/MERGE ROUTINE ;10/14/94  13:50
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: TRNMRG ; TRANSFER OR MERGE RECORDS SILENTLY (CALLED FROM TRNMRG^DIT)
        !             5:        N I,J,Z,DITYPM,DDF,DDT,DFR,DMRG,DKP,DTO,DFL,DTL,DA,DIZZ,DIERRMSG,DIK,DITF D CLEAN^DIEFU
        !             6:        F I=1:1 S DITYPM=$E(DIFLG,I) Q:DITYPM=""  Q:"MOAR"[DITYPM
        !             7:        I DITYPM="" G ERR0
        !             8:        I '$G(DIFFNO),$G(DITFNO) S DFR=DIFFNO,DIFFNO=+DITFNO I $E(DFR,$L(DFR))=")" S DFR=$$OREF^DIQGU(DFR)
        !             9:        I '$G(DIFFNO)!('$D(^DD(+$G(DIFFNO),.01,0))) S DIERRMSG=$$EZBLD^DIALOG(8082)_" "_$$EZBLD^DIALOG(8084) G ERR3
        !            10:        S DITFNO=+$G(DITFNO) S:'DITFNO DITFNO=DIFFNO I DITFNO'=DIFFNO,'$D(^DD(DITFNO,.01,0)) S DIERRMSG=$$EZBLD^DIALOG(8083)_" "_$$EZBLD^DIALOG(8084) G ERR3
        !            11:        I '$G(DIFIEN) S DIERRMSG=$$EZBLD^DIALOG(8082)_" "_$$EZBLD^DIALOG(8085) G ERR3
        !            12:        F I=0:1 S J=$P(DIFIEN,",",I+1) Q:'J  S DA(I)=J,DFL=I*2+1
        !            13:        S (I,J)=I-1 D  G:I'=J ERR5
        !            14:        . I I=0,$D(^DD(DIFFNO,0,"UP")) S J=-1 Q
        !            15:        . N Z S Z=DIFFNO,J=0 F  Q:'$D(^DD(Z,0,"UP"))  S J=J+1,Z=^("UP")
        !            16:        . Q
        !            17:        S J=0
        !            18: SD0    N @("D"_J) S @("D"_J)=DA(I),I=I-1,J=J+1 I I>-1 G SD0
        !            19:        S DA=DA(0) K DA(0)
        !            20:        S DDF(DFL)=DIFFNO,DDT(DFL-1)=DITFNO S:DIFFNO=DITFNO DDT(DFL)=DITFNO
        !            21:        S DFR(DFL)=$S($G(DFR)]"":DFR,1:$$ROOT^DIQGU(DIFFNO,DIFIEN,"",1))_+DIFIEN_"," Q:$D(DIERR)  G:'$D(@(DFR(DFL)_"0)")) ERR1 S DIZZ=^(0)
        !            22:        S:$G(DITIEN)="" DITIEN="+?1,"_$P(DIFIEN,",",2,99)
        !            23:        Q:'$$IENCHK(DITFNO,DITIEN)
        !            24:        S (DTO(DFL-1),DIK)=$$ROOT^DIQGU(DITFNO,DITIEN,"",1) Q:$D(DIERR)
        !            25:        I DITIEN S DTO(DFL)=DTO(DFL-1)_+DITIEN_"," I '$D(@(DTO(DFL)_"0)")) G ERR2
        !            26:        I 'DITIEN,$D(^DD(DITFNO,0,"UP")) D  I '$D(DITIEN) G ERR2
        !            27:        . N X,Y,Z S X=^DD(DITFNO,0,"UP"),Y=$P(DITIEN,",",2,99),Z=$$ROOT^DIQGU(X,Y) I $D(DIERR) K DITIEN Q
        !            28:        . I '$D(@(Z_$P(Y,",")_",0)")) K DITIEN Q
        !            29:        . I $P($G(^DD(DITFNO,.01,0)),U,2)["W" K DITIEN Q
        !            30:        . I '$D(@(DTO(DFL-1)_"0)")) S Z=$O(^DD(X,"SB",DITFNO,0)) I Z S Z=$P($G(^DD(X,Z,0)),U,2) I Z S @(DTO(DFL-1)_"0)")="^"_Z_"^^"
        !            31:        . Q
        !            32:        I DIFFNO'=DITFNO D  I '$D(DITF) G ERR4
        !            33:        . N %,A,L,V,X,Y,Z,DIC K ^UTILITY("DITR",$J)
        !            34:        . S A=1,L=0,L(DDF(DFL))=DDT(DFL-1)
        !            35:        . D MAP2^DIT Q
        !            36:        S DMRG=$S(DIFLG["A":0,1:1),DKP=$S(DIFLG["M":1,1:0),DTO=$S(DIFFNO=DITFNO:0,1:1)
        !            37:        N %,A,B,V,W,X,Y,DFN,DTN,DINUM,DIC,DIIX
        !            38:        I 'DITIEN D  Q:A
        !            39:        . S (DFL,DTL)=DFL-1,Z=DIZZ D ^DITR1 Q:A
        !            40:        . S DFL=DFL+1,DITIEN=+Y_","_$P(DITIEN,",",2,99)
        !            41:        . Q
        !            42:        S DTL=DFL,DFN(DFL)=-1 D N^DITR
        !            43:        I DIFLG'["X" Q
        !            44:        K DA F I=1:1 S J=$P(DITIEN,",",I) Q:'J  S:I=1 DA=J I I>1 S DA(I-1)=J
        !            45:        D IXALL^DIK
        !            46:        Q
        !            47:        ;
        !            48: IENCHK(DIFILE,DIIEN)   ;EXTRINSIC FUNCTIO TO CHECK THAT IEN STRING AND FILE/SUBFILE NO. ARE IN SYNC
        !            49:        ;DIFILE=file/subfile#, DIIEN=IEN string
        !            50:        N I,J
        !            51:        S I=$L($G(DIIEN),",") I I=1 G ERX
        !            52:        S I=I-1,J=0 D  I I'=J G ERX
        !            53:        . I I=1,$D(^DD(DIFILE,0,"UP")) Q
        !            54:        . S J=1 F  Q:'$D(^DD(DIFILE,0,"UP"))  S J=J+1,DIFILE=^("UP")
        !            55:        . Q
        !            56:        Q 1
        !            57: ERX    K I S I(1)=DIFILE,I("IENS")=DIIEN D BLD^DIALOG(205,.I) Q 0
        !            58:        ;
        !            59: ERR0   D BLD^DIALOG(301,DIFLG) Q
        !            60: ERR1   S DIERRMSG=$$EZBLD^DIALOG(8082)_" "_$$EZBLD^DIALOG(8078) G ERR3
        !            61: ERR2   S DIERRMSG=$$EZBLD^DIALOG(8083)_" "_$$EZBLD^DIALOG(8078)
        !            62: ERR3   D BLD^DIALOG(202,DIERRMSG) Q
        !            63: ERR4   D BLD^DIALOG(1504) Q
        !            64: ERR5   K I S I(1)=DIFFNO,I("IENS")=DIFIEN D BLD^DIALOG(205,.I) Q
        !            65:        ;202  The input param...that identifies...|1| is missing or invalid.
        !            66:        ;205  File...number and IEN string represent different...levels.       
        !            67:        ;301  The passed flag(s) '|1|' are unknown or inconsistent.
        !            68:        ;1504  No matching .01 field names...Transfer/Merge cannot be done
        !            69:        ;8082  Transfer FROM
        !            70:        ;8083  Transfer TO
        !            71:        ;8084  file number
        !            72:        ;8085  IEN string
        !            73:        ;