| 1 | IBDF5C ;ALB/CJM - ENCOUNTER FORM (creating a new block) ;MARCH 22,1993
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | NEWBLOCK ;adds a new block, expects IBFORM to be defined
|
|---|
| 4 | N IBBLK,TOP,BOT
|
|---|
| 5 | S VALMBCK="R"
|
|---|
| 6 | S IBBLK=$$CREATE()
|
|---|
| 7 | I IBBLK D
|
|---|
| 8 | .D TOPNBOT^IBDFU5(IBBLK,.TOP,.BOT)
|
|---|
| 9 | .D IDXFORM^IBDF5A(TOP,BOT)
|
|---|
| 10 | Q
|
|---|
| 11 | CREATE() ;creates the new block and allows the user to edit it
|
|---|
| 12 | ;INPUTS: expects IBFORM to be defined
|
|---|
| 13 | ; expects IBTKBLK to be defined - IBTKBLK=1 means add to tk
|
|---|
| 14 | ;returns IBBLK
|
|---|
| 15 | N NAME,IBBLK,NODE,IBDFDONE,IBBG,IBLFT,DLAYGO
|
|---|
| 16 | S IBBG=1,IBLFT=5
|
|---|
| 17 | S VALMBCK="R"
|
|---|
| 18 | I '$G(IBTKBLK) S IBBG=+$G(VALMBG),IBLFT=+$G(VALMLFT)
|
|---|
| 19 | S NAME=$$NEWNAME Q:NAME=-1 ""
|
|---|
| 20 | K DIC,DIE,DD,DO,DINUM S DIC="^IBE(357.1,",DIC(0)="FL",X=NAME,DLAYGO=357.1
|
|---|
| 21 | D FILE^DICN K DIC,DIE,DA
|
|---|
| 22 | S IBBLK=+Y
|
|---|
| 23 | I 'IBBLK D
|
|---|
| 24 | .W !,"Unable to create a new block!" K DIC,DIE D PAUSE^IBDFU5
|
|---|
| 25 | I IBBLK D
|
|---|
| 26 | .;delete everything in the block - it should be empty
|
|---|
| 27 | .D DLTCNTNT^IBDFU3(IBBLK,357.1)
|
|---|
| 28 | .;set the current position of the block to the upper left-hand corner of the screen as the default
|
|---|
| 29 | .S $P(^IBE(357.1,IBBLK,0),"^",4,5)=(IBBG-1)_"^"_(IBLFT-5)
|
|---|
| 30 | .;now let the user edit the new block - header,name,outline,etc.
|
|---|
| 31 | .K DIE,DA S DIE=357.1,DA=IBBLK,DR="[IBDF NEW EMPTY BLOCK]",DIE("NO^")="BACKOUTOK" D ^DIE K DIC,DIE,DR,DA
|
|---|
| 32 | .I 'IBDFDONE S DIK="^IBE(357.1,",DA=IBBLK K DA(1) D ^DIK K DIK,DA Q
|
|---|
| 33 | Q IBBLK
|
|---|
| 34 | NEWNAME() ;
|
|---|
| 35 | K DIR S DIR(0)="357.1,.01A",DIR("A")="New Block Name: ",DIR("B")=""
|
|---|
| 36 | D ^DIR K DIR I $D(DIRUT) Q -1
|
|---|
| 37 | Q Y
|
|---|
| 38 | REDRAW ;redraws the ;entire form
|
|---|
| 39 | S VALMBCK="R"
|
|---|
| 40 | D UNCMPALL^IBDF19(IBFORM)
|
|---|
| 41 | D IDXFORM^IBDF5A()
|
|---|
| 42 | Q
|
|---|
| 43 | COPYBLK ;copies a block from another form,whether in the toolkit or not, expects IBFORM=current work form to be defined
|
|---|
| 44 | N IBBLK,TOP,BOT,NEWBLOCK
|
|---|
| 45 | S IBBLK=$$SELECT2^IBDF13("")
|
|---|
| 46 | I IBBLK S NEWBLOCK=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1,$$CURY^IBDFU4,$$CURX^IBDFU4,0,"",1) I NEWBLOCK D
|
|---|
| 47 | .D RE^VALM4
|
|---|
| 48 | .D POS^IBDFU4(NEWBLOCK)
|
|---|
| 49 | .D TOPNBOT^IBDFU5(NEWBLOCK,.TOP,.BOT)
|
|---|
| 50 | .D IDXFORM^IBDF5A(TOP,BOT)
|
|---|
| 51 | S VALMBCK="R"
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | VIEW ;toggles between viewing form with data and without data
|
|---|
| 55 | N STARTVAL
|
|---|
| 56 | S STARTVAL=IBPRINT("WITH_DATA")
|
|---|
| 57 | I 'IBPRINT("WITH_DATA") D
|
|---|
| 58 | .D FULL^VALM1
|
|---|
| 59 | .S DFN=$$PATIENT
|
|---|
| 60 | .I DFN S IBPRINT("WITH_DATA")=1 I '$G(IBAPPT) D NOW^%DTC S IBAPPT=% K %,%H,%I,X
|
|---|
| 61 | E I IBPRINT("WITH_DATA") S IBPRINT("WITH_DATA")=0
|
|---|
| 62 | ;
|
|---|
| 63 | ;this action could be called at the form level or the block level - action depends on which
|
|---|
| 64 | I '$G(IBBLK) D
|
|---|
| 65 | .I STARTVAL'=IBPRINT("WITH_DATA") D JUSTDATA^IBDF2A(IBPRINT("WITH_DATA")) K ^TMP("IB",$J,"INTERFACES")
|
|---|
| 66 | I $G(IBBLK) D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
|---|
| 67 | S VALMBCK="R"
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | PATIENT() ;asks for a patient, returns the DFN
|
|---|
| 71 | K DIR S DIR(0)="P^2:EM",DIR("A")="Test with what Patient"
|
|---|
| 72 | D ^DIR K DIR I $D(DIRUT)!(+Y<1) Q 0
|
|---|
| 73 | Q +Y
|
|---|
