source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF5B.m@ 1423

Last change on this file since 1423 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1IBDF5B ;ALB/CJM - ENCOUNTER FORM (edit a form - CONTINUED);JUL 27,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3EDITBLK ;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
34DLTCOPY(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
39SAVECOPY(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 ;
53COPYBLK(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 ;
77ASKSAVE() ;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
83DECIDE ;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 ;
95DOWHAT() ;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 ;
101PRINT ;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
Note: See TracBrowser for help on using the repository browser.