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

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1DDSR ;SFISC/MKO-PAINT ;3:11 PM 11 Jun 1996
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4R ;All pages
5 ;Called after wp, mults, & deletions
6 F DDSSC=1:1:DDSSC D RP(DDSSC(DDSSC),DDSSC=1)
7 Q
8 ;
9RP(X,DDS3LIN) ;Paint page
10 ; X = DDSSC(DDSSC) node
11 ; DDS3LIN = paint bottom line
12 ;
13 S DDS3P=$P(X,U),DDS3UL=$P(X,U,2),DDS3LR=$P(X,U,3)
14 I DDS3UL="" W $P(DDGLCLR,DDGLDEL,2)
15 E D ^DDSBOX(DDS3UL,DDS3LR)
16 ;
17 ;Write caps in "X" nodes
18 D CAP^DDSR1
19 ;
20 ;Paint data & exec caps
21 ;Hdr blk
22 S DDS3B=$P($G(^DIST(.403,+DDS,40,DDS3P,0)),U,2)
23 D:DDS3B]"" DB(DDS3P,DDS3B)
24 ;
25 ;Other blks
26 S DDS3BO="" F S DDS3BO=$O(^DIST(.403,+DDS,40,DDS3P,40,"AC",DDS3BO)) Q:'DDS3BO S DDS3B=$O(^(DDS3BO,"")) Q:'DDS3B D DB(DDS3P,DDS3B)
27 K DDS3B,DDS3BO
28 ;
29 I DDS3LIN D
30 . S DDSH=1,DX=0,DY=DDSHBX X IOXY W $TR($J("",IOM-1)," ","_")
31 . I DDS3UL]"" S DY=DY+1 X IOXY W $P(DDGLCLR,DDGLDEL,3)
32 K DDS3P,DDS3UL,DDS3LR
33 Q
34 ;
35DB(DDS3P,DDS3B) ;Paint data
36 K @DDSREFT@("XCAP",DDS3P,DDS3B)
37 S DDS3=@DDSREFS@(DDS3P,DDS3B)
38 S DDS3FN="F"_$P(DDS3,U,3),DDS3REP=$P(DDS3,U,7),DDS3PTB=$P(DDS3,U,8)
39 K DDS3
40 ;
41 I $G(DDS3REP)'>1 D
42 . N DIE
43 . S DDS3DA=$G(@DDSREFT@(DDS3P,DDS3B))
44 . S:DDS3DA]"" DIE=$G(@DDSREFT@(DDS3P,DDS3B,DDS3DA,"GL"))
45 . S DDS3DDO=0
46 . F S DDS3DDO=$O(@DDSREFS@(DDS3P,DDS3B,DDS3DDO)) Q:DDS3DDO'=+DDS3DDO S DDS3C=$G(^(DDS3DDO,"D")) D:DDS3C]"" DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,DDS3PTB)
47 . K DDS3C,DDS3DA,DDS3DDO
48 E D DMULT(DDS3P,DDS3B,DDS3FN)
49 ;
50 K DDS3FN,DDS3PTB,DDS3REP
51 Q
52 ;
53DMULT(DDS3P,DDS3B,DDS3FN) ;Paint data, all lines
54 N X,DIE
55 S DDS3PDA=$P($G(@DDSREFT@(DDS3P,DDS3B)),U)
56 I 'DDS3PDA D
57 . S X="",DDS3STL=1
58 . S DDS3NREP=$P(@DDSREFS@(DDS3P,DDS3B),U,7),DDS3SEL=$P(^(DDS3B),U,10)
59 E D
60 . S X=@DDSREFT@(DDS3P,DDS3B,DDS3PDA)
61 . S DDS3STL=$P(X,U,3),DDS3NREP=$P(X,U,6),DDS3SEL=$P(X,U,9)
62 S DIE=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,"GL"))
63 ;
64 F DDS3LN=1:1:DDS3NREP D
65 . S DDS3SN=DDS3LN+DDS3STL-1
66 . S DDS3DA=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN))
67 . S:DDS3LN=1 DDS3MORE=$S(DDS3STL>1:"+",1:" ")
68 . S:DDS3LN=DDS3REP DDS3MORE=$S($D(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN+1))#2:"+",1:" ")
69 . D DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,$G(DDS3MORE),DDS3SEL)
70 . K DDS3MORE
71 ;
72 K DDS3DA,DDS3LN,DDS3NREP,DDS3PDA,DDS3SEL,DDS3SN,DDS3STL
73 Q
74 ;
75DMULTN(DDS3P,DDS3B,DDS3PDA,DDS3REP,DDS3LN) ;Paint lines from DDS3LN
76 S DDS3FN="F"_$P(@DDSREFS@(DDS3P,DDS3B),U,3)
77 S DDS3STL=$P(@DDSREFT@(DDS3P,DDS3B,DDS3PDA),U,3),DDS3SEL=$P(^(DDS3PDA),U,9)
78 F DDS3LN=DDS3LN:1:DDS3REP D
79 . S DDS3SN=DDS3LN+DDS3STL-1
80 . S DDS3DA=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN))
81 . S:DDS3LN=1 DDS3MORE=$S(DDS3STL>1:"+",1:" ")
82 . S:DDS3LN=DDS3REP DDS3MORE=$S($D(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN+1))#2:"+",1:" ")
83 . D DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,$G(DDS3MORE),DDS3SEL)
84 . K DDS3MORE
85 K DDS3DA,DDS3FN,DDS3LN,DDS3SEL,DDS3SN,DDS3STL
86 Q
87 ;
88DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,DDS3MORE,DDS3SEL) ;Paint 1 line
89 S DDS3DDO=0
90 F S DDS3DDO=$O(@DDSREFS@(DDS3P,DDS3B,DDS3DDO)) Q:DDS3DDO'=+DDS3DDO S DDS3C=$G(^(DDS3DDO,"D")) I DDS3C]"" D
91 . S $P(DDS3C,U)=$P(DDS3C,U)+DDS3LN-1
92 . S:$P(DDS3C,U,5)]"" $P(DDS3C,U,5)=$P(DDS3C,U,5)+DDS3LN-1
93 . I $D(DDS3MORE),DDS3SEL=DDS3DDO,$P(DDS3C,U) D
94 .. S DY=+DDS3C,DX=$P(DDS3C,U,2)-1 Q:DX<0
95 .. X IOXY W DDS3MORE
96 . D DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,1,DDS3LN,DDS3SN)
97 K DDS3C,DDS3DDO
98 Q
99 ;
100DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,DDS3FLG,DDS3LN,DDS3SN) ;
101 ;Paint field
102 N DDS3FLD,DDS3LEN,DDSX
103 D:$P(DDS3C,U,5)]"" XCAP
104 ;
105 S DY=+DDS3C,DX=$P(DDS3C,U,2)
106 S DDS3LEN=$P(DDS3C,U,3),DDS3FLD=$P(DDS3C,U,4)
107 ;
108 ;Computed flds
109 I DDS3DA]"",$P(DDS3C,U,9) S DDSX=$$VAL^DDSCOMP(DDS3DDO,DDS3B,DDS3DA)
110 ;
111 ;Form only flds
112 Q:DDS3FLD=""
113 I DDS3FLD'=+DDS3FLD N DDS3FN S DDS3FN="F0"
114 ;
115 ;External form
116 S:DDS3FLD DDSX=$S(DDS3DA="":"",$D(@DDSREFT@(DDS3FN,DDS3DA,DDS3FLD,"X"))#2:^("X"),1:$G(^("D")))
117 I $G(DDSX)]""!$G(DDS3FLG) D
118 . S:$D(DDSX)[0 DDSX=""
119 . X IOXY
120 . I '$P(DDS3C,U,10) S DDSX=$E(DDSX,1,DDS3LEN)_$J("",DDS3LEN-$L(DDSX))
121 . E S DDSX=$J("",DDS3LEN-$L(DDSX))_$E(DDSX,1,DDS3LEN)
122 . W $P(DDGLVID,DDGLDEL)_DDSX_$P(DDGLVID,DDGLDEL,10)
123 Q
124 ;
125XCAP ;Paint exec caps
126 N Y,DDSLN,DDSSN
127 I 'DDS3DA N DA,D0 S (DA,D0)=""
128 ;
129 I DDS3DA N DDSDL S DDSDL=$L(DDS3DA,",")-2
130 I N DA,@$$D0^DDS(DDSDL)
131 I D BLDDA^DDS(DDS3DA)
132 ;
133 S DDS3TP=$P($G(@DDSREFS@(DDS3P,DDS3B)),U,5)
134 S DDS3L0=$G(^DIST(.404,DDS3B,40,DDS3DDO,0)) G:DDS3L0?."^" XCAPQ
135 S DDS3L01=$G(^DIST(.404,DDS3B,40,DDS3DDO,.1)) G:DDS3L01?."^" XCAPQ
136 ;
137 S:$D(DDS3LN) DDSLN=DDS3LN
138 S:$D(DDS3SN) DDSSN=DDS3SN
139 ;
140 X DDS3L01 G:$G(Y)="" XCAPQ
141 S DDS3CAP=Y
142 ;
143 I DDS3TP="e","^2^3^"[(U_$P(DDS3L0,U,3)_U)!'$P(DDS3L0,U,3) D
144 . S Y=$TR(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
145 . S @DDSREFT@("XCAP",DDS3P,Y,DDS3B,DDS3DDO)=""
146 ;
147 S DY=$P(DDS3C,U,5),DX=$P(DDS3C,U,6)
148 S DDS3CAP=DDS3CAP_$P(DDS3C,U,7)
149 S:$P(DDS3C,U,8) DDS3CAP=$P(DDGLVID,DDGLDEL,4)_DDS3CAP_$P(DDGLVID,DDGLDEL,10)
150 X IOXY W DDS3CAP
151XCAPQ K DDS3CAP,DDS3L0,DDS3L01,DDS3TP
152 Q
Note: See TracBrowser for help on using the repository browser.