source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFUTL3.m@ 1000

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