116 lines
4.2 KiB
Mathematica
116 lines
4.2 KiB
Mathematica
DIFROMSI ;SCISC/DCL-EDE IN ;3:19 PM 16 Nov 2001
|
|
;;22.0;VA FileMan;**94**;Mar 30, 1999
|
|
;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
|
|
;
|
|
; preserve security codes if template/form is not new
|
|
I $G(DIFRFLG)'["N",DIFRFILE'=.5 D
|
|
.N X,Y
|
|
.S Y=@DIFRRDA@(0)
|
|
.S X=@DIFRSA@(DIFRFILE,DIFROIEN,0),$P(X,U,3)=$P(Y,U,3),$P(X,U,6)=$P(Y,U,6),^(0)=X
|
|
.Q
|
|
;
|
|
I DIFRFILE'=.403 K @DIFRRDA
|
|
E D
|
|
.Q:$G(DIFRFLG)["N"
|
|
.N DA,DIC,DIK,DINUM,X,Y,DO
|
|
.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 ENGRP^DDSZ(DIFRIEN) 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
|