[BACK]Return to DIFROMSI.m CVS log [TXT] [DIR] Up to [Coherent Logic Development] / freem_fileman / USER
File:  [Coherent Logic Development] / freem_fileman / USER / DIFROMSI.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    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>