freem_fileman/USER/DIT3.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DIT3.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

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: ;