IBDF5B ;ALB/CJM - ENCOUNTER FORM (edit a form - CONTINUED);JUL 27,1993
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
EDITBLK ;allows the user to edit everything about the block
;allows user to discard or save changes to the block
;
;If IBBLK and IBBLK2 are used to point to two copies, one copy for editing and the other in case 'undo' is needed
;
N IBBLK,IBVALMBG,TOP1,TOP2,BOT1,BOT2,IBBLK2,IBTKODR,IBJUNK,IFSAVE,WDATA
;N IBMEMARY
;
S IBVALMBG=VALMBG
D FULL^VALM1
S IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL,"HEADER") ;select the block
I IBBLK D
.D KILL^IBDFUA
.S (IBBLK2,IBTKODR,IBJUNK)=""
.S WDATA=IBPRINT("WITH_DATA")
.D COPYBLK(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 TOPNBOT^IBDFU5(IBBLK,.TOP1,.BOT1)
.D EN^VALM("IBDF FORM BLOCK EDIT") ;call list processor
.I IBBLK,IBBLK2 D
..S IFSAVE=$$ASKSAVE
..I IFSAVE D SAVECOPY(.IBBLK,.IBBLK2,IBTKODR) S IBBLK=IBBLK2,IBBLK2=""
..I 'IFSAVE D DLTCOPY(IBBLK) S IBBLK=IBBLK2,IBBLK2=""
..L -^IBE(357.1,IBBLK):1
.I '$G(IBFASTXT) D
..S VALMBG=IBVALMBG
..S IBPRINT("WITH_DATA")=WDATA
..D TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2)
..S TOP1=$S(TOP1<TOP2:TOP1,1:TOP2),BOT1=$S(BOT1>BOT2:BOT1,1:BOT2)
..D IDXFORM^IBDF5A(TOP1,BOT1)
S VALMBCK="R"
Q
DLTCOPY(WORKCOPY) ;deletes the block=WORKCOPY and unlocks it
D DLTBLK^IBDFU3(WORKCOPY,IBJUNK,357.1)
L -^IBE(357.1,WORKCOPY)
S WORKCOPY=""
Q
SAVECOPY(WORKCOPY,FORMCOPY,IBTKODR) ;deletes the block=FORMCOPY,adds WORKCOPY to IBFORM
;NOTE: upon completion WORKCOPY="",FORMCOPY points to what WORKCOPY initially did
Q:('FORMCOPY)!('WORKCOPY) ;something wrong!
;
K DIE,DA,DR S DIE="^IBE(357.1,",DA=WORKCOPY,DR=".02////"_IBFORM
I IBTKODR S DR=DR_";.14////"_IBTKODR
D ^DIE K DIE,DR,DA
;
D DLTBLK^IBDFU3(FORMCOPY,IBFORM,357.1)
D UNCMPL^IBDF19(IBFORM,0)
L -^IBE(357.1,FORMCOPY)
S FORMCOPY=WORKCOPY,WORKCOPY=""
Q
;
COPYBLK(IBBLK,FORMCOPY,WORKCOPY,IBTKODR,IBJUNK) ;copys the IBBLK to the WORKCOPY, then puts sets FORMCOPY=IBBLK
;IBJUNK set to the form="WORKCOPY", IBTKODR set to the original value of the field TOOL KIT ORDER
;
N NODE
S WORKCOPY=IBBLK,FORMCOPY=""
Q:'IBBLK ;no block to copy!
S NODE=$G(^IBE(357.1,IBBLK,0))
S IBTKODR=$P(NODE,"^",14)
;find the form=WORKCOPY, used as a work area
S IBJUNK=+$O(^IBE(357,"B","WORKCOPY",""))
;copy the block
S FORMCOPY=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1)
I 'FORMCOPY W !,"Unable to edit the block!" D PAUSE^IBDFU5 S FORMCOPY=IBBLK Q
;
;make sure both copies are locked
;the working copy on IBJUNK is locked so that the option does cleanup knows which blocks are in current use - others on IBJUNK can be deleted
L +^IBE(357.1,FORMCOPY):1
L +^IBE(357.1,WORKCOPY):1
;
;mark the working copy as not being in the tk and not on IBFORM
K DIE,DA,DR S DIE="^IBE(357.1,",DA=WORKCOPY,DR=".02////"_IBJUNK_";.14////0"
D ^DIE K DIE,DR,DA
Q
;
ASKSAVE() ;asks the user if changes to the block should be saved
;returns 1 for yes, 0 for no
K DIR S DIR(0)="Y",DIR("A")="Save changes to the block",DIR("B")="YES"
D ^DIR K DIR
Q:$D(DIRUT) 0
Q Y
DECIDE ;allows user to either save or discard changes to the block being edited
N WHAT
;
S WHAT=$$DOWHAT
I WHAT="S" D
.D SAVECOPY(.IBBLK,.IBBLK2,IBTKODR),COPYBLK(IBBLK2,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK) S VALMBCK="" I 'IBBLK S IBBLK=IBBLK2,IBBLK2="" S VALMBCK="Q"
I WHAT="D" D
.D DLTCOPY(IBBLK) S IBBLK=IBBLK2,IBBLK2="" D COPYBLK(IBBLK,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK)
.I IBBLK S VALMBCK="R" D IDXBLOCK^IBDFU4
.I 'IBBLK S IBBLK=IBBLK2,IBBLK2="",VALMBCK="Q"
Q
;
DOWHAT() ;returns "D" for discard, "S" for save, "" for do nothing
K DIR S DIR(0)="SB^S:Save Changes;D:Discard Changes;",DIR("A")="Save or Discard the recent changes to the block?"
D ^DIR K DIR
Q:$D(DIRUT) ""
Q Y
;
PRINT ;prints the form
;
N QUIT S QUIT=0
S VALMBCK=""
I $G(IBBLK),'$G(IBTKBLK) D Q:QUIT
.W !,"Before printing the form any changes you have made must be saved.",!,"Is that okay?"
.K DIR S DIR(0)="Y" D ^DIR K DIR I 'Y!$D(DIRUT) S QUIT=1 QUIT
.D SAVECOPY(.IBBLK,.IBBLK2,IBTKODR),COPYBLK(IBBLK2,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK) S VALMBCK="" I 'IBBLK S IBBLK=IBBLK2,IBBLK2="" S VALMBCK="Q",QUIT=1
D:'QUIT PRINT^IBDF1C(.IBFORM)
Q
IBDF5B ;ALB/CJM - ENCOUNTER FORM (edit a form - CONTINUED);JUL 27,1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
EDITBLK ;allows the user to edit everything about the block
+1 ;allows user to discard or save changes to the block
+2 ;
+3 ;If IBBLK and IBBLK2 are used to point to two copies, one copy for editing and the other in case 'undo' is needed
+4 ;
+5 NEW IBBLK,IBVALMBG,TOP1,TOP2,BOT1,BOT2,IBBLK2,IBTKODR,IBJUNK,IFSAVE,WDATA
+6 ;N IBMEMARY
+7 ;
+8 SET IBVALMBG=VALMBG
+9 DO FULL^VALM1
+10 ;select the block
SET IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL,"HEADER")
+11 IF IBBLK
Begin DoDot:1
+12 DO KILL^IBDFUA
+13 SET (IBBLK2,IBTKODR,IBJUNK)=""
+14 SET WDATA=IBPRINT("WITH_DATA")
+15 ;sets IBBLK to the work copy, IBBLK2 to the copy actually on the form
DO COPYBLK(IBBLK,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK)
IF 'IBBLK
SET IBBLK=IBBLK2
SET IBBLK2=""
QUIT
+16 DO TOPNBOT^IBDFU5(IBBLK,.TOP1,.BOT1)
+17 ;call list processor
DO EN^VALM("IBDF FORM BLOCK EDIT")
+18 IF IBBLK
IF IBBLK2
Begin DoDot:2
+19 SET IFSAVE=$$ASKSAVE
+20 IF IFSAVE
DO SAVECOPY(.IBBLK,.IBBLK2,IBTKODR)
SET IBBLK=IBBLK2
SET IBBLK2=""
+21 IF 'IFSAVE
DO DLTCOPY(IBBLK)
SET IBBLK=IBBLK2
SET IBBLK2=""
+22 LOCK -^IBE(357.1,IBBLK):1
End DoDot:2
+23 IF '$GET(IBFASTXT)
Begin DoDot:2
+24 SET VALMBG=IBVALMBG
+25 SET IBPRINT("WITH_DATA")=WDATA
+26 DO TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2)
+27 SET TOP1=$SELECT(TOP1<TOP2:TOP1,1:TOP2)
SET BOT1=$SELECT(BOT1>BOT2:BOT1,1:BOT2)
+28 DO IDXFORM^IBDF5A(TOP1,BOT1)
End DoDot:2
End DoDot:1
+29 SET VALMBCK="R"
+30 QUIT
DLTCOPY(WORKCOPY) ;deletes the block=WORKCOPY and unlocks it
+1 DO DLTBLK^IBDFU3(WORKCOPY,IBJUNK,357.1)
+2 LOCK -^IBE(357.1,WORKCOPY)
+3 SET WORKCOPY=""
+4 QUIT
SAVECOPY(WORKCOPY,FORMCOPY,IBTKODR) ;deletes the block=FORMCOPY,adds WORKCOPY to IBFORM
+1 ;NOTE: upon completion WORKCOPY="",FORMCOPY points to what WORKCOPY initially did
+2 ;something wrong!
IF ('FORMCOPY)!('WORKCOPY)
QUIT
+3 ;
+4 KILL DIE,DA,DR
SET DIE="^IBE(357.1,"
SET DA=WORKCOPY
SET DR=".02////"_IBFORM
+5 IF IBTKODR
SET DR=DR_";.14////"_IBTKODR
+6 DO ^DIE
KILL DIE,DR,DA
+7 ;
+8 DO DLTBLK^IBDFU3(FORMCOPY,IBFORM,357.1)
+9 DO UNCMPL^IBDF19(IBFORM,0)
+10 LOCK -^IBE(357.1,FORMCOPY)
+11 SET FORMCOPY=WORKCOPY
SET WORKCOPY=""
+12 QUIT
+13 ;
COPYBLK(IBBLK,FORMCOPY,WORKCOPY,IBTKODR,IBJUNK) ;copys the IBBLK to the WORKCOPY, then puts sets FORMCOPY=IBBLK
+1 ;IBJUNK set to the form="WORKCOPY", IBTKODR set to the original value of the field TOOL KIT ORDER
+2 ;
+3 NEW NODE
+4 SET WORKCOPY=IBBLK
SET FORMCOPY=""
+5 ;no block to copy!
IF 'IBBLK
QUIT
+6 SET NODE=$GET(^IBE(357.1,IBBLK,0))
+7 SET IBTKODR=$PIECE(NODE,"^",14)
+8 ;find the form=WORKCOPY, used as a work area
+9 SET IBJUNK=+$ORDER(^IBE(357,"B","WORKCOPY",""))
+10 ;copy the block
+11 SET FORMCOPY=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1)
+12 IF 'FORMCOPY
WRITE !,"Unable to edit the block!"
DO PAUSE^IBDFU5
SET FORMCOPY=IBBLK
QUIT
+13 ;
+14 ;make sure both copies are locked
+15 ;the working copy on IBJUNK is locked so that the option does cleanup knows which blocks are in current use - others on IBJUNK can be deleted
+16 LOCK +^IBE(357.1,FORMCOPY):1
+17 LOCK +^IBE(357.1,WORKCOPY):1
+18 ;
+19 ;mark the working copy as not being in the tk and not on IBFORM
+20 KILL DIE,DA,DR
SET DIE="^IBE(357.1,"
SET DA=WORKCOPY
SET DR=".02////"_IBJUNK_";.14////0"
+21 DO ^DIE
KILL DIE,DR,DA
+22 QUIT
+23 ;
ASKSAVE() ;asks the user if changes to the block should be saved
+1 ;returns 1 for yes, 0 for no
+2 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Save changes to the block"
SET DIR("B")="YES"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT 0
+5 QUIT Y
DECIDE ;allows user to either save or discard changes to the block being edited
+1 NEW WHAT
+2 ;
+3 SET WHAT=$$DOWHAT
+4 IF WHAT="S"
Begin DoDot:1
+5 DO SAVECOPY(.IBBLK,.IBBLK2,IBTKODR)
DO COPYBLK(IBBLK2,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK)
SET VALMBCK=""
IF 'IBBLK
SET IBBLK=IBBLK2
SET IBBLK2=""
SET VALMBCK="Q"
End DoDot:1
+6 IF WHAT="D"
Begin DoDot:1
+7 DO DLTCOPY(IBBLK)
SET IBBLK=IBBLK2
SET IBBLK2=""
DO COPYBLK(IBBLK,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK)
+8 IF IBBLK
SET VALMBCK="R"
DO IDXBLOCK^IBDFU4
+9 IF 'IBBLK
SET IBBLK=IBBLK2
SET IBBLK2=""
SET VALMBCK="Q"
End DoDot:1
+10 QUIT
+11 ;
DOWHAT() ;returns "D" for discard, "S" for save, "" for do nothing
+1 KILL DIR
SET DIR(0)="SB^S:Save Changes;D:Discard Changes;"
SET DIR("A")="Save or Discard the recent changes to the block?"
+2 DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT ""
+4 QUIT Y
+5 ;
PRINT ;prints the form
+1 ;
+2 NEW QUIT
SET QUIT=0
+3 SET VALMBCK=""
+4 IF $GET(IBBLK)
IF '$GET(IBTKBLK)
Begin DoDot:1
+5 WRITE !,"Before printing the form any changes you have made must be saved.",!,"Is that okay?"
+6 KILL DIR
SET DIR(0)="Y"
DO ^DIR
KILL DIR
IF 'Y!$DATA(DIRUT)
SET QUIT=1
QUIT
+7 DO SAVECOPY(.IBBLK,.IBBLK2,IBTKODR)
DO COPYBLK(IBBLK2,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK)
SET VALMBCK=""
IF 'IBBLK
SET IBBLK=IBBLK2
SET IBBLK2=""
SET VALMBCK="Q"
SET QUIT=1
End DoDot:1
IF QUIT
QUIT
+8 IF 'QUIT
DO PRINT^IBDF1C(.IBFORM)
+9 QUIT
