DIFROMSC.m

DIFROMSC ;SCISC/DCL-EDE IN CONTINUE FPRE & FPOST ;08:38 AM  22 Nov 1994

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

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

DIFROMSC  ;SCISC/DCL-EDE IN CONTINUE FPRE & FPOST ;08:38 AM  22 Nov 1994

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

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