IBDFQSL.m

IBDFQSL ;ALB/CJM/AAS/MAF - ENCOUNTER FORM - Quick selection edit ;12-Jun-95

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 ;allows user to select a form, then displays it for edit

 N IBFORM,ARY,DFN,IBAPPT,RTNLIST,IBPRINT

 S ARY="^TMP(""IBDF"",$J,""TEMPORARY CLINIC LIST"")"

 ;

 K @ARY

 S VALMBCK=""

 I $G(IBAPI("SELECT"))'="" X IBAPI("SELECT")

 K ARY

 I IBFORM,'$$LOCKFRM2^IBDFU7(IBFORM) D LOCKMSG2^IBDFU7(IBFORM) S IBFORM=""

 I IBFORM D PRNTPRMS^IBDFU1C(.IBPRINT,0,1,0,1),UNCMPL^IBDF19(IBFORM,0)

 Q:'$$FORMDSCR^IBDFU1C(.IBFORM)

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 incase 'undo' is needed

 ; 

 N IBBLK,IBVALMBG,TOP1,TOP2,BOT1,BOT2,IBBLK2,IBTKODR,IBJUNK,IFSAVE

 ;

 S IBVALMBG=VALMBG

 D FULL^VALM1

 S IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL,"HEADER") ;select the block

 I IBBLK S IBLIST=$O(^IBE(357.2,"C",IBBLK,0)) D

 .I 'IBLIST W !!,"Block does not contain a list!  Try Again.",! D PAUSE^IBDFU5 Q

 .D KILL^IBDFUA

 .Q:$$BLKDESCR^IBDFU1B(.IBBLK) 1

 .S (IBBLK2,IBTKODR,IBJUNK)=""

 .D COPYBLK^IBDF5B(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^IBDFQSL1

 .I IBBLK,IBBLK2 D

 ..S IFSAVE=$$ASKSAVE^IBDF5B

 ..I IFSAVE D SAVECOPY^IBDF5B(.IBBLK,.IBBLK2,IBTKODR) S IBBLK=IBBLK2,IBBLK2="" D BLKCHNG^IBDF19(IBFORM,IBBLK)

 ..I 'IFSAVE D DLTCOPY^IBDF5B(IBBLK) S IBBLK=IBBLK2,IBBLK2=""

 ..L -^IBE(357.1,IBBLK):1

 .I '$G(IBFASTXT) D

 ..S VALMBG=IBVALMBG

 ..D TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2)

 ..S TOP1=$S(TOP1<TOP2:TOP1,1:TOP2),BOT1=$S(BOT1>BOT2:BOT1,1:BOT2)

 S VALMBCK="R"

 Q

 ;

IBDFQSL   ;ALB/CJM/AAS/MAF - ENCOUNTER FORM - Quick selection edit ;12-Jun-95

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;allows user to select a form, then displays it for edit

 +3        NEW IBFORM,ARY,DFN,IBAPPT,RTNLIST,IBPRINT

 +4        SET ARY="^TMP(""IBDF"",$J,""TEMPORARY CLINIC LIST"")"

 +5       ;

 +6        KILL @ARY

 +7        SET VALMBCK=""

 +8        IF $GET(IBAPI("SELECT"))'=""

               XECUTE IBAPI("SELECT")

 +9        KILL ARY

 +10       IF IBFORM

               IF '$$LOCKFRM2^IBDFU7(IBFORM)

                   DO LOCKMSG2^IBDFU7(IBFORM)

                   SET IBFORM=""

 +11       IF IBFORM

               DO PRNTPRMS^IBDFU1C(.IBPRINT,0,1,0,1)

               DO UNCMPL^IBDF19(IBFORM,0)

 +12       IF '$$FORMDSCR^IBDFU1C(.IBFORM)

               QUIT 

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 incase 'undo' is needed

 +4       ; 

 +5        NEW IBBLK,IBVALMBG,TOP1,TOP2,BOT1,BOT2,IBBLK2,IBTKODR,IBJUNK,IFSAVE

 +6       ;

 +7        SET IBVALMBG=VALMBG

 +8        DO FULL^VALM1

 +9       ;select the block

           SET IBBLK=$$SLCTBLK^IBDFU8(IBFORM,IOSL,"HEADER")

 +10       IF IBBLK

               SET IBLIST=$ORDER(^IBE(357.2,"C",IBBLK,0))

               Begin DoDot:1

 +11               IF 'IBLIST

                       WRITE !!,"Block does not contain a list!  Try Again.",!

                       DO PAUSE^IBDFU5

                       QUIT 

 +12               DO KILL^IBDFUA

 +13               IF $$BLKDESCR^IBDFU1B(.IBBLK)

                       QUIT 1

 +14               SET (IBBLK2,IBTKODR,IBJUNK)=""

 +15      ;sets IBBLK to the work copy, IBBLK2 to the copy actually on the form

                   DO COPYBLK^IBDF5B(IBBLK,.IBBLK2,.IBBLK,.IBTKODR,.IBJUNK)

                   IF 'IBBLK

                       SET IBBLK=IBBLK2

                       SET IBBLK2=""

                       QUIT 

 +16               DO TOPNBOT^IBDFU5(IBBLK,.TOP1,.BOT1)

 +17               DO EN^IBDFQSL1

 +18               IF IBBLK

                       IF IBBLK2

                           Begin DoDot:2

 +19                           SET IFSAVE=$$ASKSAVE^IBDF5B

 +20                           IF IFSAVE

                                   DO SAVECOPY^IBDF5B(.IBBLK,.IBBLK2,IBTKODR)

                                   SET IBBLK=IBBLK2

                                   SET IBBLK2=""

                                   DO BLKCHNG^IBDF19(IBFORM,IBBLK)

 +21                           IF 'IFSAVE

                                   DO DLTCOPY^IBDF5B(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                       DO TOPNBOT^IBDFU5(IBBLK,.TOP2,.BOT2)

 +26                       SET TOP1=$SELECT(TOP1<TOP2:TOP1,1:TOP2)

                           SET BOT1=$SELECT(BOT1>BOT2:BOT1,1:BOT2)

                       End DoDot:2

               End DoDot:1

 +27       SET VALMBCK="R"

 +28       QUIT 

 +29      ;