| 1 | IBDF5D ;ALB/CJM - ENCOUNTER FORM - (copy page) ;DEC 12, 1994
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | COPYPAGE ;
|
|---|
| 5 | N FROMFORM,PAGE,TOLINE,NODE,ROW,COL,BEGIN,END,QUIT,BLOCK
|
|---|
| 6 | D FULL^VALM1
|
|---|
| 7 | S VALMBCK="R"
|
|---|
| 8 | S FROMFORM=$$SLCTFORM^IBDFU4("") Q:'FROMFORM
|
|---|
| 9 | Q:'$$FORMSIZE^IBDFU1C(.FROMFORM)
|
|---|
| 10 | I FROMFORM("PAGES")=1 D
|
|---|
| 11 | .S BEGIN=0,END=FROMFORM("PAGE_HT")-1
|
|---|
| 12 | E D Q:QUIT
|
|---|
| 13 | .S QUIT=0
|
|---|
| 14 | .K DIR S DIR(0)="N^1:"_FROMFORM("PAGES")_":0",DIR("A")="Copy Page Number",DIR("B")=1,DIR("?")="Which page do you want to copy?" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q
|
|---|
| 15 | .S PAGE=Y I 'PAGE S QUIT=1 Q
|
|---|
| 16 | .S BEGIN=((PAGE-1)*FROMFORM("PAGE_HT"))-1,END=(BEGIN+FROMFORM("PAGE_HT"))-1
|
|---|
| 17 | K DIR S DIR(0)="N^1:"_IBFORM("HT")_":0",DIR("A")="Copy To Line Number",DIR("B")=($$CURY^IBDFU4)+1,DIR("?")="Begining at what line should the page be pasted?" D ^DIR K DIR I 'X!$D(DIRUT) S QUIT=1 Q
|
|---|
| 18 | I 'Y S QUIT=1 Q
|
|---|
| 19 | S TOLINE=Y-1
|
|---|
| 20 | S BLOCK=0
|
|---|
| 21 | F S BLOCK=$O(^IBE(357.1,"C",FROMFORM,BLOCK)) Q:'BLOCK S NODE=$G(^IBE(357.1,BLOCK,0)) Q:NODE="" S ROW=$P(NODE,"^",4),COL=$P(NODE,"^",5) D
|
|---|
| 22 | .N NEWBLOCK
|
|---|
| 23 | .I '(ROW>END),'(ROW<BEGIN) S NEWBLOCK=$$COPYBLK^IBDFU2(BLOCK,IBFORM,357.1,357.1,(ROW#FROMFORM("PAGE_HT"))+TOLINE,COL)
|
|---|
| 24 | D IDXFORM^IBDF5A()
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | COPY ;ask user whether to copy a block or a page
|
|---|
| 28 | S VALMBCK="R"
|
|---|
| 29 | K DIR S DIR(0)="SB^P:PAGE COPY;B:BLOCK COPY;",DIR("A")="Copy an entire page or a single block?",DIR("?")="You can copy either a single block or an entire page."
|
|---|
| 30 | D ^DIR K DIR I $D(DIRUT) Q
|
|---|
| 31 | D:Y="P" COPYPAGE
|
|---|
| 32 | D:Y="B" COPYBLK^IBDF5C
|
|---|
| 33 | K DIR
|
|---|
| 34 | Q
|
|---|
