| [613] | 1 | IBDFUTL3 ;ALB/MAF - MAINTENANCE UTILITY CONT. - 4/24/95
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | REPLACE ; -- Replace invalid code with another valid code... it will be in
|
|---|
| 6 | ; the same place as the old invalid code.
|
|---|
| 7 | N IBDFVALM,VALMY,IBBLK,IBDFSLC,IBDFSLC1,IBDFSLC2,IBFORM,IBGRP,IBLIST,DA,IBSEL,ORDER,IEN
|
|---|
| 8 | S VALMBCK=""
|
|---|
| 9 | D EN^VALM2($G(XQORNOD(0))) G REP:'$O(VALMY(0)) S IBDFVALM=0
|
|---|
| 10 | D FULL^VALM1 S VALMBCK="R"
|
|---|
| 11 | 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
|
|---|
| 12 | .S IBFORM=$P($G(^TMP("CPTIDX",$J,IBDFVALM)),"^",5)
|
|---|
| 13 | .S IBGRP=$P(IBDFSLC,"^",4)
|
|---|
| 14 | .S IBLIST=$P(IBDFSLC,"^",3)
|
|---|
| 15 | .S ORDER=$P(IBDFSLC,"^",5)
|
|---|
| 16 | .S IBBLK=$P($G(^TMP("CPTIDX",$J,IBDFVALM)),"^",6)
|
|---|
| 17 | D REPLC(IBLIST,IBGRP,ORDER,.IBSEL,IBBLK,IBFORM)
|
|---|
| 18 | K IBDF,^TMP("UTIL",$J) D INIT^IBDFUTL S VALMBCK="R" Q
|
|---|
| 19 | ;
|
|---|
| 20 | ;
|
|---|
| 21 | 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
|
|---|
| 22 | N SUB,IBRTN
|
|---|
| 23 | ;
|
|---|
| 24 | Q:'$$FORMDSCR^IBDFU1C(.IBFORM)
|
|---|
| 25 | Q:$$BLKDESCR^IBDFU1B(.IBBLK) 1
|
|---|
| 26 | Q:$$LSTDESCR^IBDFU1(.IBLIST) 1
|
|---|
| 27 | S IBRTN=IBLIST("RTN")
|
|---|
| 28 | D RTNDSCR^IBDFU1B(.IBRTN)
|
|---|
| 29 | N QUIT S QUIT=0
|
|---|
| 30 | I IBRTN("ACTION")'=3 D NOGOOD^IBDF4 Q 1
|
|---|
| 31 | K @IBRTN("DATA_LOCATION")
|
|---|
| 32 | I '$$DORTN^IBDFU1B(.IBRTN) D NOGOOD^IBDF4 Q 1
|
|---|
| 33 | I '$D(@IBRTN("DATA_LOCATION")) Q
|
|---|
| 34 | D ADDREC^IBDF4(.QUIT,ORDER,.IBSEL) ;edits and adds the selection
|
|---|
| 35 | K @IBRTN("DATA_LOCATION")
|
|---|
| 36 | ; -- If a selection has been chosen, the old node is killed off and
|
|---|
| 37 | ; the block/selection list is updated.
|
|---|
| 38 | I QUIT=0 S DA=IBDFSEL,DIK="^IBE(357.3," D ^DIK K DIK D BLKCHNG^IBDF19(IBFORM,IBBLK)
|
|---|
| 39 | Q
|
|---|
| 40 | REP K IBDF D INIT^IBDFUTL S VALMBG=1,VALMBCK="R"
|
|---|
| 41 | Q
|
|---|
