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

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1DIFROMSU ;SCISC/DCL-DIFROM SERVER BUILD "FIA" SUBSCRIPTS IN TRANSPORT ARRAY ;6/2/96 18:48
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4FIA(DIFRFILE,DIFRFLG,DIFRPFL,DIFRTAR,DIFR222,DIFR223,DIFRDSCR,DIFRVER,DIFRMSGR) ;
5 ;FILE,FLAGS,PARTIAL_FILE_LIST,TARGET_ARRAY_ROOT,ANSWERS,DD_SCREEN,DATA_SCREEN,VERSION,MSG_ARRAY
6 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
7 I '$D(DIFM) N DIFM S DIFM=1
8 I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
9 N DIFRFD,DIFRFE,DIFRX,FIELD,FIELDNR,DIFRTA,DIFRP,DIFR00
10 S DIFRTA=$NA(@DIFRTAR@("FIA"))
11 I $G(DIFRFILE)'>0 D BLD^DIALOG(9542) Q
12 I '$D(^DIC(DIFRFILE)) D BLD^DIALOG(9539,DIFRFILE) Q
13 I $P($G(DIFR222),"^",3)'="p" G F
14 I $G(DIFRPFL)']"" G F
15 I $D(@DIFRPFL)'>9 G F
16 G F:$O(@DIFRPFL@(0))'>0
17 N DIFRDDC,DIFRFLDC,DIFRTMP
18 K ^TMP("FIA",$J)
19 S DIFRDDC=0,DIFRTMP=$NA(^TMP("FIA",$J))
20 M @DIFRTMP=@DIFRPFL
21 F S DIFRDDC=$O(@DIFRTMP@(DIFRFILE,DIFRDDC)) Q:DIFRDDC'>0 D
22 .I '$D(^DD(DIFRDDC)) K @DIFRTMP@(DIFRFILE,DIFRDDC) D BLD^DIALOG(9540,DIFRDDC) Q
23 .I '$O(@DIFRTMP@(DIFRFILE,DIFRDDC,0)) D Q
24 ..Q:@DIFRTMP@(DIFRFILE,DIFRDDC)="SUB"
25 ..D SB^DIFROMSS(DIFRDDC,"W",$NA(@DIFRTMP@(DIFRFILE)),"SUB")
26 ..Q
27 .S DIFRFLDC=0
28 .F S DIFRFLDC=$O(@DIFRTMP@(DIFRFILE,DIFRDDC,DIFRFLDC)) Q:DIFRFLDC'>0 D
29 ..I '$D(^DD(DIFRDDC,DIFRFLDC,0)) K @DIFRTMP@(DIFRFILE,DIFRDDC,DIFRFLDC) D Q
30 ...N DIFRX S DIFRX(1)=DIFRFLDC,DIFRX(2)=DIFRDDC
31 ...D BLD^DIALOG(9541,.DIFRX)
32 ...Q
33 ..I $P(^DD(DIFRDDC,DIFRFLDC,0),"^",2) S DIFRX=$P(^DD(+$P(^(0),"^",2),.01,0),"^",2) D
34 ...I DIFRX["W" S @DIFRTMP@(DIFRFILE,+$P(^DD(DIFRDDC,DIFRFLDC,0),"^",2))=0 Q
35 ...K @DIFRTMP@(DIFRFILE,DIFRDDC,DIFRFLDC)
36 ...Q
37 ..Q
38 .Q
39 ;
40 M @DIFRTA@(DIFRFILE)=@DIFRTMP@(DIFRFILE)
41 K @DIFRTMP
42 ;
43 I $D(@DIFRTA@(DIFRFILE,DIFRFILE))=1 G F
44 S @DIFRTA@(DIFRFILE,DIFRFILE)=1,DIFRFE=DIFRFILE
45 ;F S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0 S:$P(^DD(DIFRFE,.01,0),"^",2)'["W" @DIFRTA@(DIFRFILE,DIFRFE,.01)=0
46 F S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0 D
47 .S @DIFRTA@(DIFRFILE,DIFRFE)=$D(@DIFRTA@(DIFRFILE,DIFRFE))>9
48 .N DIFRX,DIFRY
49 .S DIFRY=$$UP^DIQGU(DIFRFE,.DIFRX)
50 .Q:'$D(DIFRX)
51 .;K DIFRX($O(DIFRX(""))) <<REMOVED IN PATCH 10>>
52 .M @DIFRTAR@("UP",DIFRFILE,DIFRFE)=DIFRX
53 .Q
54 S DIFRFE=DIFRFILE
55 F S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0 D:'^(DIFRFE)!($D(@DIFRTA@(DIFRFILE,DIFRFE,.01)))
56 .Q:'$D(^DD(DIFRFE,0,"UP"))
57 .N DIFRUP,DIFRFLD
58 .S DIFRUP=^DD(DIFRFE,0,"UP"),DIFRFLD=$O(^DD(DIFRUP,"SB",DIFRFE,0))
59 .Q:$G(@DIFRTA@(DIFRFILE,DIFRUP))=0!($D(@DIFRTA@(DIFRFILE,DIFRUP,DIFRFLD)))
60 .S @DIFRTA@(DIFRFILE,DIFRUP,DIFRFLD)=""
61 .Q:$D(@DIFRTA@(DIFRFILE,DIFRUP))#2
62 .S @DIFRTA@(DIFRFILE,DIFRUP)=1
63 .Q
64 ;
65 G G
66F S @DIFRTA@(DIFRFILE,DIFRFILE)=0,DIFRFE=0
67 S:$P(DIFR222,"^",3)'="f" $P(DIFR222,"^",3)="f"
68E F S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0 D
69 .S DIFRFD=0
70 .F S DIFRFD=$O(^DD(DIFRFE,"SB",DIFRFD)) Q:DIFRFD'>0 S @DIFRTA@(DIFRFILE,DIFRFD)=0
71 .Q
72G S @DIFRTA@(DIFRFILE)=$P(^DIC(DIFRFILE,0),"^")
73 S (DIFR00,@DIFRTA@(DIFRFILE,0))=^DIC(DIFRFILE,0,"GL")
74 S @DIFRTA@(DIFRFILE,0,0)=$P(@(DIFR00_"0)"),"^",2)
75 S @DIFRTA@(DIFRFILE,0,1)=$G(DIFR222)
76 S @DIFRTA@(DIFRFILE,0,10)=$G(DIFR223)
77 S @DIFRTA@(DIFRFILE,0,11)=$G(DIFRDSCR)
78 S @DIFRTA@(DIFRFILE,0,"RLRO")=$$ROOT($P(DIFR222,"^",6))
79 I $G(DIFRVER)]"" S @DIFRTA@(DIFRFILE,0,"VR")=DIFRVER
80FE I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
81 Q
82 ;
83ERR501(DIFRFILE,DIFRFLD) ; 501 Errors
84 N DIFRERRX
85 S DIFRERRX("FILE")=DIFRFILE,DIFRERRX(1)=DIFRFLD
86 D BLD^DIALOG(501,.DIFRERRX)
87 Q
88ROOT(IEN) ;Create root from DIBT(ien
89 ;
90 I $G(IEN)>0,$D(^DIBT(IEN,1))>9 Q "^DIBT("_IEN_",1)"
91 I $G(IEN)]"" S IEN=$O(^DIBT("F"_DIFRFILE,IEN,"")) Q:IEN>0 $$ROOT(IEN)
92 Q ""
Note: See TracBrowser for help on using the repository browser.