IBDFQSL ;ALB/CJM/AAS/MAF - ENCOUNTER FORM - Quick selection edit ;06/12/95
;;3.0;AUTOMATED INFO COLLECTION SYS;**63**;APR 24, 1997;Build 80
;
;
;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 in case '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)
.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)
K ^TMP("IBDF DELETE SELECTION OPTION",$J),^TMP("IBDF DELETED ALL SELECTIONS",$J),^TMP("IBDF ADDSLCTN",$J)
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFQSL 1952 printed Nov 22, 2024@18:03:24 Page 2
IBDFQSL ;ALB/CJM/AAS/MAF - ENCOUNTER FORM - Quick selection edit ;06/12/95
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**63**;APR 24, 1997;Build 80
+2 ;
+3 ;
+4 ;allows user to select a form, then displays it for edit
+5 NEW IBFORM,ARY,DFN,IBAPPT,RTNLIST,IBPRINT
+6 SET ARY="^TMP(""IBDF"",$J,""TEMPORARY CLINIC LIST"")"
+7 ;
+8 KILL @ARY
+9 SET VALMBCK=""
+10 IF $GET(IBAPI("SELECT"))'=""
XECUTE IBAPI("SELECT")
+11 KILL ARY
+12 IF IBFORM
IF '$$LOCKFRM2^IBDFU7(IBFORM)
DO LOCKMSG2^IBDFU7(IBFORM)
SET IBFORM=""
+13 IF IBFORM
DO PRNTPRMS^IBDFU1C(.IBPRINT,0,1,0,1)
DO UNCMPL^IBDF19(IBFORM,0)
+14 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 in case '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
+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 KILL ^TMP("IBDF DELETE SELECTION OPTION",$JOB),^TMP("IBDF DELETED ALL SELECTIONS",$JOB),^TMP("IBDF ADDSLCTN",$JOB)
+28 SET VALMBCK="R"
+29 QUIT
+30 ;
