IBDF13 ;ALB/CJM - ENCOUNTER FORM - EDITING TOOLKIT BLKS ; 24-JUN-1993
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
LIST ;displays list of toolkit blocks, then allows editng
N IBFORM,IBTKFORM,IBTKBLK,IBFASTXT,IOVL,IOHL,IOBRC,IOBLC,IOTRC,IOTLC,IBBLK,BLKLIST,D0,DA,IBDEVICE
S (IBTKFORM,IBFASTXT,IBBLK)=0,IBTKBLK=1
S IBFORM("NAME")="LIST OF TOOLKIT BLOCKS",IBFORM("TOOLKIT")=1,IBFORM("COMPILED")=0,IBFORM("HT")=80,IBFORM("WIDTH")=133,IBFORM("PAGE_HT")=80,IBFORM("PAGES")=1,IBFORM("SCAN")=1,IBFORM("SCAN","ICR")=1,IBFORM("SCAN",1)=1
;
D DEVICE^IBDFUA(1,.IBDEVICE)
K XQORS,VALMEVL
D PRNTPRMS^IBDFU1C(.IBPRINT,0,1,0,0)
S IBFORM=$$TKFORM^IBDFU2C
D EN^VALM("IBDF EDIT TOOL KIT BLOCKS") ;list processor displays list of toolkit blocks
Q
;
SELECT() ;allows the user to select from the displayed list of TK blocks
N CHOICE,IBBLK
S IBBLK=""
D EN^VALM2($G(XQORNOD(0)),"S")
S CHOICE=$O(VALMY("")) S:CHOICE IBBLK=$G(@VALMAR@("IDX",CHOICE,CHOICE))
Q IBBLK
EDITBLK ;allows user to select a blk, then displays it for edit
;allows user to discard or save changes to the block
;
;If IBBLK and IBBLK2 are used to point to two copies of the block, one in the workspace and the other on the form
;the copy on the form is not edited, the copy in the workspace is
N IBBLK,IBBLK2,IBTKODR,IBJUNK,IFSAVE
;N IBMEMARY
S VALMBCK="R"
S IBBLK2=""
S IBBLK=$$SELECT
I IBBLK D
.S (IBBLK2,IBTKODR,IBJUNK)=""
.D COPYBLK^IBDF5B(IBBLK,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK) I 'IBBLK S IBBLK=IBBLK2,IBBLK2="" Q ;sets IBBLK to the work copy, IBBLK2 to the copy actually on the form
D:IBBLK2 EN^VALM("IBDF FORM BLOCK EDIT")
I IBBLK,IBBLK2 D
.S IFSAVE=$$ASKSAVE^IBDF5B
.I IFSAVE D SAVECOPY^IBDF5B(.IBBLK,.IBBLK2,IBTKODR) S IBBLK=IBBLK2,IBBLK2=""
.I 'IFSAVE D DLTCOPY^IBDF5B(IBBLK) S IBBLK=IBBLK2,IBBLK2=""
S IBPRINT("WITH_DATA")=0
D:'$G(IBFASTXT) IDXBLKS^IBDF7
Q
DLTBLOCK ;allows user to select a blk, then deletes it
N IBBLK
S VALMBCK="R"
S IBBLK=$$SELECT
I IBBLK Q:'$$RUSURE^IBDFU5($P($G(^IBE(357.1,IBBLK,0)),"^")) D DLTBLK^IBDFU3(IBBLK,IBFORM,357.1),IDXBLKS^IBDF7
Q
CHGORDER ;allows user to select a blk, then change it's order in the toolkit
N IBBLK
S VALMBCK="R"
S IBBLK=$$SELECT
I IBBLK K DIE,DA S DIE=357.1,DA=IBBLK,DR=".14R" D ^DIE K DIE,DA,DR,DIC
D IDXBLKS^IBDF7
Q
NEWBLK ;creates a new toolkit block
N IBBLK
S VALMBCK="R"
S IBBLK=$$CREATE^IBDF5C()
D:IBBLK IDXBLKS^IBDF7
Q
COPYBLK ;allows the user to select a block to copy
N IBBLK,CHOICE,NEWBLK
S VALMBCK="R"
D FULL^VALM1
K DIR S DIR(0)="SO^1:ON THE LIST OF TOOLKIT BLOCKS;2:ON A TOOLKIT FORM;3:ON A FORM NOT IN THE TOOLKIT"
S DIR("A")="WHERE IS THE BLOCK THAT YOU WANT COPIED?"
D ^DIR K DIR
Q:(Y=-1)!$D(DIRUT)
S CHOICE=Y,IBBLK=""
D:CHOICE=1 RE^VALM4
S:CHOICE=1 IBBLK=$$SELECT
S:CHOICE=2 IBBLK=$$SELECT2(1)
S:CHOICE=3 IBBLK=$$SELECT2(0)
I IBBLK S NEWBLK=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1,0,0,$$TKORDER()) I NEWBLK D
.K DIE,DA S DIE=357.1,DA=NEWBLK,DR=".01;.13R;.14R" D ^DIE
.I '$G(DA) D DLTCNTNT^IBDFU3(NEWBLK,357.1)
.K DIE,DA,DR,DIC
.D IDXBLKS^IBDF7
S VALMBCK="R"
Q
TKORDER() ;returns an unused number for the list of toolkit blocks
N NUMBER
F NUMBER=1:1:10000 Q:'$D(^IBE(357.1,"D",NUMBER))
Q NUMBER
SELECT2(TK) ;allows the user to select a form, then a block from it
;TK=0 if form is not to be chosen from the TK
;TK=1 if the form is to be chosen from the TK
;TK="" means ask the user whether or not the form is in the TK
N IBFORM,IBBLK
S IBBLK=""
S IBFORM=$$SLCTFORM^IBDFU4($G(TK))
I IBFORM D
.W !!,"NOW CHOOSE THE BLOCK TO COPY!",!
.S IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL)
Q IBBLK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF13 3691 printed Apr 09, 2024@20:49:58 Page 2
IBDF13 ;ALB/CJM - ENCOUNTER FORM - EDITING TOOLKIT BLKS ; 24-JUN-1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
LIST ;displays list of toolkit blocks, then allows editng
+1 NEW IBFORM,IBTKFORM,IBTKBLK,IBFASTXT,IOVL,IOHL,IOBRC,IOBLC,IOTRC,IOTLC,IBBLK,BLKLIST,D0,DA,IBDEVICE
+2 SET (IBTKFORM,IBFASTXT,IBBLK)=0
SET IBTKBLK=1
+3 SET IBFORM("NAME")="LIST OF TOOLKIT BLOCKS"
SET IBFORM("TOOLKIT")=1
SET IBFORM("COMPILED")=0
SET IBFORM("HT")=80
SET IBFORM("WIDTH")=133
SET IBFORM("PAGE_HT")=80
SET IBFORM("PAGES")=1
SET IBFORM("SCAN")=1
SET IBFORM("SCAN","ICR")=1
SET IBFORM("SCAN",1)=1
+4 ;
+5 DO DEVICE^IBDFUA(1,.IBDEVICE)
+6 KILL XQORS,VALMEVL
+7 DO PRNTPRMS^IBDFU1C(.IBPRINT,0,1,0,0)
+8 SET IBFORM=$$TKFORM^IBDFU2C
+9 ;list processor displays list of toolkit blocks
DO EN^VALM("IBDF EDIT TOOL KIT BLOCKS")
+10 QUIT
+11 ;
SELECT() ;allows the user to select from the displayed list of TK blocks
+1 NEW CHOICE,IBBLK
+2 SET IBBLK=""
+3 DO EN^VALM2($GET(XQORNOD(0)),"S")
+4 SET CHOICE=$ORDER(VALMY(""))
if CHOICE
SET IBBLK=$GET(@VALMAR@("IDX",CHOICE,CHOICE))
+5 QUIT IBBLK
EDITBLK ;allows user to select a blk, then displays it for edit
+1 ;allows user to discard or save changes to the block
+2 ;
+3 ;If IBBLK and IBBLK2 are used to point to two copies of the block, one in the workspace and the other on the form
+4 ;the copy on the form is not edited, the copy in the workspace is
+5 NEW IBBLK,IBBLK2,IBTKODR,IBJUNK,IFSAVE
+6 ;N IBMEMARY
+7 SET VALMBCK="R"
+8 SET IBBLK2=""
+9 SET IBBLK=$$SELECT
+10 IF IBBLK
Begin DoDot:1
+11 SET (IBBLK2,IBTKODR,IBJUNK)=""
+12 ;sets IBBLK to the work copy, IBBLK2 to the copy actually on the form
DO COPYBLK^IBDF5B(IBBLK,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK)
IF 'IBBLK
SET IBBLK=IBBLK2
SET IBBLK2=""
QUIT
End DoDot:1
+13 if IBBLK2
DO EN^VALM("IBDF FORM BLOCK EDIT")
+14 IF IBBLK
IF IBBLK2
Begin DoDot:1
+15 SET IFSAVE=$$ASKSAVE^IBDF5B
+16 IF IFSAVE
DO SAVECOPY^IBDF5B(.IBBLK,.IBBLK2,IBTKODR)
SET IBBLK=IBBLK2
SET IBBLK2=""
+17 IF 'IFSAVE
DO DLTCOPY^IBDF5B(IBBLK)
SET IBBLK=IBBLK2
SET IBBLK2=""
End DoDot:1
+18 SET IBPRINT("WITH_DATA")=0
+19 if '$GET(IBFASTXT)
DO IDXBLKS^IBDF7
+20 QUIT
DLTBLOCK ;allows user to select a blk, then deletes it
+1 NEW IBBLK
+2 SET VALMBCK="R"
+3 SET IBBLK=$$SELECT
+4 IF IBBLK
if '$$RUSURE^IBDFU5($PIECE($GET(^IBE(357.1,IBBLK,0)),"^"))
QUIT
DO DLTBLK^IBDFU3(IBBLK,IBFORM,357.1)
DO IDXBLKS^IBDF7
+5 QUIT
CHGORDER ;allows user to select a blk, then change it's order in the toolkit
+1 NEW IBBLK
+2 SET VALMBCK="R"
+3 SET IBBLK=$$SELECT
+4 IF IBBLK
KILL DIE,DA
SET DIE=357.1
SET DA=IBBLK
SET DR=".14R"
DO ^DIE
KILL DIE,DA,DR,DIC
+5 DO IDXBLKS^IBDF7
+6 QUIT
NEWBLK ;creates a new toolkit block
+1 NEW IBBLK
+2 SET VALMBCK="R"
+3 SET IBBLK=$$CREATE^IBDF5C()
+4 if IBBLK
DO IDXBLKS^IBDF7
+5 QUIT
COPYBLK ;allows the user to select a block to copy
+1 NEW IBBLK,CHOICE,NEWBLK
+2 SET VALMBCK="R"
+3 DO FULL^VALM1
+4 KILL DIR
SET DIR(0)="SO^1:ON THE LIST OF TOOLKIT BLOCKS;2:ON A TOOLKIT FORM;3:ON A FORM NOT IN THE TOOLKIT"
+5 SET DIR("A")="WHERE IS THE BLOCK THAT YOU WANT COPIED?"
+6 DO ^DIR
KILL DIR
+7 if (Y=-1)!$DATA(DIRUT)
QUIT
+8 SET CHOICE=Y
SET IBBLK=""
+9 if CHOICE=1
DO RE^VALM4
+10 if CHOICE=1
SET IBBLK=$$SELECT
+11 if CHOICE=2
SET IBBLK=$$SELECT2(1)
+12 if CHOICE=3
SET IBBLK=$$SELECT2(0)
+13 IF IBBLK
SET NEWBLK=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1,0,0,$$TKORDER())
IF NEWBLK
Begin DoDot:1
+14 KILL DIE,DA
SET DIE=357.1
SET DA=NEWBLK
SET DR=".01;.13R;.14R"
DO ^DIE
+15 IF '$GET(DA)
DO DLTCNTNT^IBDFU3(NEWBLK,357.1)
+16 KILL DIE,DA,DR,DIC
+17 DO IDXBLKS^IBDF7
End DoDot:1
+18 SET VALMBCK="R"
+19 QUIT
TKORDER() ;returns an unused number for the list of toolkit blocks
+1 NEW NUMBER
+2 FOR NUMBER=1:1:10000
if '$DATA(^IBE(357.1,"D",NUMBER))
QUIT
+3 QUIT NUMBER
SELECT2(TK) ;allows the user to select a form, then a block from it
+1 ;TK=0 if form is not to be chosen from the TK
+2 ;TK=1 if the form is to be chosen from the TK
+3 ;TK="" means ask the user whether or not the form is in the TK
+4 NEW IBFORM,IBBLK
+5 SET IBBLK=""
+6 SET IBFORM=$$SLCTFORM^IBDFU4($GET(TK))
+7 IF IBFORM
Begin DoDot:1
+8 WRITE !!,"NOW CHOOSE THE BLOCK TO COPY!",!
+9 SET IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL)
End DoDot:1
+10 QUIT IBBLK
