DIFROMSC ;SCISC/DCL-EDE IN CONTINUE FPRE & FPOST ;08:38 AM 22 Nov 1994
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
FPRE ;
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
S DIFRFILE=$G(DIFRFILE) S:DIFRFILE'>0 DIFRFILE=$G(XPDFIL)
I DIFRFILE'>0 D BLD^DIALOG(9519) Q
Q:DIFRFILE'=.403
I $G(DIFRNAME)="" D BLD^DIALOG(9520) Q
I $G(DIFRSA)="" S DIFRSA=$NA(^XTMP("XPDI",DIFRNAME,"KRN"))
I DIFRFILE=.403 D Q
.N DIC,DIK,DIFRR,DIFRFILE,DIFRL,DIFRX,X,Y
.S DIC="^DIST(.404,",DIC(0)="LX",DLAYGO=.404,DIFRFILE=.404
.S DIFRR=0
.F S DIFRR=$O(@DIFRSA@(DIFRFILE,DIFRR)) Q:DIFRR'>0 S DIFRX=^(DIFRR,0) D
..S DIFRL=$P(DIFRX,"^",2)
..S X=$P(DIFRX,"^")
..K DA
..D ^DIC
..I Y'>0 D Q
...N DIFRERR S DIFRERR(1)=$P(DIFRX,"^")
...D BLD^DIALOG(9517,.DIFRERR)
...Q
..K ^DIST(.404,+Y)
..I '$D(^DD(+DIFRL)) D
...N DIFRERR S DIFRERR(1)=$P(DIFRX,"^"),DIFRERR(2)=DIFRL
...D BLD^DIALOG(9518,.DIFRERR)
...Q
..M ^DIST(.404,+Y)=@DIFRSA@(DIFRFILE,DIFRR)
..S DIK=DIC,DA=+Y
..D IX1^DIK
..Q
.Q
Q
FPOST ;
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
Q
EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFROMSC 1611 printed Dec 13, 2024@02:48:18 Page 2
DIFROMSC ;SCISC/DCL-EDE IN CONTINUE FPRE & FPOST ;08:38 AM 22 Nov 1994
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
FPRE ;
+1 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+2 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
+3 IF $GET(U)'="^"!($GET(DT)'>0)!($GET(DTIME)'>0)!('$DATA(DUZ))
DO DT^DICRW
+4 NEW DIOVRD
SET DIOVRD=1
+5 SET DIFRFILE=$GET(DIFRFILE)
if DIFRFILE'>0
SET DIFRFILE=$GET(XPDFIL)
+6 IF DIFRFILE'>0
DO BLD^DIALOG(9519)
QUIT
+7 if DIFRFILE'=.403
QUIT
+8 IF $GET(DIFRNAME)=""
DO BLD^DIALOG(9520)
QUIT
+9 IF $GET(DIFRSA)=""
SET DIFRSA=$NAME(^XTMP("XPDI",DIFRNAME,"KRN"))
+10 IF DIFRFILE=.403
Begin DoDot:1
+11 NEW DIC,DIK,DIFRR,DIFRFILE,DIFRL,DIFRX,X,Y
+12 SET DIC="^DIST(.404,"
SET DIC(0)="LX"
SET DLAYGO=.404
SET DIFRFILE=.404
+13 SET DIFRR=0
+14 FOR
SET DIFRR=$ORDER(@DIFRSA@(DIFRFILE,DIFRR))
if DIFRR'>0
QUIT
SET DIFRX=^(DIFRR,0)
Begin DoDot:2
+15 SET DIFRL=$PIECE(DIFRX,"^",2)
+16 SET X=$PIECE(DIFRX,"^")
+17 KILL DA
+18 DO ^DIC
+19 IF Y'>0
Begin DoDot:3
+20 NEW DIFRERR
SET DIFRERR(1)=$PIECE(DIFRX,"^")
+21 DO BLD^DIALOG(9517,.DIFRERR)
+22 QUIT
End DoDot:3
QUIT
+23 KILL ^DIST(.404,+Y)
+24 IF '$DATA(^DD(+DIFRL))
Begin DoDot:3
+25 NEW DIFRERR
SET DIFRERR(1)=$PIECE(DIFRX,"^")
SET DIFRERR(2)=DIFRL
+26 DO BLD^DIALOG(9518,.DIFRERR)
+27 QUIT
End DoDot:3
+28 MERGE ^DIST(.404,+Y)=@DIFRSA@(DIFRFILE,DIFRR)
+29 SET DIK=DIC
SET DA=+Y
+30 DO IX1^DIK
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
QUIT
+33 QUIT
FPOST ;
+1 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+2 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
+3 IF $GET(U)'="^"!($GET(DT)'>0)!($GET(DTIME)'>0)!('$DATA(DUZ))
DO DT^DICRW
+4 NEW DIOVRD
SET DIOVRD=1
+5 QUIT
EXIT IF $GET(DIFRMSGR)]""
DO CALLOUT^DIEFU(DIFRMSGR)
+1 QUIT
