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

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1DDSUTL ;SFISC/MKO-PROGRAMMER UTILITIES ;11:37 AM 25 Jul 1995
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5MSG(TXT) ;
6 ;Data validation messages
7 D PROC(.TXT,$NA(@DDSREFT@("MSG")))
8 Q
9 ;
10HLP(TXT) ;
11 ;Help box messages
12 D PROC(.TXT,$NA(@DDSREFT@("HLP")))
13 Q
14PROC(TXT,GLB) ;
15 ;Put text into global
16 N CNT,I
17 S CNT=$G(@GLB)
18 I $D(TXT)<9 S CNT=CNT+1,@GLB@(CNT)=TXT
19 E S I="" F CNT=CNT:1 S I=$O(TXT(I)) Q:I="" S @GLB@(CNT+1)=TXT(I)
20 S @GLB=CNT
21 Q
22 ;
23REFRESH ;Refresh the screen
24 G R^DDSR
25 ;
26MLOAD(DDSIEN) ;Load subrecords for current multiple
27 G MLOAD^DDSM1
28 ;
29MDEL(DDSIEN) ;Delete subrecords for current multiple
30 G MDEL^DDSM1
31 ;
32UNED(DDSF,DDSB,DDSP,DDSVAL,DDSUDA) ;Change DISABLE EDITING attribute
33 S:$D(DDSVAL)[0 DDSVAL=""
34 D SETATT(4)
35 Q
36 ;
37REQ(DDSF,DDSB,DDSP,DDSVAL,DDSUDA) ;Change REQUIRED attribute
38 S:$D(DDSVAL)[0 DDSVAL=""
39 D SETATT(1)
40 Q
41 ;
42 ;
43SETATT(DDSUPC) ;Set attribute node, piece DDSUPC
44 N DDSOVAL,DDSUDDP,DDSUFLD,DDSUTP
45 I $D(DDSPG)[0 N DDSPG S DDSPG=""
46 I $D(DDSBK)[0 N DDSBK S DDSBK=""
47 S DDSP=$$GETFLD^DDSLIB(DDSF,$G(DDSB),$G(DDSP),+DDS,DDSPG,DDSBK)
48 I $G(DIERR) D ERR^DDSMSG Q
49 ;
50 S DDSF=$P(DDSP,","),DDSB=$P(DDSP,",",2),DDSP=$P(DDSP,",",3)
51 ;
52 S DDSUDDP=+$P($G(^DIST(.404,DDSB,0)),U,2)
53 I DDSUDDP,$G(DDSUDA)]"" N DDSDA S DDSDA=DDSUDA
54 E I DDSUDDP,DDSB'=DDSBK N DDSDA D GL^DDS10(DDSUDDP,.DDSDAORG,"","",.DDSDA)
55 ;
56 S DDSUTP=$P($G(^DIST(.404,DDSB,40,DDSF,0)),U,3) S:'DDSUTP DDSUTP=3
57 I DDSUTP=2 D
58 . S DDSUFLD=DDSF_","_DDSB
59 . S DDSUDDP=0
60 E I DDSUTP=3 D Q:'DDSUFLD
61 . S DDSUFLD=$P($G(^DIST(.404,DDSB,40,DDSF,1)),U)
62 E Q
63 ;
64 S DDSOVAL=$P($G(@DDSREFT@("F"_DDSUDDP,DDSDA,DDSUFLD,"A")),U,DDSUPC)
65 Q:DDSVAL=DDSOVAL
66 S $P(@DDSREFT@("F"_DDSUDDP,DDSDA,DDSUFLD,"A"),U,DDSUPC)=DDSVAL
67 Q
68 ;
69ADD(DDSFIL,X,DA,DINUM,DDSDIC0,DDSDR,DDSL) ;
70 ;Add an entry as part of a transaction
71 ;DDSL=1 means don't lock
72 ;
73 N %,%W,%Y,C,D0,DD,DO,DI,DIC,DIE,DQ,DR
74 N DDSDA,DDSDIC,DDSFD,DDSREQ,DDSUP,I
75 K DIERR,^TMP("DIERR",$J)
76 K:'$G(DINUM) DINUM
77 S:$G(DDSDIC0)="" DDSDIC0="L"
78 S DIC(0)=DDSDIC0,Y=-1
79 S:$G(DDSDR)]"" DIC("DR")=DDSDR
80 S DIC=$$ROOT^DILFD(DDSFIL,.DA),DDSDIC=$$CREF^DIQGU(DIC)
81 ;
82 I $D(@DDSDIC@(0))[0 D Q:$G(DIC("P"))=""
83 . S DDSUP=$G(^DD(DDSFIL,0,"UP")) Q:'DDSUP
84 . S DDSFD=$O(^DD(DDSUP,"SB",DDSFIL,"")) Q:'DDSFD
85 . S DIC("P")=$P($G(^DD(DDSUP,DDSFD,0)),U,2)
86 ;
87 I DDSDIC0'["E",$$REQID(DDSFIL,.DDSREQ) D Q:$G(DIERR)
88 . N F
89 . S F=""
90 . F S F=$O(DDSREQ(F)) Q:'F I $G(DIC("DR"))'[(F_"///") D BLD^DIALOG(3031,"ADD^DDSUTL") Q
91 ;
92 D FILE^DICN K DTOUT,DUOUT Q:Y=-1!'$D(DDS)
93 ;
94 I '$G(DDSL) D
95 . N I,L,R
96 . S L=1,R=DIC_DA_","
97 . F I=$L(R,",")-1:-1:1 I $D(^TMP("DDS",$J,"LOCK",$P(R,",",1,I)_")"))#2 S L=0 Q
98 . I L,$D(^TMP("DDS",$J,"LOCK",$P(R,"(")))#2 S L=0
99 . I L L +@(DIC_+Y_")"):0 S ^TMP("DDS",$J,"LOCK",DIC_+Y_")")=""
100 ;
101 S DDSDA=+Y_","
102 F I=1:1 Q:$D(DA(I))[0 S DDSDA=DDSDA_DA(I)_","
103 S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIC
104 Q
105 ;
106REQID(FIL,REQ) ;
107 ;Get list of required identifiers into DDSREQ
108 N F
109 K REQ
110 S F="" F S F=$O(^DD(FIL,0,"ID",F)) Q:F'=+$P(F,"E") D
111 . S:$P($G(^DD(FIL,F,0)),U,2)["R" REQ(F)=""
112 Q $D(REQ)>0
113 ;
114DESTROY(PG) ;Destroy all data for page PG
115 N P,B,F,IENS,TP,FIL,FLD
116 S P=$O(^DIST(.403,+DDS,40,"B",PG,"")) Q:'P
117 S B=0 F S B=$O(^DIST(.403,+DDS,40,P,40,B)) Q:'B D
118 . Q:'$D(^DIST(.403,+DDS,40,P,40,B,0))
119 . Q:'$D(^DIST(.404,B,0)) S FIL=$P(^(0),U,2)
120 . S F=0 F S F=$O(^DIST(.404,B,40,F)) Q:'F D
121 .. Q:'$D(^DIST(.404,B,40,F,0)) S TP=$P(^(0),U,3)
122 .. S:'TP TP=3
123 .. ;
124 .. I TP=3 S FF="F"_FIL,FLD=$G(^DIST(.404,B,40,F,1)) Q:FLD?."^"
125 .. E I TP=2 S FF="F0",FLD=F_","_B
126 .. E Q
127 .. ;
128 .. S IENS=" "
129 .. F S IENS=$O(@DDSREFT@(FF,IENS)) Q:IENS="" K ^(IENS,FLD)
130 ;
131 K @DDSREFT@(P),@DDSREFT@("XCAP",P)
132 Q
133 ;
134 ;
135DDSDA(DA,DL,DDSDA) ;Determine DDSDA
136 ;
137 N I
138 I DA="" S DDSDA="" Q
139 S DDSDA=DA_"," F I=1:1:DL S DDSDA=DDSDA_DA(I)_","
140 Q
Note: See TracBrowser for help on using the repository browser.