- 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 Feb 19, 2025@00:14:33 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
