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

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1DIFROMSI ;SCISC/DCL-EDE IN ;3:19 PM 16 Nov 2001
2 ;;22.0;VA FileMan;**94**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4FPRE(DIFRFILE,DIFRFLG,DIFRNAME,DIFRSA) ;
5 G FPRE^DIFROMSC
6EPRE(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA,DIFROIEN) ;
7 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
8 I '$D(DIFM) N DIFM S DIFM=1
9 I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
10 N DIOVRD S DIOVRD=1
11 N DIFRRDA,DIFRX
12 S DIFRFILE=$G(DIFRFILE) S:DIFRFILE'>0 DIFRFILE=$G(XPDFIL)
13 I DIFRFILE'>0 D BLD^DIALOG(9521) Q
14 S DIFRIEN=$G(DIFRIEN) S:DIFRIEN'>0 DIFRIEN=$G(DA)
15 I DIFRIEN'>0 D BLD^DIALOG(9522) Q
16 S DIFROIEN=$G(DIFROIEN) S:DIFROIEN'>0 DIFROIEN=$G(OLDA)
17 I DIFROIEN'>0 D BLD^DIALOG(9523) Q
18 I $G(DIFRNAME)="" D BLD^DIALOG(9524) Q
19 I $G(DIFRSA)="" S DIFRSA=$NA(^XTMP("XPDI",DIFRNAME,"KRN"))
20 S DIFRRDA=$$CREF^DIQGU($$ROOT^DIQGU(DIFRFILE)_DIFRIEN)
21 S DIFRX=$P(@DIFRRDA@(0),"^")
22 G:DIFRFILE=.84 DIALOG
23 ;
24 ; preserve security codes if template/form is not new
25 I $G(DIFRFLG)'["N",DIFRFILE'=.5 D
26 .N X,Y
27 .S Y=@DIFRRDA@(0)
28 .S X=@DIFRSA@(DIFRFILE,DIFROIEN,0),$P(X,U,3)=$P(Y,U,3),$P(X,U,6)=$P(Y,U,6),^(0)=X
29 .Q
30 ;
31 I DIFRFILE'=.403 K @DIFRRDA
32 E D
33 .Q:$G(DIFRFLG)["N"
34 .N DA,DIC,DIK,DINUM,X,Y,DO
35 .S DIK="^DIST(.403,",DA=DIFRIEN
36 .D ^DIK
37 .S DIC="^DIST(.403,",DIC(0)="LX",X=DIFRX,DINUM=DIFRIEN
38 .D FILE^DICN
39 .Q
40 I DIFRFILE=.403 D
41 .N DIFRA0,DIFRA1,DIFRA2,DIFRJ,DIFRL,DIFRP,DIFRX,DIFRY
42 .S DIFRJ=0
43 .F S DIFRJ=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ)) Q:'DIFRJ I $D(^(DIFRJ,0)) S DIFRP=$P(^(0),"^",2) D
44 ..S:DIFRP]"" DIFRP=$O(^DIST(.404,"B",DIFRP,0))
45 ..S:DIFRP $P(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,0),"^",2)=DIFRP
46 ..S DIFRL=0
47 ..F S DIFRL=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL)) Q:'DIFRL S DIFRA0=$G(^(DIFRL,0)),DIFRP=$P(DIFRA0,"^") I DIFRP]"" D
48 ...S DIFRP=$O(^DIST(.404,"B",DIFRP,0)) I DIFRP D
49 ....S $P(DIFRA0,"^")=DIFRP,@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,0)=DIFRA0
50 ....N DIFRX
51 ....S DIFRX=0
52 ....F S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)) Q:DIFRX="" S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,DIFRX)=^(DIFRX)
53 ....Q
54 ...Q
55 ..S DIFRA0=$G(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0))
56 ..Q:DIFRA0=""
57 ..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40)
58 ..S (DIFRA1,DIFRA2)=0
59 ..S DIFRL=0
60 ..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
61 ...N DIFRX
62 ...S DIFRX=0
63 ...F S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRL,DIFRX)) Q:DIFRX="" S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)=^(DIFRX)
64 ...Q
65 ..S $P(DIFRA0,"^",3,4)=DIFRA1_"^"_DIFRA2
66 ..S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0)=DIFRA0
67 ..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK")
68 ..Q
69 .Q
70 Q
71DIALOG N DIFRF,DIFRX
72 S DIFRF=$P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)
73 I DIFRF]"" D
74 .S DIFRF=$O(^DIC(9.4,"B",DIFRF,0)) I DIFRF,$O(^(DIFRF)) D S DIFRF=""
75 ..N DIFRERR S DIFRERR(1)=DIFRF,DIFRERR(2)=DIFRIEN
76 ..D BLD^DIALOG(9525,.DIFRERR)
77 ..Q
78 .S $P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)=DIFRF
79 F DIFRX=1,2,3,5,6 K @DIFRRDA@(DIFRX)
80 Q
81EPOST(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA) ;
82 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
83 I '$D(DIFM) N DIFM S DIFM=1
84 I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
85 N DIOVRD S DIOVRD=1
86 I '$G(DIFRFILE)!('$G(DIFRIEN)) Q
87 I $G(DIFRNAME)="" Q
88 S:$G(DIFRSA)']"" DIFRSA=$NA(^XTMP("XPDI",DIFRNAME))
89 N DA,DIFR,DIFR3,DIFROU,DIK,DMAX,DNM,X,Y,Z,DIFRTN
90 S DIK=$$ROOT^DILFD(DIFRFILE),DA=DIFRIEN
91 D IX1^DIK
92 I DIFRFILE=.403,DIFRIEN D ENGRP^DDSZ(DIFRIEN) Q
93 S DIFR=$S(DIFRFILE=.4:"DIPT",DIFRFILE=.402:"DIE",1:"")
94 Q:DIFR=""
95 I ^DD("VERSION")>17.4,'$D(DISYS) D OS^DII
96 E S DISYS=^DD("OS")
97 I '$D(^DD("OS",DISYS,"ZS")) D BLD^DIALOG(9526) Q
98 S Y=DIFRIEN
99 I $D(@("^"_DIFR_"(Y,""ROU"")")) K ^("ROU") I $D(^("ROUOLD")) S (DIFROU,X)=^("ROUOLD"),DIFRTN=$P(^(0),"^") D:X]""
100 .N %X,DIR,DMAX,X,Y,DIFRZTA
101 .S DIFR3="DI"_$E(DIFR,3)_"Z"
102 .I $$VAL^DIFROMSS(DIFRFILE,DIFRIEN) D Q
103 ..D @("EN2^"_DIFR3_"(DIFRIEN,"""",DIFROU,"""",""DIFRZTA"")")
104 ..I $D(DIFRZTA) M @DIFRSA@(DIFR3,DIFRIEN)=DIFRZTA
105 ..S @DIFRSA@(DIFR3,DIFRIEN)=DIFROU
106 ..Q
107 .N DIFRTT,DIFRERR S DIFRTT=$S(DIFRFILE=.4:"PRINT",1:"INPUT")
108 .S DIFRERR(1)=DIFRTT,DIFRERR(2)=DIFRTN
109 .D BLD^DIALOG(9528,.DIFRERR)
110 .Q
111 Q
112FPOST ;
113 G FPOST^DIFROMSC
114EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
115 Q
Note: See TracBrowser for help on using the repository browser.