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

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

initial load of WorldVistAEHR

File size: 5.0 KB
Line 
1DDSVAL ;SFISC/MKO-GET,PUT FOR DD IELDS ;9:38 AM 29 Aug 1995
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5GET(DDSFILE,DA,DDSFLD,DDSER,DDSPARM) ;Get value for file/field
6 N DDP,DIE,DDSANS,DDSTMP,X
7 N DDSVDA,DDSVDDL0,DDSVDL,DDSVDV,DDSVND,DDSVPC,DIERR
8 ;
9 S DDSANS=""
10 I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"I"
11 ;
12 D GDIE() G:$G(DIERR) GETQ G:'$G(DDSVDA) GETQ
13 ;
14 I DDSFLD[":",$$FIND^DDSLIB(DDSFLD,":") D G GETQ
15 . S DDSANS=$$REL^DDSVALM(DDP,.DA,DDSFLD,DDSPARM)
16 ;
17 S DDSFLD=$$FIELD(DDP,DDSFLD) G:$G(DIERR) GETQ
18 ;
19 S:$D(DDSREFT)#2 DDSTMP=$NA(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD))
20 I $D(DDS),$D(DDSREFT)#2,$D(@DDSTMP@("D")) D
21 . I $D(@DDSTMP@("M")),'^("M") D Q
22 .. S DDSANS=$NA(^TMP("DDSWP",$J,DDP,DDSVDA,DDSFLD))
23 .. M @DDSANS=@DDSTMP@("D")
24 . S DDSANS=$G(@DDSTMP@("D")) I DDSPARM["E",$D(^("X"))#2 S DDSANS=^("X")
25 E D
26 . D GNDPC Q:$G(DIERR)
27 . I DDSVPC=0,DDSVDV["W" D GETWP^DDSVALM Q
28 . S DDSANS=$$GVAL(DIE,DA,DDSVND,DDSVPC)
29 . I DDSPARM["E" S DDSANS=$$EXTERNAL^DILFD(DDP,DDSFLD,"",DDSANS)
30 ;
31GETQ D:$G(DIERR) ERR^DDSVALM("$$GET^DDSVAL")
32 Q DDSANS
33 ;
34PUT(DDSFILE,DA,DDSFLD,DDSVAL,DDSER,DDSPARM) ;Put value for file/field
35 N DDP,DDSVDA,DDSV0,DDSV02,DDSVDL,DIE
36 N DIERR
37 ;
38 S:$D(DDSVAL)[0 DDSVAL=""
39 I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"E"
40 ;
41 D GDIE($D(DDS)#2) G:$G(DIERR) PUTQ G:'$G(DDSVDA) PUTQ
42 S DDSFLD=$$FIELD(DDP,DDSFLD) G:$G(DIERR) PUTQ
43 I DDSFLD=.01,"@"[DDSVAL D BLD^DIALOG(3086) G PUTQ
44 ;
45 S DDSV0=^DD(DDP,DDSFLD,0),DDSV02=$P(DDSV0,U,2)
46 I +DDSV02 D
47 . D MULT^DDSVALM
48 E D VALPUT
49 ;
50PUTQ D:$G(DIERR) ERR^DDSVALM("PUT^DDSVAL")
51 Q
52 ;
53VALPUT ;Validate and put
54 N DDSVY
55 I DDSPARM["E" D
56 . D VAL^DIE(DDP,DDSVDA,DDSFLD,"ER",DDSVAL,.DDSVY)
57 E D
58 . D AUXVAL^DIEV(DDP,DDSVDA,DDSFLD,"EIR",DDSVAL,.DDSVY,DDSV0,DDSV02)
59 Q:$G(DIERR)
60 I DDSVY=DDSVY(0),'$D(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD,"X")) K DDSVY(0)
61 ;
62 I $D(DDS) D
63 . S:'$D(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD)) ^("GL")=DIE
64 . D UPDATE(DDP,DDSVDA,.DA,DDSFLD,DDSPG,.DDSVY)
65 . S DDSCHG=1
66 E D
67 . N DDSFDA
68 . S DDSFDA(DDP,DDSVDA,DDSFLD)=DDSVY
69 . D FILE^DIE("","DDSFDA")
70 Q
71 ;
72UPDATE(DDP,DDSVDA,DA,FLD,PG,Y) ;Store value, repaint
73 N DX,DY,BK,DDO,LEN,EXT,PAGE,RJ,REP,VAL
74 S (EXT,@DDSREFT@("F"_DDP,DDSVDA,FLD,"D"))=Y,^("F")=3 S:$D(Y(0))#2 (EXT,^("X"))=Y(0)
75 ;
76 D:FLD=.01
77 . S PAGE=0 F S PAGE=$O(@DDSREFS@("F"_DDP,FLD,"L",PAGE)) Q:'PAGE D
78 .. S BK=0 F S BK=$O(@DDSREFS@("F"_DDP,FLD,"L",PAGE,BK)) Q:'BK D
79 ... D:$P($G(@DDSREFS@(PAGE,BK)),U,8)
80 .... N DDSPTB S DDSPTB=$G(@DDSREFS@(PAGE,BK,"PTB"))
81 .... D:DDSPTB]"" RPF^DDS7(DDP,DDSPTB,DDSVDA,.DA)
82 ;
83 S BK=0 F S BK=$O(@DDSREFS@("F"_DDP,FLD,"L",PG,BK)) Q:'BK D
84 . S DDO=0 F S DDO=$O(@DDSREFS@("F"_DDP,FLD,"L",PG,BK,DDO)) Q:'DDO D
85 .. S LEN=$G(@DDSREFS@(PG,BK,DDO,"D")) Q:LEN=""
86 .. S DY=+LEN,DX=$P(LEN,U,2),RJ=$P(LEN,U,10),LEN=$P(LEN,U,3)
87 .. S REP=$P($G(@DDSREFS@(PG,BK)),U,7)
88 .. I $G(REP) D Q:DY=""
89 ... N SN,PDA,OFS
90 ... S PDA=$G(@DDSREFT@(PG,BK)) I 'PDA S DY="" Q
91 ... S REP=$P($G(@DDSREFT@(PG,BK,PDA)),U,2,999) I REP="" S DY="" Q
92 ... S SN=$G(@DDSREFT@(PG,BK,PDA,"B",DDSVDA)) I 'SN S DY="" Q
93 ... S OFS=SN-$P(REP,U,2)
94 ... I OFS'<0,OFS<$P(REP,U,5) S DY=DY+OFS
95 ... E S DY=""
96 .. S VAL=$P(DDGLVID,DDGLDEL)_$E(EXT,1,LEN)_$P(DDGLVID,DDGLDEL,10)
97 .. X IOXY
98 .. W $S(RJ:$J("",LEN-$L(EXT))_VAL,1:VAL_$J("",LEN-$L(EXT)))
99 ;
100 D:$D(@DDSREFS@("PT",DDP,FLD)) RPB^DDS7(DDP,FLD,PG)
101 D:$D(@DDSREFS@("COMP",DDP,FLD,PG)) RPCF^DDSCOMP(PG)
102 Q
103 ;
104GDIE(DDSVL) ;In:
105 ; DDSFILE = File # or root
106 ; DA = Record array
107 ; DDSVL = Flag to lock record
108 ;Returns:
109 ; DIE = Global root of file
110 ; DDP = File #
111 ; DDSVDL = Level #
112 ; DDSVDA = DA,DA(1),...,
113 S DDP=$S(DDSFILE=+DDSFILE:DDSFILE,1:+$P($G(@(DDSFILE_"0)")),U,2))
114 I DDP=0 D BLD^DIALOG(202,"file") Q
115 D GL^DDS10(DDP,.DA,.DIE,.DDSVDL,.DDSVDA,$G(DDSVL))
116 Q
117 ;
118GNDPC ;In:
119 ; DDP = File #
120 ; DDSFLD = Field #
121 ;Returns:
122 ; DDSVDDL0 = 0 node of DD
123 ; DDSVND = Node where data resides
124 ; DDSVPC = Piece where data resides
125 ; DDSVDV = Field specifications
126 ; X = Pointed to file root or set of codes
127 I $G(DDSFLD)="" D BLD^DIALOG(202,"field") Q
128 S DDSVDDL0=$G(^DD(DDP,DDSFLD,0))
129 I DDSVDDL0?."^" D Q
130 . N I,E
131 . S (I("FILE"),E("FILE"))=DDP,I(1)="#"_DDSFLD,E("FIELD")=DDSFLD
132 . D BLD^DIALOG(501,.I,.E)
133 ;
134 S DDSVPC=$P(DDSVDDL0,U,4)
135 S DDSVND=$P(DDSVPC,";"),DDSVPC=$P(DDSVPC,";",2)
136 S DDSVDV=$P(DDSVDDL0,U,2),X=$P(DDSVDDL0,U,3)
137 ;
138 N P S P("FILE")=DDP,P("FIELD")=DDSFLD
139 I DDSVPC=" " D
140 . D BLD^DIALOG(520,"computed",.P)
141 I DDSVPC=0 D
142 . S DDSVDV=+DDSVDV_$P($G(^DD(+DDSVDV,.01,0)),U,2)
143 . D:DDSVDV'["W" BLD^DIALOG(520,"multiple",.P)
144 Q
145 ;
146GVAL(DIE,DA,ND,PC) ;Get value
147 N LN,Y
148 S LN=$G(@(DIE_"DA,ND)"))
149 I $E(PC)'="E" S Y=$P(LN,U,PC)
150 E S Y=$E(LN,+$E(PC,2,999),$P(PC,",",2)) S:Y?." " Y=""
151 Q Y
152 ;
153FIELD(DDP,FLD) ;Get field number
154 N F,P
155 S:$E(FLD)="""" FLD=$$UQT^DDSLIB($E(FLD,1,$$AFTQ^DDSLIB(FLD)-1))
156 ;
157 S F=FLD,P("FILE")=DDP
158 I FLD'=+$P(FLD,"E") D Q:$G(DIERR) ""
159 . S F=$O(^DD(DDP,"B",FLD,""))
160 . I F="" S P(1)=FLD D BLD^DIALOG(501,.P)
161 ;
162 I $D(^DD(DDP,F,0))[0 S P(1)="#"_F D BLD^DIALOG(501,.P) Q ""
163 Q F
Note: See TracBrowser for help on using the repository browser.