IBDF5C ;ALB/CJM - ENCOUNTER FORM (creating a new block) ;MARCH 22,1993
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
NEWBLOCK ;adds a new block, expects IBFORM to be defined
N IBBLK,TOP,BOT
S VALMBCK="R"
S IBBLK=$$CREATE()
I IBBLK D
.D TOPNBOT^IBDFU5(IBBLK,.TOP,.BOT)
.D IDXFORM^IBDF5A(TOP,BOT)
Q
CREATE() ;creates the new block and allows the user to edit it
;INPUTS: expects IBFORM to be defined
; expects IBTKBLK to be defined - IBTKBLK=1 means add to tk
;returns IBBLK
N NAME,IBBLK,NODE,IBDFDONE,IBBG,IBLFT,DLAYGO
S IBBG=1,IBLFT=5
S VALMBCK="R"
I '$G(IBTKBLK) S IBBG=+$G(VALMBG),IBLFT=+$G(VALMLFT)
S NAME=$$NEWNAME Q:NAME=-1 ""
K DIC,DIE,DD,DO,DINUM S DIC="^IBE(357.1,",DIC(0)="FL",X=NAME,DLAYGO=357.1
D FILE^DICN K DIC,DIE,DA
S IBBLK=+Y
I 'IBBLK D
.W !,"Unable to create a new block!" K DIC,DIE D PAUSE^IBDFU5
I IBBLK D
.;delete everything in the block - it should be empty
.D DLTCNTNT^IBDFU3(IBBLK,357.1)
.;set the current position of the block to the upper left-hand corner of the screen as the default
.S $P(^IBE(357.1,IBBLK,0),"^",4,5)=(IBBG-1)_"^"_(IBLFT-5)
.;now let the user edit the new block - header,name,outline,etc.
.K DIE,DA S DIE=357.1,DA=IBBLK,DR="[IBDF NEW EMPTY BLOCK]",DIE("NO^")="BACKOUTOK" D ^DIE K DIC,DIE,DR,DA
.I 'IBDFDONE S DIK="^IBE(357.1,",DA=IBBLK K DA(1) D ^DIK K DIK,DA Q
Q IBBLK
NEWNAME() ;
K DIR S DIR(0)="357.1,.01A",DIR("A")="New Block Name: ",DIR("B")=""
D ^DIR K DIR I $D(DIRUT) Q -1
Q Y
REDRAW ;redraws the ;entire form
S VALMBCK="R"
D UNCMPALL^IBDF19(IBFORM)
D IDXFORM^IBDF5A()
Q
COPYBLK ;copies a block from another form,whether in the toolkit or not, expects IBFORM=current work form to be defined
N IBBLK,TOP,BOT,NEWBLOCK
S IBBLK=$$SELECT2^IBDF13("")
I IBBLK S NEWBLOCK=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1,$$CURY^IBDFU4,$$CURX^IBDFU4,0,"",1) I NEWBLOCK D
.D RE^VALM4
.D POS^IBDFU4(NEWBLOCK)
.D TOPNBOT^IBDFU5(NEWBLOCK,.TOP,.BOT)
.D IDXFORM^IBDF5A(TOP,BOT)
S VALMBCK="R"
Q
;
VIEW ;toggles between viewing form with data and without data
N STARTVAL
S STARTVAL=IBPRINT("WITH_DATA")
I 'IBPRINT("WITH_DATA") D
.D FULL^VALM1
.S DFN=$$PATIENT
.I DFN S IBPRINT("WITH_DATA")=1 I '$G(IBAPPT) D NOW^%DTC S IBAPPT=% K %,%H,%I,X
E I IBPRINT("WITH_DATA") S IBPRINT("WITH_DATA")=0
;
;this action could be called at the form level or the block level - action depends on which
I '$G(IBBLK) D
.I STARTVAL'=IBPRINT("WITH_DATA") D JUSTDATA^IBDF2A(IBPRINT("WITH_DATA")) K ^TMP("IB",$J,"INTERFACES")
I $G(IBBLK) D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
S VALMBCK="R"
Q
;
PATIENT() ;asks for a patient, returns the DFN
K DIR S DIR(0)="P^2:EM",DIR("A")="Test with what Patient"
D ^DIR K DIR I $D(DIRUT)!(+Y<1) Q 0
Q +Y
IBDF5C ;ALB/CJM - ENCOUNTER FORM (creating a new block) ;MARCH 22,1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
NEWBLOCK ;adds a new block, expects IBFORM to be defined
+1 NEW IBBLK,TOP,BOT
+2 SET VALMBCK="R"
+3 SET IBBLK=$$CREATE()
+4 IF IBBLK
Begin DoDot:1
+5 DO TOPNBOT^IBDFU5(IBBLK,.TOP,.BOT)
+6 DO IDXFORM^IBDF5A(TOP,BOT)
End DoDot:1
+7 QUIT
CREATE() ;creates the new block and allows the user to edit it
+1 ;INPUTS: expects IBFORM to be defined
+2 ; expects IBTKBLK to be defined - IBTKBLK=1 means add to tk
+3 ;returns IBBLK
+4 NEW NAME,IBBLK,NODE,IBDFDONE,IBBG,IBLFT,DLAYGO
+5 SET IBBG=1
SET IBLFT=5
+6 SET VALMBCK="R"
+7 IF '$GET(IBTKBLK)
SET IBBG=+$GET(VALMBG)
SET IBLFT=+$GET(VALMLFT)
+8 SET NAME=$$NEWNAME
IF NAME=-1
QUIT ""
+9 KILL DIC,DIE,DD,DO,DINUM
SET DIC="^IBE(357.1,"
SET DIC(0)="FL"
SET X=NAME
SET DLAYGO=357.1
+10 DO FILE^DICN
KILL DIC,DIE,DA
+11 SET IBBLK=+Y
+12 IF 'IBBLK
Begin DoDot:1
+13 WRITE !,"Unable to create a new block!"
KILL DIC,DIE
DO PAUSE^IBDFU5
End DoDot:1
+14 IF IBBLK
Begin DoDot:1
+15 ;delete everything in the block - it should be empty
+16 DO DLTCNTNT^IBDFU3(IBBLK,357.1)
+17 ;set the current position of the block to the upper left-hand corner of the screen as the default
+18 SET $PIECE(^IBE(357.1,IBBLK,0),"^",4,5)=(IBBG-1)_"^"_(IBLFT-5)
+19 ;now let the user edit the new block - header,name,outline,etc.
+20 KILL DIE,DA
SET DIE=357.1
SET DA=IBBLK
SET DR="[IBDF NEW EMPTY BLOCK]"
SET DIE("NO^")="BACKOUTOK"
DO ^DIE
KILL DIC,DIE,DR,DA
+21 IF 'IBDFDONE
SET DIK="^IBE(357.1,"
SET DA=IBBLK
KILL DA(1)
DO ^DIK
KILL DIK,DA
QUIT
End DoDot:1
+22 QUIT IBBLK
NEWNAME() ;
+1 KILL DIR
SET DIR(0)="357.1,.01A"
SET DIR("A")="New Block Name: "
SET DIR("B")=""
+2 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT -1
+3 QUIT Y
REDRAW ;redraws the ;entire form
+1 SET VALMBCK="R"
+2 DO UNCMPALL^IBDF19(IBFORM)
+3 DO IDXFORM^IBDF5A()
+4 QUIT
COPYBLK ;copies a block from another form,whether in the toolkit or not, expects IBFORM=current work form to be defined
+1 NEW IBBLK,TOP,BOT,NEWBLOCK
+2 SET IBBLK=$$SELECT2^IBDF13("")
+3 IF IBBLK
SET NEWBLOCK=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1,$$CURY^IBDFU4,$$CURX^IBDFU4,0,"",1)
IF NEWBLOCK
Begin DoDot:1
+4 DO RE^VALM4
+5 DO POS^IBDFU4(NEWBLOCK)
+6 DO TOPNBOT^IBDFU5(NEWBLOCK,.TOP,.BOT)
+7 DO IDXFORM^IBDF5A(TOP,BOT)
End DoDot:1
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
VIEW ;toggles between viewing form with data and without data
+1 NEW STARTVAL
+2 SET STARTVAL=IBPRINT("WITH_DATA")
+3 IF 'IBPRINT("WITH_DATA")
Begin DoDot:1
+4 DO FULL^VALM1
+5 SET DFN=$$PATIENT
+6 IF DFN
SET IBPRINT("WITH_DATA")=1
IF '$GET(IBAPPT)
DO NOW^%DTC
SET IBAPPT=%
KILL %,%H,%I,X
End DoDot:1
+7 IF '$TEST
IF IBPRINT("WITH_DATA")
SET IBPRINT("WITH_DATA")=0
+8 ;
+9 ;this action could be called at the form level or the block level - action depends on which
+10 IF '$GET(IBBLK)
Begin DoDot:1
+11 IF STARTVAL'=IBPRINT("WITH_DATA")
DO JUSTDATA^IBDF2A(IBPRINT("WITH_DATA"))
KILL ^TMP("IB",$JOB,"INTERFACES")
End DoDot:1
+12 IF $GET(IBBLK)
DO UNCMPBLK^IBDF19(IBBLK)
DO IDXBLOCK^IBDFU4
+13 SET VALMBCK="R"
+14 QUIT
+15 ;
PATIENT() ;asks for a patient, returns the DFN
+1 KILL DIR
SET DIR(0)="P^2:EM"
SET DIR("A")="Test with what Patient"
+2 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(+Y<1)
QUIT 0
+3 QUIT +Y
