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

Last change on this file since 762 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1IBDFUTL3 ;ALB/MAF - MAINTENANCE UTILITY CONT. - 4/24/95
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4 ;
5REPLACE ; -- 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 ;
21REPLC(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
40REP K IBDF D INIT^IBDFUTL S VALMBG=1,VALMBCK="R"
41 Q
Note: See TracBrowser for help on using the repository browser.