Annotation of freem_fileman/USER/DIFROMSI.m, revision 1.1
1.1 ! snw 1: DIFROMSI ;SCISC/DCL-EDE IN ;08:42 AM 22 Nov 1994;
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: FPRE(DIFRFILE,DIFRFLG,DIFRNAME,DIFRSA) ;
! 5: G FPRE^DIFROMSC
! 6: EPRE(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA,DIFROIEN) ;
! 7: I '$D(DIQUIET) N DIQUIET S DIQUIET=1
! 8: I '$D(DIFM) N DIFM S DIFM=1
! 9: I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
! 10: N DIOVRD S DIOVRD=1
! 11: N DIFRRDA,DIFRX
! 12: S DIFRFILE=$G(DIFRFILE) S:DIFRFILE'>0 DIFRFILE=$G(XPDFIL)
! 13: I DIFRFILE'>0 D BLD^DIALOG(9521) Q
! 14: S DIFRIEN=$G(DIFRIEN) S:DIFRIEN'>0 DIFRIEN=$G(DA)
! 15: I DIFRIEN'>0 D BLD^DIALOG(9522) Q
! 16: S DIFROIEN=$G(DIFROIEN) S:DIFROIEN'>0 DIFROIEN=$G(OLDA)
! 17: I DIFROIEN'>0 D BLD^DIALOG(9523) Q
! 18: I $G(DIFRNAME)="" D BLD^DIALOG(9524) Q
! 19: I $G(DIFRSA)="" S DIFRSA=$NA(^XTMP("XPDI",DIFRNAME,"KRN"))
! 20: S DIFRRDA=$$CREF^DIQGU($$ROOT^DIQGU(DIFRFILE)_DIFRIEN)
! 21: S DIFRX=$P(@DIFRRDA@(0),"^")
! 22: G:DIFRFILE=.84 DIALOG
! 23: I DIFRFILE'=.403 K @DIFRRDA
! 24: E D
! 25: .Q:$G(DIFRFLG)["N"
! 26: .N DA,DIC,DIK,DINUM,X,Y
! 27: .S DIK="^DIST(.403,",DA=DIFRIEN
! 28: .D ^DIK
! 29: .S DIC="^DIST(.403,",DIC(0)="LX",X=DIFRX,DINUM=DIFRIEN
! 30: .D FILE^DICN
! 31: .Q
! 32: I DIFRFILE=.403 D
! 33: .N DIFRA0,DIFRA1,DIFRA2,DIFRJ,DIFRL,DIFRP,DIFRX,DIFRY
! 34: .S DIFRJ=0
! 35: .F S DIFRJ=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ)) Q:'DIFRJ I $D(^(DIFRJ,0)) S DIFRP=$P(^(0),"^",2) D
! 36: ..S:DIFRP]"" DIFRP=$O(^DIST(.404,"B",DIFRP,0))
! 37: ..S:DIFRP $P(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,0),"^",2)=DIFRP
! 38: ..S DIFRL=0
! 39: ..F S DIFRL=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL)) Q:'DIFRL S DIFRA0=$G(^(DIFRL,0)),DIFRP=$P(DIFRA0,"^") I DIFRP]"" D
! 40: ...S DIFRP=$O(^DIST(.404,"B",DIFRP,0)) I DIFRP D
! 41: ....S $P(DIFRA0,"^")=DIFRP,@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,0)=DIFRA0
! 42: ....N DIFRX
! 43: ....S DIFRX=0
! 44: ....F S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)) Q:DIFRX="" S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,DIFRX)=^(DIFRX)
! 45: ....Q
! 46: ...Q
! 47: ..S DIFRA0=$G(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0))
! 48: ..Q:DIFRA0=""
! 49: ..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40)
! 50: ..S (DIFRA1,DIFRA2)=0
! 51: ..S DIFRL=0
! 52: ..F S DIFRL=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRL)) Q:'DIFRL S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,0)=^(DIFRL,0),DIFRA1=DIFRL,DIFRA2=DIFRA2+1 D
! 53: ...N DIFRX
! 54: ...S DIFRX=0
! 55: ...F S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRL,DIFRX)) Q:DIFRX="" S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)=^(DIFRX)
! 56: ...Q
! 57: ..S $P(DIFRA0,"^",3,4)=DIFRA1_"^"_DIFRA2
! 58: ..S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0)=DIFRA0
! 59: ..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK")
! 60: ..Q
! 61: .Q
! 62: Q
! 63: DIALOG N DIFRF,DIFRX
! 64: S DIFRF=$P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)
! 65: I DIFRF]"" D
! 66: .S DIFRF=$O(^DIC(9.4,"B",DIFRF,0)) I DIFRF,$O(^(DIFRF)) D S DIFRF=""
! 67: ..N DIFRERR S DIFRERR(1)=DIFRF,DIFRERR(2)=DIFRIEN
! 68: ..D BLD^DIALOG(9525,.DIFRERR)
! 69: ..Q
! 70: .S $P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)=DIFRF
! 71: F DIFRX=1,2,3,5,6 K @DIFRRDA@(DIFRX)
! 72: Q
! 73: EPOST(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA) ;
! 74: I '$D(DIQUIET) N DIQUIET S DIQUIET=1
! 75: I '$D(DIFM) N DIFM S DIFM=1
! 76: I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
! 77: N DIOVRD S DIOVRD=1
! 78: I '$G(DIFRFILE)!('$G(DIFRIEN)) Q
! 79: I $G(DIFRNAME)="" Q
! 80: S:$G(DIFRSA)']"" DIFRSA=$NA(^XTMP("XPDI",DIFRNAME))
! 81: N DA,DIFR,DIFR3,DIFROU,DIK,DMAX,DNM,X,Y,Z,DIFRTN
! 82: S DIK=$$ROOT^DILFD(DIFRFILE),DA=DIFRIEN
! 83: D IX1^DIK
! 84: I DIFRFILE=.403,DIFRIEN D Q
! 85: .I $$VAL^DIFROMSS(DIFRFILE,DIFRIEN) D EN^DDSZ(DIFRIEN) Q
! 86: .S DIFRTN=$P($G(^DIST(.403,DIFRIEN,0)),"^")
! 87: .N DIFRERR S DIFRERR(1)=DIFRTN
! 88: .D BLD^DIALOG(9527,.DIFRERR)
! 89: .Q
! 90: S DIFR=$S(DIFRFILE=.4:"DIPT",DIFRFILE=.402:"DIE",1:"")
! 91: Q:DIFR=""
! 92: I ^DD("VERSION")>17.4,'$D(DISYS) D OS^DII
! 93: E S DISYS=^DD("OS")
! 94: I '$D(^DD("OS",DISYS,"ZS")) D BLD^DIALOG(9526) Q
! 95: S Y=DIFRIEN
! 96: I $D(@("^"_DIFR_"(Y,""ROU"")")) K ^("ROU") I $D(^("ROUOLD")) S (DIFROU,X)=^("ROUOLD"),DIFRTN=$P(^(0),"^") D:X]""
! 97: .N %X,DIR,DMAX,X,Y,DIFRZTA
! 98: .S DIFR3="DI"_$E(DIFR,3)_"Z"
! 99: .I $$VAL^DIFROMSS(DIFRFILE,DIFRIEN) D Q
! 100: ..D @("EN2^"_DIFR3_"(DIFRIEN,"""",DIFROU,"""",""DIFRZTA"")")
! 101: ..I $D(DIFRZTA) M @DIFRSA@(DIFR3,DIFRIEN)=DIFRZTA
! 102: ..S @DIFRSA@(DIFR3,DIFRIEN)=DIFROU
! 103: ..Q
! 104: .N DIFRTT,DIFRERR S DIFRTT=$S(DIFRFILE=.4:"PRINT",1:"INPUT")
! 105: .S DIFRERR(1)=DIFRTT,DIFRERR(2)=DIFRTN
! 106: .D BLD^DIALOG(9528,.DIFRERR)
! 107: .Q
! 108: Q
! 109: FPOST ;
! 110: G FPOST^DIFROMSC
! 111: EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
! 112: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIFROMSI.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman / USER