| 1 | IBDE3 ;ALB/CJM - ENCOUNTER FORM - IMP/EXP UTILITY -DISPLAYS TOOLKIT BLOCKS ;AUG 12,1993
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**14**;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | HDR ;
|
|---|
| 5 | S VALMHDR(1)="LIST OF TOOLKIT BLOCKS READY FOR IMPORT OR EXPORT"
|
|---|
| 6 | S VALMHDR(3)="(** there are "_$S($O(^IBE(358,0)):"also",1:"no")_" forms in the work space **)"
|
|---|
| 7 | Q
|
|---|
| 8 | ONENTRY ;
|
|---|
| 9 | N LINE
|
|---|
| 10 | S VALMCNT=$G(BLKCNT)
|
|---|
| 11 | I $D(BLKLIST) S LINE=0 F S LINE=$O(@BLKLIST@(LINE)) Q:'LINE D FLDCTRL^VALM10(LINE)
|
|---|
| 12 | Q
|
|---|
| 13 | ONEXIT ;
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | IDXBLKS ;build an array of forms used by IBCLINIC for the list processor
|
|---|
| 17 | N BLOCK,NODE,ORDER
|
|---|
| 18 | K @BLKLIST
|
|---|
| 19 | S (VALMCNT,ORDER)=0 F S ORDER=$O(^IBE(358.1,"D",ORDER)) Q:'ORDER S BLOCK=0 F S BLOCK=$O(^IBE(358.1,"D",ORDER,BLOCK)) Q:'BLOCK D
|
|---|
| 20 | .I $D(^IBE(358.1,BLOCK,0)) D
|
|---|
| 21 | ..S VALMCNT=VALMCNT+1,@BLKLIST@(VALMCNT,0)=$$DISPLAY(BLOCK,VALMCNT),@BLKLIST@("IDX",VALMCNT,VALMCNT)=BLOCK D FLDCTRL^VALM10(VALMCNT) ;set video for ID column
|
|---|
| 22 | S BLKCNT=VALMCNT
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | DISPLAY(BLOCK,ID) ;
|
|---|
| 26 | N NODE,RET
|
|---|
| 27 | S RET=$J(ID,3)_" "
|
|---|
| 28 | S NODE=$G(^IBE(358.1,BLOCK,0))
|
|---|
| 29 | S RET=RET_$$PADRIGHT^IBDFU($P(NODE,"^",1),30)_" "_$P(NODE,"^",13)
|
|---|
| 30 | Q RET
|
|---|
| 31 | ;
|
|---|
| 32 | ADD ;adds a block to the work space
|
|---|
| 33 | N OLDBLOCK,NEWBLOCK
|
|---|
| 34 | D FULL^VALM1
|
|---|
| 35 | S VALMBCK="R"
|
|---|
| 36 | S OLDBLOCK=$$SELECT Q:'OLDBLOCK
|
|---|
| 37 | S NEWBLOCK=$$COPYBLK^IBDFU2(OLDBLOCK,"",357.1,358.1,"","",1)
|
|---|
| 38 | I NEWBLOCK K DIE,DR,DA S DIE="^IBE(358.1,",DA=NEWBLOCK,DR="1;" D ^DIE K DIE,DR,DA
|
|---|
| 39 | D IDXBLKS
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | DELETE ;deletes a block from the work space
|
|---|
| 43 | N PICK,FORM,IBTKBLK
|
|---|
| 44 | S IBTKBLK=1 ;can't delete tk blocks unless IBTKBLK
|
|---|
| 45 | D EN^VALM2($G(XQORNOD(0)))
|
|---|
| 46 | S PICK="" F S PICK=$O(VALMY(PICK)) Q:'PICK S BLOCK=+$G(@VALMAR@("IDX",PICK,PICK)) I BLOCK,$$RUSURE^IBDFU5($P($G(^IBE(358.1,BLOCK,0)),"^")) D DLTBLK^IBDFU3(BLOCK,"",358.1)
|
|---|
| 47 | S VALMBCK="R"
|
|---|
| 48 | D IDXBLKS
|
|---|
| 49 | Q
|
|---|
| 50 | EDIT ;allows the export notes of a block to be edited
|
|---|
| 51 | N PICK,BLOCK
|
|---|
| 52 | D EN^VALM2($G(XQORNOD(0)))
|
|---|
| 53 | D FULL^VALM1
|
|---|
| 54 | S PICK="" F S PICK=$O(VALMY(PICK)) Q:'PICK S BLOCK=+$G(@VALMAR@("IDX",PICK,PICK)) D:BLOCK
|
|---|
| 55 | .K DIE,DR,DA S DIE="^IBE(358.1,",DR="1;",DA=BLOCK D ^DIE K DIE,DA,DR
|
|---|
| 56 | S VALMBCK="R"
|
|---|
| 57 | D IDXBLKS
|
|---|
| 58 | Q
|
|---|
| 59 | IMPORT ;allows the user to pick a block from the imp/exp files, then import it
|
|---|
| 60 | N PICK,BLOCK,NEWBLOCK,IBTKBLK,NAME
|
|---|
| 61 | S IBTKBLK=1
|
|---|
| 62 | D EN^VALM2($G(XQORNOD(0)))
|
|---|
| 63 | D FULL^VALM1
|
|---|
| 64 | S PICK="" F S PICK=$O(VALMY(PICK)) Q:'PICK S BLOCK=+$G(@VALMAR@("IDX",PICK,PICK)) D:BLOCK
|
|---|
| 65 | .S NAME=$$NEWNAME($P($G(^IBE(358.1,BLOCK,0)),"^"))
|
|---|
| 66 | .Q:NAME=""
|
|---|
| 67 | .S NEWBLOCK=$$COPYBLK^IBDFU2(BLOCK,$$TKFORM^IBDFU2C,358.1,357.1,"","",$$TKORDER^IBDF13,NAME)
|
|---|
| 68 | .D:$G(NEWBLOCK) DLTBLK^IBDFU3(BLOCK,"",358.1)
|
|---|
| 69 | S VALMBCK="R"
|
|---|
| 70 | D IDXBLKS
|
|---|
| 71 | D UPDATE^IBDECLN(1) ;clean up qualifiers (with messages)
|
|---|
| 72 | Q
|
|---|
| 73 | VIEW ;allows the export notes of a form to be edited
|
|---|
| 74 | N PICK,BLOCK,IBARY,IBHDRRTN
|
|---|
| 75 | D EN^VALM2($G(XQORNOD(0)),"S")
|
|---|
| 76 | S PICK="" F S PICK=$O(VALMY(PICK)) Q:'PICK S BLOCK=+$G(@VALMAR@("IDX",PICK,PICK)) D
|
|---|
| 77 | .S IBHDRRTN="D VIEWHDR^IBDE3"
|
|---|
| 78 | .S IBARY="^IBE(358.1,"_BLOCK_",1)"
|
|---|
| 79 | .D EN^VALM("IBDE TEXT DISPLAY")
|
|---|
| 80 | S VALMBCK="R"
|
|---|
| 81 | Q
|
|---|
| 82 | VIEWHDR ;
|
|---|
| 83 | S VALMHDR(1)="Export Notes For "_$P($G(^IBE(358.1,BLOCK,0)),"^")_" Block"
|
|---|
| 84 | Q
|
|---|
| 85 | SELECT() ;allows the user to select a form, then a block from it
|
|---|
| 86 | N IBFORM,IBBLK
|
|---|
| 87 | S (IBFORM,IBBLK)=""
|
|---|
| 88 | K DIR S DIR(0)="S^1:TOOLKIT BLOCK;2:BLOCK FROM A TOOLKIT FORM;3:BLOCK FROM A FORM NOT IN THE TOOLKIT"
|
|---|
| 89 | S DIR("A")="What type of block do you want to export?"
|
|---|
| 90 | D ^DIR K DIR
|
|---|
| 91 | Q:(Y=-1)!($D(DIRUT)) ""
|
|---|
| 92 | I Y=1 D
|
|---|
| 93 | .S IBFORM=$$TKFORM^IBDFU2C
|
|---|
| 94 | E S IBFORM=$$SLCTFORM^IBDFU4($S(Y=2:1,1:0))
|
|---|
| 95 | I IBFORM D
|
|---|
| 96 | .W !!,"NOW CHOOSE THE BLOCK TO COPY!",!
|
|---|
| 97 | .S IBBLK=$$SLCTBLK^IBDFU8(IBFORM)
|
|---|
| 98 | Q IBBLK
|
|---|
| 99 | ;
|
|---|
| 100 | NEWNAME(OLDNAME) ;asks the user to select uniqued toolkit block name
|
|---|
| 101 | ;returns "" if unsuccessfull, else the blk name
|
|---|
| 102 | ;shows OLDNAME as the default if defined
|
|---|
| 103 | ;
|
|---|
| 104 | N NAME,FOUND,TKBLK,ORDER S NAME=""
|
|---|
| 105 | K DIR S DIR(0)="357.1,.01A",DIR("A")="New Toolkit Block Name: ",DIR("?")="Enter a unique name for the toolkit block up to 30 characters"
|
|---|
| 106 | S DIR("B")="" I $G(OLDNAME)'="" S DIR("B")=OLDNAME
|
|---|
| 107 | F D Q:'FOUND
|
|---|
| 108 | .S FOUND=0
|
|---|
| 109 | .D ^DIR I $D(DIRUT) S Y="" Q
|
|---|
| 110 | .S ORDER=0 F S ORDER=$O(^IBE(357.1,"D",ORDER)) Q:ORDER="" S TKBLK=$O(^IBE(357.1,"D",ORDER,0)) Q:'TKBLK I $P($G(^IBE(357.1,TKBLK,0)),"^")=Y W !,"There is already a toolkit block with that name! The name should be unique." S FOUND=1 Q
|
|---|
| 111 | S:'FOUND NAME=Y
|
|---|
| 112 | K DIR
|
|---|
| 113 | Q NAME
|
|---|
