source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF10.m@ 1578

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1IBDF10 ;ALB/CJM - ENCOUNTER FORM - (shift block contents) ;APRIL 22,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4SHIFT(TYPE) ;shifts contents of blocks - prompts user for what to shift (unless TYPE is defined), and how much to shift
5 ;assumes IBBLK is defined unless TYPE="B"
6 N AMOUNT,WAY,QUIT,TOP,BOTTOM,LEFT,RIGHT,HT,WIDTH,MAX
7 S QUIT=0,VALMBCK="R"
8 I '$D(TYPE) N TYPE D TYPE
9 I $D(TYPE),"EDSLTMH"[TYPE S HT=IBBLK("H"),WIDTH=IBBLK("W")
10 I $G(TYPE)="B" S HT=IBFORM("HT"),WIDTH=IBFORM("WIDTH")
11 D:'QUIT DIRECTN
12 D RE^VALM4
13 D:'QUIT RANGE(HT,WIDTH)
14 S:'QUIT MAX=$S(WAY="U":$S(BOTTOM:BOTTOM,1:HT),WAY="D":HT-TOP-1,WAY="L":$S(RIGHT:RIGHT,1:WIDTH),1:WIDTH-LEFT-1)
15 S:'QUIT MAX=$$MAX^IBDF10C(TYPE,WAY,MAX,TOP,BOTTOM,LEFT,RIGHT)
16 D:'QUIT AMOUNT(MAX)
17 D:('QUIT)&($G(AMOUNT)>0) @TYPE
18 S VALMBCK="R"
19 Q
20TYPE ;asks user for what should be shifted
21 D TYPEHELP
22 K DIR S DIR(0)="SB^E:Everything;D:Display Fields;S:Selection Lists;L:Lines;T:Text Areas;M:Multiple Choice Fields;H:Hand Print Fields",DIR("A")="What should be shifted?",DIR("B")="Everything"
23 S DIR("?")="^D TYPEHELP^IBDF10"
24 D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
25 S TYPE=Y
26 Q
27TYPEHELP ;help for TYPE
28 W !!,"You can choose what should be shifted. Select one of the following:",!," [E]verything, [D]isplay fields, [S]election lists, [L]ines, [T]ext areas,",!," [M]ultiple choice fields, [H]and print fields"
29 Q
30DIRECTN ;asks user for direction of shift - returns WAY
31 S DIR(0)="SB^U:UP;D:DOWN;L:LEFT;R:RIGHT",DIR("A")="Shift UP, DOWN, LEFT, or RIGHT?",DIR("B")="DOWN",DIR("?")="Which direction should the shift be in?"
32 D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
33 S WAY=Y
34 Q
35AMOUNT(MAX) ;now ask user how far to shift - returns AMOUNT
36 ;MAX is the maxium shift allowed
37 S DIR(0)="N^0:"_MAX_":0"
38 S DIR("A")="Shift how far "_$S(WAY="U":"up in rows",WAY="D":"down in rows",WAY="R":"to the right in columns",1:"to the left in columns")_"?"
39 D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
40 S AMOUNT=Y
41 Q
42RANGE(HT,WIDTH) ;asks the user for the range - returns TOP,BOTTOM,LEFT,RIGHT
43 N I
44 K DIR
45 ;get TOP
46 S DIR("A")="What is the top-most row to shift?"
47 S DIR(0)="N^1:"_HT_":0",DIR("B")=1
48 D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
49 S TOP=Y
50 ;now get BOTTOM
51 S DIR("A")="What is the bottom-most row to shift? (optional)",DIR("?",1)="Enter the lowest row that the shift should effect.",DIR("?")="Enter nothing to shift everything below the top-most row that you specified."
52 K DIR("B")
53 S DIR(0)="NO^"_TOP_":"_HT_":0"
54 D ^DIR K DIR I (Y=-1)!$D(DTOUT)!$D(DUOUT) S QUIT=1 Q
55 S BOTTOM=Y
56 ;get LEFT
57 S DIR("A")="What is the left-most column to shift?"
58 S DIR(0)="N^1:"_WIDTH_":0",DIR("B")=1
59 D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
60 S LEFT=Y
61 ;now get RIGHT
62 S DIR("A")="What is the right-most column to shift? (optional)"
63 S DIR("?",1)="Enter the right-most column that the shift should effect.",DIR("?")="Enter nothing to shift everything to the right of the left-most column that you specified."
64 K DIR("B")
65 S DIR(0)="NO^"_LEFT_":"_WIDTH_":0"
66 D ^DIR K DIR I (Y=-1)!$D(DTOUT)!$D(DUOUT) S QUIT=1 Q
67 S RIGHT=Y
68 ;now change TOP,BOTTOM,LEFT,RIGHT to their internal values
69 ;(BOTTOM or RIGHT)="" has special meaning - means shift without limit
70 S TOP=TOP-1,LEFT=LEFT-1
71 S:BOTTOM>0 BOTTOM=BOTTOM-1
72 S:RIGHT>0 RIGHT=RIGHT-1
73 Q
74E ;shift everything
75 D FLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
76 D LSTS^IBDF10B(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
77 D TXT^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
78 D LINES^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
79 D MFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
80 D HFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
81 Q
82D ;shift data fields
83 D FLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
84 Q
85M ;shift multiple choice fields
86 D MFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
87 Q
88H ;shift hand print fields
89 D HFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
90 Q
91S ;shift selection lists
92 D LSTS^IBDF10B(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
93 Q
94T ;shift text areas
95 D TXT^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
96 Q
97L ;shift lines
98 D LINES^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
99 Q
100B ;shift blocks
101 D BLOCKS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
102 Q
Note: See TracBrowser for help on using the repository browser.