IBDF10 ;ALB/CJM - ENCOUNTER FORM - (shift block contents) ;APRIL 22,1993
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
SHIFT(TYPE) ;shifts contents of blocks - prompts user for what to shift (unless TYPE is defined), and how much to shift
;assumes IBBLK is defined unless TYPE="B"
N AMOUNT,WAY,QUIT,TOP,BOTTOM,LEFT,RIGHT,HT,WIDTH,MAX
S QUIT=0,VALMBCK="R"
I '$D(TYPE) N TYPE D TYPE
I $D(TYPE),"EDSLTMH"[TYPE S HT=IBBLK("H"),WIDTH=IBBLK("W")
I $G(TYPE)="B" S HT=IBFORM("HT"),WIDTH=IBFORM("WIDTH")
D:'QUIT DIRECTN
D RE^VALM4
D:'QUIT RANGE(HT,WIDTH)
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)
S:'QUIT MAX=$$MAX^IBDF10C(TYPE,WAY,MAX,TOP,BOTTOM,LEFT,RIGHT)
D:'QUIT AMOUNT(MAX)
D:('QUIT)&($G(AMOUNT)>0) @TYPE
S VALMBCK="R"
Q
TYPE ;asks user for what should be shifted
D TYPEHELP
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"
S DIR("?")="^D TYPEHELP^IBDF10"
D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
S TYPE=Y
Q
TYPEHELP ;help for TYPE
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"
Q
DIRECTN ;asks user for direction of shift - returns WAY
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?"
D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
S WAY=Y
Q
AMOUNT(MAX) ;now ask user how far to shift - returns AMOUNT
;MAX is the maxium shift allowed
S DIR(0)="N^0:"_MAX_":0"
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")_"?"
D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
S AMOUNT=Y
Q
RANGE(HT,WIDTH) ;asks the user for the range - returns TOP,BOTTOM,LEFT,RIGHT
N I
K DIR
;get TOP
S DIR("A")="What is the top-most row to shift?"
S DIR(0)="N^1:"_HT_":0",DIR("B")=1
D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
S TOP=Y
;now get BOTTOM
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."
K DIR("B")
S DIR(0)="NO^"_TOP_":"_HT_":0"
D ^DIR K DIR I (Y=-1)!$D(DTOUT)!$D(DUOUT) S QUIT=1 Q
S BOTTOM=Y
;get LEFT
S DIR("A")="What is the left-most column to shift?"
S DIR(0)="N^1:"_WIDTH_":0",DIR("B")=1
D ^DIR K DIR I (Y=-1)!$D(DIRUT) S QUIT=1 Q
S LEFT=Y
;now get RIGHT
S DIR("A")="What is the right-most column to shift? (optional)"
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."
K DIR("B")
S DIR(0)="NO^"_LEFT_":"_WIDTH_":0"
D ^DIR K DIR I (Y=-1)!$D(DTOUT)!$D(DUOUT) S QUIT=1 Q
S RIGHT=Y
;now change TOP,BOTTOM,LEFT,RIGHT to their internal values
;(BOTTOM or RIGHT)="" has special meaning - means shift without limit
S TOP=TOP-1,LEFT=LEFT-1
S:BOTTOM>0 BOTTOM=BOTTOM-1
S:RIGHT>0 RIGHT=RIGHT-1
Q
E ;shift everything
D FLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
D LSTS^IBDF10B(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
D TXT^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
D LINES^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
D MFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
D HFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
Q
D ;shift data fields
D FLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
Q
M ;shift multiple choice fields
D MFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
Q
H ;shift hand print fields
D HFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
Q
S ;shift selection lists
D LSTS^IBDF10B(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
Q
T ;shift text areas
D TXT^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
Q
L ;shift lines
D LINES^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
Q
B ;shift blocks
D BLOCKS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF10 4241 printed Apr 09, 2024@21:13:40 Page 2
IBDF10 ;ALB/CJM - ENCOUNTER FORM - (shift block contents) ;APRIL 22,1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
SHIFT(TYPE) ;shifts contents of blocks - prompts user for what to shift (unless TYPE is defined), and how much to shift
+1 ;assumes IBBLK is defined unless TYPE="B"
+2 NEW AMOUNT,WAY,QUIT,TOP,BOTTOM,LEFT,RIGHT,HT,WIDTH,MAX
+3 SET QUIT=0
SET VALMBCK="R"
+4 IF '$DATA(TYPE)
NEW TYPE
DO TYPE
+5 IF $DATA(TYPE)
IF "EDSLTMH"[TYPE
SET HT=IBBLK("H")
SET WIDTH=IBBLK("W")
+6 IF $GET(TYPE)="B"
SET HT=IBFORM("HT")
SET WIDTH=IBFORM("WIDTH")
+7 if 'QUIT
DO DIRECTN
+8 DO RE^VALM4
+9 if 'QUIT
DO RANGE(HT,WIDTH)
+10 if 'QUIT
SET MAX=$SELECT(WAY="U":$SELECT(BOTTOM:BOTTOM,1:HT),WAY="D":HT-TOP-1,WAY="L":$SELECT(RIGHT:RIGHT,1:WIDTH),1:WIDTH-LEFT-1)
+11 if 'QUIT
SET MAX=$$MAX^IBDF10C(TYPE,WAY,MAX,TOP,BOTTOM,LEFT,RIGHT)
+12 if 'QUIT
DO AMOUNT(MAX)
+13 if ('QUIT)&($GET(AMOUNT)>0)
DO @TYPE
+14 SET VALMBCK="R"
+15 QUIT
TYPE ;asks user for what should be shifted
+1 DO TYPEHELP
+2 KILL DIR
SET DIR(0)="SB^E:Everything;D:Display Fields;S:Selection Lists;L:Lines;T:Text Areas;M:Multiple Choice Fields;H:Hand Print Fields"
SET DIR("A")="What should be shifted?"
SET DIR("B")="Everything"
+3 SET DIR("?")="^D TYPEHELP^IBDF10"
+4 DO ^DIR
KILL DIR
IF (Y=-1)!$DATA(DIRUT)
SET QUIT=1
QUIT
+5 SET TYPE=Y
+6 QUIT
TYPEHELP ;help for TYPE
+1 WRITE !!,"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"
+2 QUIT
DIRECTN ;asks user for direction of shift - returns WAY
+1 SET DIR(0)="SB^U:UP;D:DOWN;L:LEFT;R:RIGHT"
SET DIR("A")="Shift UP, DOWN, LEFT, or RIGHT?"
SET DIR("B")="DOWN"
SET DIR("?")="Which direction should the shift be in?"
+2 DO ^DIR
KILL DIR
IF (Y=-1)!$DATA(DIRUT)
SET QUIT=1
QUIT
+3 SET WAY=Y
+4 QUIT
AMOUNT(MAX) ;now ask user how far to shift - returns AMOUNT
+1 ;MAX is the maxium shift allowed
+2 SET DIR(0)="N^0:"_MAX_":0"
+3 SET DIR("A")="Shift how far "_$SELECT(WAY="U":"up in rows",WAY="D":"down in rows",WAY="R":"to the right in columns",1:"to the left in columns")_"?"
+4 DO ^DIR
KILL DIR
IF (Y=-1)!$DATA(DIRUT)
SET QUIT=1
QUIT
+5 SET AMOUNT=Y
+6 QUIT
RANGE(HT,WIDTH) ;asks the user for the range - returns TOP,BOTTOM,LEFT,RIGHT
+1 NEW I
+2 KILL DIR
+3 ;get TOP
+4 SET DIR("A")="What is the top-most row to shift?"
+5 SET DIR(0)="N^1:"_HT_":0"
SET DIR("B")=1
+6 DO ^DIR
KILL DIR
IF (Y=-1)!$DATA(DIRUT)
SET QUIT=1
QUIT
+7 SET TOP=Y
+8 ;now get BOTTOM
+9 SET DIR("A")="What is the bottom-most row to shift? (optional)"
SET DIR("?",1)="Enter the lowest row that the shift should effect."
SET DIR("?")="Enter nothing to shift everything below the top-most row that you specified."
+10 KILL DIR("B")
+11 SET DIR(0)="NO^"_TOP_":"_HT_":0"
+12 DO ^DIR
KILL DIR
IF (Y=-1)!$DATA(DTOUT)!$DATA(DUOUT)
SET QUIT=1
QUIT
+13 SET BOTTOM=Y
+14 ;get LEFT
+15 SET DIR("A")="What is the left-most column to shift?"
+16 SET DIR(0)="N^1:"_WIDTH_":0"
SET DIR("B")=1
+17 DO ^DIR
KILL DIR
IF (Y=-1)!$DATA(DIRUT)
SET QUIT=1
QUIT
+18 SET LEFT=Y
+19 ;now get RIGHT
+20 SET DIR("A")="What is the right-most column to shift? (optional)"
+21 SET DIR("?",1)="Enter the right-most column that the shift should effect."
SET DIR("?")="Enter nothing to shift everything to the right of the left-most column that you specified."
+22 KILL DIR("B")
+23 SET DIR(0)="NO^"_LEFT_":"_WIDTH_":0"
+24 DO ^DIR
KILL DIR
IF (Y=-1)!$DATA(DTOUT)!$DATA(DUOUT)
SET QUIT=1
QUIT
+25 SET RIGHT=Y
+26 ;now change TOP,BOTTOM,LEFT,RIGHT to their internal values
+27 ;(BOTTOM or RIGHT)="" has special meaning - means shift without limit
+28 SET TOP=TOP-1
SET LEFT=LEFT-1
+29 if BOTTOM>0
SET BOTTOM=BOTTOM-1
+30 if RIGHT>0
SET RIGHT=RIGHT-1
+31 QUIT
E ;shift everything
+1 DO FLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+2 DO LSTS^IBDF10B(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+3 DO TXT^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+4 DO LINES^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+5 DO MFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+6 DO HFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+7 QUIT
D ;shift data fields
+1 DO FLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+2 QUIT
M ;shift multiple choice fields
+1 DO MFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+2 QUIT
H ;shift hand print fields
+1 DO HFLDS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+2 QUIT
S ;shift selection lists
+1 DO LSTS^IBDF10B(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+2 QUIT
T ;shift text areas
+1 DO TXT^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+2 QUIT
L ;shift lines
+1 DO LINES^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+2 QUIT
B ;shift blocks
+1 DO BLOCKS^IBDF10A(WAY,AMOUNT,TOP,BOTTOM,LEFT,RIGHT)
+2 QUIT
