source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDS0.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1DDS0 ;SFISC/MLH-SETUP, CLEANUP ;4:45 AM 7 Sep 2006
2 ;;22.0;VA FileMan;**8,151**;Mar 30, 1999;Build 10
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN(DDSFILE,DR,DA) ;Initial setup
6 S U="^"
7 D INIT^DDGLIB0() Q:$G(DIERR)
8 D FORM(.DDSFILE,DR) Q:$G(DIERR)
9 ;
10 ;Compile the form if not already compiled
11 S DDSREFS=$$REF(DDS)
12 I '$$COMPILED(DDS) D EN^DDSZ(DDS) Q:$G(DIERR)
13 N:$P(^DIST(.403,+DDS,0),U,10) DA
14 ;
15 D FRSTPG(DDS,.DA,$G(DDSPAGE)) Q:$G(DIERR)
16 D REC(DDP,.DA) Q:$G(DIERR)
17 D INIT
18 Q
19 ;
20FORM(DDSFILE,DR) ;Form lookup
21 ;Output:
22 ; DDS = Form number^Form name
23 ; DDP = File number (or 0)
24 ; DDSPG = First page to go to on form
25 ; DIERR
26 ;
27 I $D(DDSFILE)[0 D BLD^DIALOG(201,"DDSFILE") Q
28 ;
29 N DIC,X,Y
30 ;
31 S DDP=$S(DDSFILE=+DDSFILE:DDSFILE,1:+$P($G(@(DDSFILE_"0)")),U,2))
32 S X=$S(DR:DR,1:$P($P(DR,"[",2),"]"))
33 S DIC="^DIST(.403,",DIC(0)="FNX",D="F"_DDP
34 D IX^DIC K DIC
35 ;
36 I Y<0 D BLD^DIALOG(3021,X) Q
37 I '$O(^DIST(.403,+Y,40,"B","")) D BLD^DIALOG(3022,X) Q
38 S DDS=Y
39 ;
40 I $D(DDSFILE(1))#2 S DDP=$S(DDSFILE(1)=+DDSFILE(1):DDSFILE(1),1:+$P($G(@(DDSFILE(1)_"0)")),U,2))
41 Q
42 ;
43FRSTPG(DDS,DA,DDSPAGE) ;Get first page of form
44 ;Output:
45 ; DDSPG
46 ; DDSSEL = 1, if DA is null and there is a record selection page
47 ; DIERR
48 ;
49 N P
50 I $G(DA)!$P(^DIST(.403,+DDS,0),U,10) D
51 . S P=$S($G(DDSPAGE):DDSPAGE,1:1)
52 . S DDSPG=$O(^DIST(.403,+DDS,40,"B",P,""))
53 . I $D(^DIST(.403,+DDS,40,+DDSPG,0))[0 D BLD^DIALOG(3023,"number "_P)
54 E D PG^DDSRSEL D:'$G(DDSSEL) BLD^DIALOG(202,"record")
55 Q
56 ;
57REC(DDP,DA) ;Check record and lock
58 ;Output:
59 ; DIE = Global root
60 ; DDSDA = DA,DA(1),...,
61 ; DDSDAORG = Original DA array
62 ; DDSDL = Level number (top=0)
63 ; DDSDLORG = Original level number
64 ; DDSFLORG = Orig DDP^Orig DIE
65 ; D0,D1,etc.
66 ; DIERR
67 ;
68 I '$G(DA) D Q
69 . S DIE="",(DDSDL,DDSDLORG)=0,DDSDA="0,"
70 . S DA="",DDSDAORG=DA
71 ;
72 D GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,1) Q:$G(DIERR)
73 ;
74 I $D(DIOVRD)[0 D Q:$G(DIERR)
75 . N DDSTOP S DDSTOP=$$FNO^DILIBF(DDP)
76 . Q:$P($G(^DD(DDSTOP,0,"DI")),U,2)'["Y"
77 . N P S P("FILE")=$P(@(DIE_"0)"),U)
78 . D BLD^DIALOG(405,DDSTOP,.P)
79 ;
80 S DDSDLORG=DDSDL
81 K DDSDAORG S (DDSDAORG,@("D"_DDSDL))=DA
82 F DDSI=1:1:DDSDL S (DDSDAORG(DDSI),@("D"_(DDSDL-DDSI)))=DA(DDSI)
83 S DDSFLORG=$G(DDP)_$G(DIE)
84 K DDSI
85 Q
86 ;
87INIT ;Initialize some variables
88 ; DDSHBX = $Y of first line of help area
89 ; DDSREFT = Global reference of temporary global location
90 ; DDSFDO = 1 if entire form is display-only
91 ; DDSCHG = Change flag
92 ; DDSKM = Flag to keep whatever's in help area
93 ; DDSH = Flag to indicate help area is empty
94 ; DDSSC = Array to indicate what pages are on the screen
95 ;
96 S DDSHBX=IOSL-7
97 S DDXY=IOXY_" S $X=DX,$Y=DY"
98 ;
99 K DDH,DDSSC,DDSCHANG,DDSSAVE
100 S DDSH=1,(DDH,DDM,DDSCHG,DDSSC)=0,DDACT="N"
101 S DDSREFT="^TMP(""DDS"",$J,"_+DDS_")"
102 K @DDSREFT
103 ;
104 N %,%H,%I,X
105 D NOW^%DTC
106 S $P(^DIST(.403,+DDS,0),U,6)=$E(%,1,12)
107 Q
108 ;
109END I $D(DDSHBX) S DX=0,DY=IOSL-1 X IOXY
110 D KILL^DDGLIB0($G(DDSPARM))
111 ;
112 D:$D(^TMP("DDS",$J,"LOCK")) UNLOCK
113 ;
114 K:'$G(DA) DA
115 I $D(DA),$D(DDSDAORG)#2,$D(DDSDLORG)#2 D
116 . K DA,D0
117 . S DA=DDSDAORG
118 . F DDSI=1:1:DDSDLORG S DA(DDSI)=DDSDAORG(DDSI) K @("D"_DDSI)
119 ;
120 K:$G(DDSPARM)'["E" DIERR,^TMP("DIERR",$J)
121 K:$D(DDSREFT)#2 @DDSREFT,DDSREFT
122 K ^TMP("DDSH",$J),^TMP("DDSWP",$J)
123 K DDACT,DDH,DDM,DDO,DDP,DDQ,DDS,DDSDDP
124 K DDSBK,DDSBR,DDSCHG,DDSDA,DDSDAORG,DDSDL
125 K DDSDLORG,DDSDN,DDSEXT,DDSFDO,DDSFLD,DDSFLORG,DDSGL,DDSH,DDSI
126 K DDSKM,DDSLN,DDSNP,DDSO,DDSOLD,DDSORD,DDSOPB,DDSOSV,DDSPTB,DDSPG
127 K DDSPX,DDSPY,DDSQ,DDSREP,DDSSC,DDSSP,DDSSTACK,DDSTP,DDSU,DDSX
128 K DDSHBX,DDSREFS,DDXY,DDSCTRL ;DI*151
129 K DIC,DIR,DIR0N,DIROUT,DIRUT,DUOUT,DY,DX
130 K A1,D,DDC,DDD,DI,DIEQ,DIK,DIW,DIY,DIZ,DS
131 Q
132 ;
133UNLOCK ;Unlock any lock records
134 N I
135 S I="" F S I=$O(^TMP("DDS",$J,"LOCK",I)) Q:I="" L -@I
136 K ^TMP("DDS",$J,"LOCK")
137 Q
138 ;
139COMPILED(DDS) ;Return 1 if form is compiled
140 Q $D(@$$REF(DDS))>0
141 ;
142REF(DDS) ;Return global reference for compiled global
143 Q $NA(^DIST(.403,+DDS,"AY"))
144 ;
145OLDREF(DDS) ;Return global reference for compiled global used prior
146 ;to version 22.0
147 Q $NA(^DIST(.403,+DDS,"AZ"))
148 ;
149IXF ;
150 N D0,DA,DIC,DP,Y S DIC="^DD("_DDGFDD_",",DIC(0)="EN" D ^DIC
151 I Y'>0 K X
152 E S X=+$P(Y,"E")
153 Q
Note: See TracBrowser for help on using the repository browser.