IBDF5B.m

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