source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIFROMSC.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1DIFROMSC ;SCISC/DCL-EDE IN CONTINUE FPRE & FPOST ;08:38 AM 22 Nov 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4FPRE ;
5 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
6 I '$D(DIFM) N DIFM S DIFM=1
7 I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
8 N DIOVRD S DIOVRD=1
9 S DIFRFILE=$G(DIFRFILE) S:DIFRFILE'>0 DIFRFILE=$G(XPDFIL)
10 I DIFRFILE'>0 D BLD^DIALOG(9519) Q
11 Q:DIFRFILE'=.403
12 I $G(DIFRNAME)="" D BLD^DIALOG(9520) Q
13 I $G(DIFRSA)="" S DIFRSA=$NA(^XTMP("XPDI",DIFRNAME,"KRN"))
14 I DIFRFILE=.403 D Q
15 .N DIC,DIK,DIFRR,DIFRFILE,DIFRL,DIFRX,X,Y
16 .S DIC="^DIST(.404,",DIC(0)="LX",DLAYGO=.404,DIFRFILE=.404
17 .S DIFRR=0
18 .F S DIFRR=$O(@DIFRSA@(DIFRFILE,DIFRR)) Q:DIFRR'>0 S DIFRX=^(DIFRR,0) D
19 ..S DIFRL=$P(DIFRX,"^",2)
20 ..S X=$P(DIFRX,"^")
21 ..K DA
22 ..D ^DIC
23 ..I Y'>0 D Q
24 ...N DIFRERR S DIFRERR(1)=$P(DIFRX,"^")
25 ...D BLD^DIALOG(9517,.DIFRERR)
26 ...Q
27 ..K ^DIST(.404,+Y)
28 ..I '$D(^DD(+DIFRL)) D
29 ...N DIFRERR S DIFRERR(1)=$P(DIFRX,"^"),DIFRERR(2)=DIFRL
30 ...D BLD^DIALOG(9518,.DIFRERR)
31 ...Q
32 ..M ^DIST(.404,+Y)=@DIFRSA@(DIFRFILE,DIFRR)
33 ..S DIK=DIC,DA=+Y
34 ..D IX1^DIK
35 ..Q
36 .Q
37 Q
38FPOST ;
39 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
40 I '$D(DIFM) N DIFM S DIFM=1
41 I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
42 N DIOVRD S DIOVRD=1
43 Q
44EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
45 Q
Note: See TracBrowser for help on using the repository browser.