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

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1DDGFFLDA ;SFISC/MKO-ADD A FIELD ;2:22 PM 13 Sep 1995
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4ADD ;Add a field
5 I '$O(^DIST(.403,+DDGFFM,40,DDGFPG,40,0)) D Q
6 . D MSG^DDGF($C(7)_"There are no blocks defined on this page. To add a block, press <PF2>B.")
7 . H 2 D MSG^DDGF()
8 S DDGFDY=DY,DDGFDX=DX
9 ;
10 ;Invoke form to select block, field order, field type
11 K DDGFBLCK,DDGFFORD,DDGFTYPE
12 S DDSFILE=.404,DDSFILE(1)=.4044
13 S DR="[DDGF FIELD ADD]",DDSPARM="KTW"
14 D ^DDS K DDSFILE,DA,DR,DDSPARM
15 ;
16 I '$D(DDGFBLCK)!'$D(DDGFFORD)!'$D(DDGFTYPE) G ADDQ
17 ;
18 ;Get relative field coordinates
19 S (DDGFCAP,DDGFCAP0)=""
20 S (DDGFSUP,DDGFSUP0)=""
21 S (DDGFCC,DDGFCC0)=""
22 ;
23 S DDGFB2=@DDGFREF@("F",DDGFPG,DDGFBLCK)
24 S DDGFB1=$P(DDGFB2,U),DDGFB2=$P(DDGFB2,U,2)
25 ;
26 I DDGFTYPE=1 D
27 . S DDGFCC0=DDGFDY-DDGFB1+1_","_(DDGFDX-DDGFB2+1)
28 E D
29 . S DDGFD1=DDGFDY-DDGFB1+1,DDGFD2=DDGFDX-DDGFB2+1
30 . S (DDGFDC,DDGFDC0)=DDGFD1_","_DDGFD2
31 . S (DDGFDL,DDGFDL0)=1
32 ;
33 I DDGFTYPE'=1,DDGFD1<1!(DDGFD2<1) D G ADDQ
34 . D MSG^DDGF($C(7)_"Unable to add a field above or to the left of the block.")
35 . H 2 D MSG^DDGF()
36 ;
37 K DDGFD1,DDGFD2
38 ;
39 ;Add field order to block file
40 S DIC="^DIST(.404,"_DDGFBLCK_",40,",DIC(0)="L"
41 S DIC("P")=$P(^DD(.404,40,0),U,2)
42 S DA(1)=DDGFBLCK,X=DDGFFORD
43 K DD,DO D FILE^DICN
44 I Y=-1 K DIC,DA,Y D MSG^DDGF($C(7)_"Unable to add field.") H 2 D MSG^DDGF() G ADDQ
45 ;
46 ;Stuff values for field type, data coordinate, and data length
47 ;If form-only field, also stuff in default read type
48 S DIE=DIC,DA(1)=DDGFBLCK,DA=+Y
49 S DR="2////"_DDGFTYPE
50 S:DDGFTYPE'=1 DR=DR_";4.1////"_DDGFDC_";4.2////1"
51 S:DDGFTYPE=2 DR=DR_";20.1////F"
52 D ^DIE K DIC,DIE,DR,Y
53 ;
54 ;Invoke appropriate form
55 S DDSFILE=.404,DDSFILE(1)=.4044,DDSPARM="CKTW"
56 S DDGFDD=$P(^DIST(.404,DDGFBLCK,0),U,2)
57 S DR="[DDGF FIELD "_$P("CAPTION ONLY^FORM ONLY^DD^COMPUTED",U,DDGFTYPE)_"]"
58 D ^DDS K DDSFILE,DR,DDSPARM,DDGFDD
59 ;
60 I $D(DA)#2,DDGFTYPE'=1,$G(DDSCHANG)'=1 D
61 . S DIK="^DIST(.404,"_DA(1)_",40,"
62 . D ^DIK K DIK
63 E I $D(DA)#2 D
64 . D SAVE
65 . D LOADF
66 ;
67ADDQ ;Refresh and cleanup
68 D REFRESH^DDGF
69 D RC(DDGFDY,DDGFDX)
70 ;
71 K DA,DDSCHANG
72 K DDGFB1,DDGFB2,DDGFD1,DDGFD2
73 K DDGFSUP,DDGFSUP0,DDGFCAP,DDGFCAP0,DDGFCC,DDGFCC0
74 K DDGFDL,DDGFDL0,DDGFDC,DDGFDC0
75 K DDGFDY,DDGFDX,DDGFBLCK,DDGFFORD,DDGFTYPE
76 Q
77 ;
78SAVE ;Save changes to caption, coordinates, data length, and suppress
79 ;colon flag
80 S:DDGFCAP="" (DDGFSUP,DDGFCC)=""
81 S DR=""
82 ;
83 S:DDGFCAP]"" DR=DR_"1////"_DDGFCAP_";"
84 S:DDGFCC]"" DR=DR_"5.1////"_DDGFCC_";"
85 S:DDGFSUP DR=DR_"5.2////1;"
86 ;
87 I DDGFTYPE'=1 D
88 . S:DDGFDC'=DDGFDC0 DR=DR_"4.1////"_DDGFDC_";"
89 . S:DDGFDL'=DDGFDL0 DR=DR_"4.2////"_DDGFDL_";"
90 I DR="" K DR Q
91 ;
92 S DIE="^DIST(.404,"_DA(1)_",40,"
93 S DR=$E(DR,1,$L(DR)-1)
94 D ^DIE K DIE,DR,Y
95 Q
96 ;
97LOADF ;Set DDGFREF and window buffer
98 N C,C1,C2,C3,D,D1,D2,D3,L
99 ;
100 I DDGFCAP="" D
101 . S (C,C1,C2,C3)=""
102 . K @DDGFREF@("F",DDGFPG,DDGFBLCK,DA)
103 E D
104 . S C=DDGFCAP_$S(DDGFTYPE'=1&'DDGFSUP:":",1:"")
105 . S C1=$P(DDGFCC,",")-1+DDGFB1
106 . S C2=$P(DDGFCC,",",2)-1+DDGFB2
107 . S C3=C2+$L(C)-1
108 . ;
109 . S @DDGFREF@("F",DDGFPG,DDGFBLCK,DA)=C1_U_C2_U_C3_U_C
110 . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,DDGFBLCK,DA,"C")=""
111 . D WRITE^DDGLIBW(DDGFWID,C,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
112 ;
113 I DDGFTYPE'=1 D
114 . S D1=$P(DDGFDC,",")-1+DDGFB1
115 . S D2=$P(DDGFDC,",",2)-1+DDGFB2
116 . S D3=D2+DDGFDL-1
117 . ;
118 . S $P(@DDGFREF@("F",DDGFPG,DDGFBLCK,DA),U,5,8)=D1_U_D2_U_D3_U_DDGFDL
119 . I D1]"",D2]"" S @DDGFREF@("RC",DDGFWID,D1,D2,D3,DDGFBLCK,DA,"D")=""
120 . D:DDGFDL WRITE^DDGLIBW(DDGFWID,$TR($J("",DDGFDL)," ","_"),D1-$P(DDGFLIM,U),D2-$P(DDGFLIM,U,2),"",1)
121 Q
122 ;
123RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
124 N S
125 I DDGFR D
126 . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
127 . X IOXY W S_$J("",7-$L(S))
128 S DY=DDGFY,DX=DDGFX X IOXY
129 Q
Note: See TracBrowser for help on using the repository browser.