IBDFUTL3 ;ALB/MAF - MAINTENANCE UTILITY CONT. - 4/24/95 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997 ; ; REPLACE ; -- Replace invalid code with another valid code... it will be in ; the same place as the old invalid code. N IBDFVALM,VALMY,IBBLK,IBDFSLC,IBDFSLC1,IBDFSLC2,IBFORM,IBGRP,IBLIST,DA,IBSEL,ORDER,IEN S VALMBCK="" D EN^VALM2($G(XQORNOD(0))) G REP:'$O(VALMY(0)) S IBDFVALM=0 D FULL^VALM1 S VALMBCK="R" F IBDFVALM=0:0 S IBDFVALM=$O(VALMY(IBDFVALM)) Q:IBDFVALM']"" S (IBDFSEL,DA)=$P($G(^TMP("CPTIDX",$J,IBDFVALM)),"^",4) I DA]"" S IBDFSLC=$G(^IBE(357.3,DA,0)),IBDFSLC1=$G(^IBE(357.3,DA,1,1,0)),IBDFSLC2=$G(^IBE(357.3,DA,1,2,0)) D .S IBFORM=$P($G(^TMP("CPTIDX",$J,IBDFVALM)),"^",5) .S IBGRP=$P(IBDFSLC,"^",4) .S IBLIST=$P(IBDFSLC,"^",3) .S ORDER=$P(IBDFSLC,"^",5) .S IBBLK=$P($G(^TMP("CPTIDX",$J,IBDFVALM)),"^",6) D REPLC(IBLIST,IBGRP,ORDER,.IBSEL,IBBLK,IBFORM) K IBDF,^TMP("UTIL",$J) D INIT^IBDFUTL S VALMBCK="R" Q ; ; REPLC(IBLIST,IBGRP,ORDER,IBSEL,IBBLK,IBFORM) ;allows the user to add a selection to the selection group for replacement - returns 0 if it was done, 1 otherwise N SUB,IBRTN ; Q:'$$FORMDSCR^IBDFU1C(.IBFORM) Q:$$BLKDESCR^IBDFU1B(.IBBLK) 1 Q:$$LSTDESCR^IBDFU1(.IBLIST) 1 S IBRTN=IBLIST("RTN") D RTNDSCR^IBDFU1B(.IBRTN) N QUIT S QUIT=0 I IBRTN("ACTION")'=3 D NOGOOD^IBDF4 Q 1 K @IBRTN("DATA_LOCATION") I '$$DORTN^IBDFU1B(.IBRTN) D NOGOOD^IBDF4 Q 1 I '$D(@IBRTN("DATA_LOCATION")) Q D ADDREC^IBDF4(.QUIT,ORDER,.IBSEL) ;edits and adds the selection K @IBRTN("DATA_LOCATION") ; -- If a selection has been chosen, the old node is killed off and ; the block/selection list is updated. I QUIT=0 S DA=IBDFSEL,DIK="^IBE(357.3," D ^DIK K DIK D BLKCHNG^IBDF19(IBFORM,IBBLK) Q REP K IBDF D INIT^IBDFUTL S VALMBG=1,VALMBCK="R" Q