Return to DIFROMSI.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIFROMSI	;SCISC/DCL-EDE IN ;08:42 AM  22 Nov 1994;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
FPRE(DIFRFILE,DIFRFLG,DIFRNAME,DIFRSA)	;
	G FPRE^DIFROMSC
EPRE(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA,DIFROIEN)	;
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1
	I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
	N DIOVRD S DIOVRD=1
	N DIFRRDA,DIFRX
	S DIFRFILE=$G(DIFRFILE) S:DIFRFILE'>0 DIFRFILE=$G(XPDFIL)
	I DIFRFILE'>0 D BLD^DIALOG(9521) Q
	S DIFRIEN=$G(DIFRIEN) S:DIFRIEN'>0 DIFRIEN=$G(DA)
	I DIFRIEN'>0 D BLD^DIALOG(9522) Q
	S DIFROIEN=$G(DIFROIEN) S:DIFROIEN'>0 DIFROIEN=$G(OLDA)
	I DIFROIEN'>0 D BLD^DIALOG(9523) Q
	I $G(DIFRNAME)="" D BLD^DIALOG(9524) Q
	I $G(DIFRSA)="" S DIFRSA=$NA(^XTMP("XPDI",DIFRNAME,"KRN"))
	S DIFRRDA=$$CREF^DIQGU($$ROOT^DIQGU(DIFRFILE)_DIFRIEN)
	S DIFRX=$P(@DIFRRDA@(0),"^")
	G:DIFRFILE=.84 DIALOG
	I DIFRFILE'=.403 K @DIFRRDA
	E  D
	.Q:$G(DIFRFLG)["N"
	.N DA,DIC,DIK,DINUM,X,Y
	.S DIK="^DIST(.403,",DA=DIFRIEN
	.D ^DIK
	.S DIC="^DIST(.403,",DIC(0)="LX",X=DIFRX,DINUM=DIFRIEN
	.D FILE^DICN
	.Q
	I DIFRFILE=.403 D
	.N DIFRA0,DIFRA1,DIFRA2,DIFRJ,DIFRL,DIFRP,DIFRX,DIFRY
	.S DIFRJ=0
	.F  S DIFRJ=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ)) Q:'DIFRJ  I $D(^(DIFRJ,0)) S DIFRP=$P(^(0),"^",2) D
	..S:DIFRP]"" DIFRP=$O(^DIST(.404,"B",DIFRP,0))
	..S:DIFRP $P(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,0),"^",2)=DIFRP
	..S DIFRL=0
	..F  S DIFRL=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL)) Q:'DIFRL  S DIFRA0=$G(^(DIFRL,0)),DIFRP=$P(DIFRA0,"^") I DIFRP]"" D
	...S DIFRP=$O(^DIST(.404,"B",DIFRP,0)) I DIFRP D
	....S $P(DIFRA0,"^")=DIFRP,@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,0)=DIFRA0
	....N DIFRX
	....S DIFRX=0
	....F  S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)) Q:DIFRX=""  S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,DIFRX)=^(DIFRX)
	....Q
	...Q
	..S DIFRA0=$G(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0))
	..Q:DIFRA0=""
	..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40)
	..S (DIFRA1,DIFRA2)=0
	..S DIFRL=0
	..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
	...N DIFRX
	...S DIFRX=0
	...F  S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRL,DIFRX)) Q:DIFRX=""  S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)=^(DIFRX)
	...Q
	..S $P(DIFRA0,"^",3,4)=DIFRA1_"^"_DIFRA2
	..S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0)=DIFRA0
	..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK")
	..Q
	.Q
	Q
DIALOG	N DIFRF,DIFRX
	S DIFRF=$P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)
	I DIFRF]"" D
	.S DIFRF=$O(^DIC(9.4,"B",DIFRF,0)) I DIFRF,$O(^(DIFRF)) D  S DIFRF=""
	..N DIFRERR S DIFRERR(1)=DIFRF,DIFRERR(2)=DIFRIEN
	..D BLD^DIALOG(9525,.DIFRERR)
	..Q
	.S $P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)=DIFRF
	F DIFRX=1,2,3,5,6 K @DIFRRDA@(DIFRX)
	Q
EPOST(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA)	;
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1
	I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
	N DIOVRD S DIOVRD=1
	I '$G(DIFRFILE)!('$G(DIFRIEN)) Q
	I $G(DIFRNAME)="" Q
	S:$G(DIFRSA)']"" DIFRSA=$NA(^XTMP("XPDI",DIFRNAME))
	N DA,DIFR,DIFR3,DIFROU,DIK,DMAX,DNM,X,Y,Z,DIFRTN
	S DIK=$$ROOT^DILFD(DIFRFILE),DA=DIFRIEN
	D IX1^DIK
	I DIFRFILE=.403,DIFRIEN D  Q
	.I $$VAL^DIFROMSS(DIFRFILE,DIFRIEN) D EN^DDSZ(DIFRIEN) Q
	.S DIFRTN=$P($G(^DIST(.403,DIFRIEN,0)),"^")
	.N DIFRERR S DIFRERR(1)=DIFRTN
	.D BLD^DIALOG(9527,.DIFRERR)
	.Q
	S DIFR=$S(DIFRFILE=.4:"DIPT",DIFRFILE=.402:"DIE",1:"")
	Q:DIFR=""
	I ^DD("VERSION")>17.4,'$D(DISYS) D OS^DII
	E  S DISYS=^DD("OS")
	I '$D(^DD("OS",DISYS,"ZS")) D BLD^DIALOG(9526) Q
	S Y=DIFRIEN
	I $D(@("^"_DIFR_"(Y,""ROU"")")) K ^("ROU") I $D(^("ROUOLD")) S (DIFROU,X)=^("ROUOLD"),DIFRTN=$P(^(0),"^") D:X]""
	.N %X,DIR,DMAX,X,Y,DIFRZTA
	.S DIFR3="DI"_$E(DIFR,3)_"Z"
	.I $$VAL^DIFROMSS(DIFRFILE,DIFRIEN) D  Q
	..D @("EN2^"_DIFR3_"(DIFRIEN,"""",DIFROU,"""",""DIFRZTA"")")
	..I $D(DIFRZTA) M @DIFRSA@(DIFR3,DIFRIEN)=DIFRZTA
	..S @DIFRSA@(DIFR3,DIFRIEN)=DIFROU
	..Q
	.N DIFRTT,DIFRERR S DIFRTT=$S(DIFRFILE=.4:"PRINT",1:"INPUT")
	.S DIFRERR(1)=DIFRTT,DIFRERR(2)=DIFRTN
	.D BLD^DIALOG(9528,.DIFRERR)
	.Q
	Q
FPOST	;
	G FPOST^DIFROMSC
EXIT	I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
	Q