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

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

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1DDS1(DDSPG) ;SFISC/MKO-LOAD PAGE ;11:25 AM 4 Aug 1998
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;Input:
5 ; DDS = Form number^Form name
6 ; DDSPG = Internal page number
7 ; DA = Record array
8 ; DDSREFT = Global location where data (temporarily) is stored
9 ; DDP = Primary file number of form
10 ; DIE = Global root of form
11 ; DDSDA = DA,DA(1),... of form
12 ; DDSDL = Level number
13 ;Also needed for pointed-to blocks:
14 ; DDSDAORG
15 ; DDSDLORG
16 ;Returns:
17 ; DIERR
18 ;
19 S U="^"
20 ;
21 ;Get header block
22 S DDS1B=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U,2)
23 I DDS1B]"" D BLK(DDSPG,DDS1B,"",1) G:$G(DIERR) END
24 ;
25 ;Get all other blocks on page
26 S DDS1BO="" F S DDS1BO=$O(^DIST(.403,+DDS,40,DDSPG,40,"AC",DDS1BO)) Q:DDS1BO="" S DDS1B=$O(^(DDS1BO,0)) Q:'DDS1B D BLK(DDSPG,DDS1B,DDS1BO) G:$G(DIERR) END
27 ;
28END K DDS1B,DDS1BO
29 Q
30 ;
31BLK(DDSPG,DDS1B,DDS1BO,DDS1H,DDS1E) ;Load block
32 ;In: DDS1H = 1 if a header block
33 ; DDS1E = 1 if we're loading up a pointed-to block and
34 ; we want interactive dialog (DIC(0)["E") in the lookup
35 ;
36 I $D(^DIST(.404,DDS1B,0))[0 D BLD^DIALOG(3051,"#"_DDS1B) Q
37 ;
38 N DDS1PTB,DDS1REP S DDS1PTB=""
39 I '$G(DDS1H) D
40 . S DDS1PTB=$G(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,1)),DDS1REP=$G(^(2))
41 . K:DDS1REP<2 DDS1REP
42 ;
43 I DDS1PTB]"" N @$$D0(DDSDL),DA,DDP,DIE,DDSDL,DDSDA D Q:$G(DIERR)
44 . I $G(DDS1REP)>1 D
45 .. D BK^DDS10(.DDS1B,.DDP) Q:$G(DIERR)
46 .. D GDA^DDS10(DDS1B,$G(DDS1E),.DA) Q:$G(DIERR)
47 .. S DDP=$G(^DD(DDP,0,"UP"))
48 .. D GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,1)
49 .. D GETD0(.DA,DDSDL)
50 . E D
51 .. D SET^DDS10(DDS1B,$G(DDS1E),.DA,.DDP,.DIE,.DDSDL,.DDSDA)
52 .. I +$G(DIERR)=1,$G(^TMP("DIERR",$J,1))=601 D Q
53 ... L -@(DIE_DA_")")
54 ... K ^TMP("DDS",$J,"LOCK",DIE_DA_")")
55 ... D CLEAN^DILF
56 ... S (DA,D0,DDSDA)=""
57 .. Q:$G(DIERR)
58 .. I DA="",'$G(DDS1E),$P($G(@DDSREFT@(DDSPG,DDS1B)),U)]"" S DDSDA=$P(^(DDS1B),U),DA=+DDSDA
59 .. S D0=DA
60 ;
61 I $G(DA)!'$G(DDSDAORG),$G(@DDSREFT@(DDSPG,DDS1B,DDSDA))<1 D
62 . S $P(@DDSREFT@(DDSPG,DDS1B,DDSDA),U)=1
63 . I $G(DDS1REP)>1 D REP Q
64 . ;
65 . S @DDSREFT@(DDSPG,DDS1B,DDSDA,"GL")=DIE
66 . D ^DDS11(DDS1B)
67 ;
68 S $P(@DDSREFT@(DDSPG,DDS1B),U)=$G(DDSDA)
69 Q
70 ;
71REP ;Load data for repeating block
72 N DDS1DDP,DDS1IND,DDS1INI,DDS1MUL,DDS1PDA,DDS1REF,DDS1RT,DDS1SEL
73 N DDS1SN,DDS1VAL,DDS1FSCR,DDS1SCNT,DDS1STRT,DDS1Q
74 S DDS1REF=$NA(@DDSREFT@(DDSPG,DDS1B))
75 S DDS1DDP=$P(@DDSREFS@(DDSPG,DDS1B),U,3)
76 S DDS1IND=$P(DDS1REP,U,2) S:DDS1IND="" DDS1IND="B"
77 S DDS1INI=$P(DDS1REP,U,3)
78 S DDS1SEL=$P(@DDSREFS@(DDSPG,DDS1B),U,10)
79 S DDS1PDA=DDSDA
80 ;
81 S DDS1MUL=$O(^DD(DDP,"SB",DDS1DDP,""))
82 S:$G(^DD(DDS1DDP,0,"SCR"))]"" DDS1FSCR=^("SCR")
83 ;
84 S $P(@DDS1REF@(DDS1PDA),U,7,10)=DDP_U_DDS1MUL_U_DDS1SEL_U_DDS1IND
85 S @DDS1REF@(DDSDA,"GL")=$S(DDS1MUL:DIE_+DA_","""_$P($P(^DD(DDP,DDS1MUL,0),U,4),";")_""",",1:^DIC(DDS1DDP,0,"GL"))
86 ;
87 N DIE,DDP
88 S DIE=@DDS1REF@(DDSDA,"GL"),DDS1RT=$$CREF^DILF(DIE),DDP=DDS1DDP
89 S DDS1SN=0
90 ;
91 I DDS1MUL D
92 . D DDA^DDS5(0,.DA,.DDSDL)
93 . S DDSDA=","_DDSDA
94 . S:'$D(@DDS1RT@(DDS1IND)) DDS1IND="!IEN"
95 . I DDS1IND="!IEN" D
96 .. S DA=0 F S DA=$O(@DDS1RT@(DA)) Q:'DA D REPLD
97 . E D
98 .. S (DDS1Q,DDS1STRT)=$NA(@DDS1RT@(DDS1IND)),DDS1SCNT=$QL(DDS1Q)
99 .. F S DDS1Q=$Q(@DDS1Q) Q:DDS1Q="" Q:$NA(@DDS1Q,DDS1SCNT)'=DDS1STRT D
100 ... S DA=$QS(DDS1Q,$QL(DDS1Q)) D REPLD
101 ;
102 E S DDS1VAL=DA N D0,DA,DDSDA D
103 . S DDSDA=","
104 . S (DDS1Q,DDS1STRT)=$NA(@DDS1RT@(DDS1IND,DDS1VAL)),DDS1SCNT=$QL(DDS1Q)
105 . F S DDS1Q=$Q(@DDS1Q) Q:DDS1Q="" Q:$NA(@DDS1Q,DDS1SCNT)'=DDS1STRT D
106 .. S DA=$QS(DDS1Q,$QL(DDS1Q)) D REPLD
107 ;
108 I DDS1INI="l"!(DDS1INI="n") D
109 . N N,T
110 . S N=DDS1INI="n"
111 . S DDS1SN=$O(@DDS1REF@(DDS1PDA," "),-1)+N
112 . S T=DDS1SN-DDS1REP+2-N
113 . S DDS1INI=$S(T<1:1_U_DDS1SN,1:T_U_(DDS1REP-'N))_U_DDS1SN
114 E S DDS1INI="1^1^1"
115 ;
116 S $P(@DDS1REF@(DDS1PDA),U,2,6)=DDS1PDA_U_DDS1INI_U_+DDS1REP
117 ;
118 I DDS1MUL D
119 . D UDA^DDS5(.DA,.DDSDL)
120 . S DDSDA=$P(DDSDA,",",2,999)
121 Q
122 ;
123REPLD ;Load data
124 Q:'$D(@DDS1RT@(DA,0)) I $D(DDS1FSCR) N Y S Y=DA X DDS1FSCR Q:'$T
125 S DDS1SN=DDS1SN+1,$P(DDSDA,",")=DA,@("D"_DDSDL)=DA
126 S @DDS1REF@(DDS1PDA,DDS1SN)=DDSDA
127 S @DDS1REF@(DDS1PDA,"B",DDSDA)=DDS1SN
128 D ^DDS11(DDS1B)
129 Q
130 ;
131D0(DL) ;Given DL, return string D0,D1,...,Dn
132 N I,S
133 S S="" F I=0:1:DL S S=S_"D"_I_","
134 S:S?.E1"," S=$E(S,1,$L(S)-1)
135 Q S
136 ;
137GETD0(DA,DL) ;Given DA array, set D0,D1...
138 N I
139 S @("D"_DL)=DA
140 F I=1:1:DL-1 S @("D"_(DL-I))=DA(I)
141 Q
Note: See TracBrowser for help on using the repository browser.