| 1 | IBDF5B ;ALB/CJM - ENCOUNTER FORM (edit a form - CONTINUED);JUL 27,1993
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | EDITBLK ;allows the user to edit everything about the block
|
|---|
| 4 | ;allows user to discard or save changes to the block
|
|---|
| 5 | ;
|
|---|
| 6 | ;If IBBLK and IBBLK2 are used to point to two copies, one copy for editing and the other in case 'undo' is needed
|
|---|
| 7 | ;
|
|---|
| 8 | N IBBLK,IBVALMBG,TOP1,TOP2,BOT1,BOT2,IBBLK2,IBTKODR,IBJUNK,IFSAVE,WDATA
|
|---|
| 9 | ;N IBMEMARY
|
|---|
| 10 | ;
|
|---|
| 11 | S IBVALMBG=VALMBG
|
|---|
| 12 | D FULL^VALM1
|
|---|
| 13 | S IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL,"HEADER") ;select the block
|
|---|
| 14 | I IBBLK D
|
|---|
| 15 | .D KILL^IBDFUA
|
|---|
| 16 | .S (IBBLK2,IBTKODR,IBJUNK)=""
|
|---|
| 17 | .S WDATA=IBPRINT("WITH_DATA")
|
|---|
| 18 | .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
|
|---|
| 19 | .D TOPNBOT^IBDFU5(IBBLK,.TOP1,.BOT1)
|
|---|
| 20 | .D EN^VALM("IBDF FORM BLOCK EDIT") ;call list processor
|
|---|
| 21 | .I IBBLK,IBBLK2 D
|
|---|
| 22 | ..S IFSAVE=$$ASKSAVE
|
|---|
| 23 | ..I IFSAVE D SAVECOPY(.IBBLK,.IBBLK2,IBTKODR) S IBBLK=IBBLK2,IBBLK2=""
|
|---|
| 24 | ..I 'IFSAVE D DLTCOPY(IBBLK) S IBBLK=IBBLK2,IBBLK2=""
|
|---|
| 25 | ..L -^IBE(357.1,IBBLK):1
|
|---|
| 26 | .I '$G(IBFASTXT) D
|
|---|
| 27 | ..S VALMBG=IBVALMBG
|
|---|
| 28 | ..S IBPRINT("WITH_DATA")=WDATA
|
|---|
| 29 | ..D TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2)
|
|---|
| 30 | ..S TOP1=$S(TOP1<TOP2:TOP1,1:TOP2),BOT1=$S(BOT1>BOT2:BOT1,1:BOT2)
|
|---|
| 31 | ..D IDXFORM^IBDF5A(TOP1,BOT1)
|
|---|
| 32 | S VALMBCK="R"
|
|---|
| 33 | Q
|
|---|
| 34 | DLTCOPY(WORKCOPY) ;deletes the block=WORKCOPY and unlocks it
|
|---|
| 35 | D DLTBLK^IBDFU3(WORKCOPY,IBJUNK,357.1)
|
|---|
| 36 | L -^IBE(357.1,WORKCOPY)
|
|---|
| 37 | S WORKCOPY=""
|
|---|
| 38 | Q
|
|---|
| 39 | SAVECOPY(WORKCOPY,FORMCOPY,IBTKODR) ;deletes the block=FORMCOPY,adds WORKCOPY to IBFORM
|
|---|
| 40 | ;NOTE: upon completion WORKCOPY="",FORMCOPY points to what WORKCOPY initially did
|
|---|
| 41 | Q:('FORMCOPY)!('WORKCOPY) ;something wrong!
|
|---|
| 42 | ;
|
|---|
| 43 | K DIE,DA,DR S DIE="^IBE(357.1,",DA=WORKCOPY,DR=".02////"_IBFORM
|
|---|
| 44 | I IBTKODR S DR=DR_";.14////"_IBTKODR
|
|---|
| 45 | D ^DIE K DIE,DR,DA
|
|---|
| 46 | ;
|
|---|
| 47 | D DLTBLK^IBDFU3(FORMCOPY,IBFORM,357.1)
|
|---|
| 48 | D UNCMPL^IBDF19(IBFORM,0)
|
|---|
| 49 | L -^IBE(357.1,FORMCOPY)
|
|---|
| 50 | S FORMCOPY=WORKCOPY,WORKCOPY=""
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | COPYBLK(IBBLK,FORMCOPY,WORKCOPY,IBTKODR,IBJUNK) ;copys the IBBLK to the WORKCOPY, then puts sets FORMCOPY=IBBLK
|
|---|
| 54 | ;IBJUNK set to the form="WORKCOPY", IBTKODR set to the original value of the field TOOL KIT ORDER
|
|---|
| 55 | ;
|
|---|
| 56 | N NODE
|
|---|
| 57 | S WORKCOPY=IBBLK,FORMCOPY=""
|
|---|
| 58 | Q:'IBBLK ;no block to copy!
|
|---|
| 59 | S NODE=$G(^IBE(357.1,IBBLK,0))
|
|---|
| 60 | S IBTKODR=$P(NODE,"^",14)
|
|---|
| 61 | ;find the form=WORKCOPY, used as a work area
|
|---|
| 62 | S IBJUNK=+$O(^IBE(357,"B","WORKCOPY",""))
|
|---|
| 63 | ;copy the block
|
|---|
| 64 | S FORMCOPY=$$COPYBLK^IBDFU2(IBBLK,IBFORM,357.1,357.1)
|
|---|
| 65 | I 'FORMCOPY W !,"Unable to edit the block!" D PAUSE^IBDFU5 S FORMCOPY=IBBLK Q
|
|---|
| 66 | ;
|
|---|
| 67 | ;make sure both copies are locked
|
|---|
| 68 | ;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
|
|---|
| 69 | L +^IBE(357.1,FORMCOPY):1
|
|---|
| 70 | L +^IBE(357.1,WORKCOPY):1
|
|---|
| 71 | ;
|
|---|
| 72 | ;mark the working copy as not being in the tk and not on IBFORM
|
|---|
| 73 | K DIE,DA,DR S DIE="^IBE(357.1,",DA=WORKCOPY,DR=".02////"_IBJUNK_";.14////0"
|
|---|
| 74 | D ^DIE K DIE,DR,DA
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | ASKSAVE() ;asks the user if changes to the block should be saved
|
|---|
| 78 | ;returns 1 for yes, 0 for no
|
|---|
| 79 | K DIR S DIR(0)="Y",DIR("A")="Save changes to the block",DIR("B")="YES"
|
|---|
| 80 | D ^DIR K DIR
|
|---|
| 81 | Q:$D(DIRUT) 0
|
|---|
| 82 | Q Y
|
|---|
| 83 | DECIDE ;allows user to either save or discard changes to the block being edited
|
|---|
| 84 | N WHAT
|
|---|
| 85 | ;
|
|---|
| 86 | S WHAT=$$DOWHAT
|
|---|
| 87 | I WHAT="S" D
|
|---|
| 88 | .D SAVECOPY(.IBBLK,.IBBLK2,IBTKODR),COPYBLK(IBBLK2,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK) S VALMBCK="" I 'IBBLK S IBBLK=IBBLK2,IBBLK2="" S VALMBCK="Q"
|
|---|
| 89 | I WHAT="D" D
|
|---|
| 90 | .D DLTCOPY(IBBLK) S IBBLK=IBBLK2,IBBLK2="" D COPYBLK(IBBLK,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK)
|
|---|
| 91 | .I IBBLK S VALMBCK="R" D IDXBLOCK^IBDFU4
|
|---|
| 92 | .I 'IBBLK S IBBLK=IBBLK2,IBBLK2="",VALMBCK="Q"
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | DOWHAT() ;returns "D" for discard, "S" for save, "" for do nothing
|
|---|
| 96 | K DIR S DIR(0)="SB^S:Save Changes;D:Discard Changes;",DIR("A")="Save or Discard the recent changes to the block?"
|
|---|
| 97 | D ^DIR K DIR
|
|---|
| 98 | Q:$D(DIRUT) ""
|
|---|
| 99 | Q Y
|
|---|
| 100 | ;
|
|---|
| 101 | PRINT ;prints the form
|
|---|
| 102 | ;
|
|---|
| 103 | N QUIT S QUIT=0
|
|---|
| 104 | S VALMBCK=""
|
|---|
| 105 | I $G(IBBLK),'$G(IBTKBLK) D Q:QUIT
|
|---|
| 106 | .W !,"Before printing the form any changes you have made must be saved.",!,"Is that okay?"
|
|---|
| 107 | .K DIR S DIR(0)="Y" D ^DIR K DIR I 'Y!$D(DIRUT) S QUIT=1 QUIT
|
|---|
| 108 | .D SAVECOPY(.IBBLK,.IBBLK2,IBTKODR),COPYBLK(IBBLK2,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK) S VALMBCK="" I 'IBBLK S IBBLK=IBBLK2,IBBLK2="" S VALMBCK="Q",QUIT=1
|
|---|
| 109 | D:'QUIT PRINT^IBDF1C(.IBFORM)
|
|---|
| 110 | Q
|
|---|
