147 lines
4.5 KiB
Mathematica
147 lines
4.5 KiB
Mathematica
IBDF3 ;ALB/CJM - Edit Selection List ;NOV 16,1992
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;**15**;APR 24, 1997
|
|
;
|
|
EDITLIST ;expects IBBLK to be defined
|
|
N IBLIST,IBVALMBG
|
|
D FULL^VALM1
|
|
S IBVALMBG=VALMBG,VALMBCK="R"
|
|
D SELECT
|
|
I IBLIST D
|
|
.Q:$$LSTDSCR2^IBDFU1(.IBLIST)
|
|
.;I IBLIST("DYNAMIC"),$G(IBLIST("CLRM")) D SEL^IBDFN15(.IBLIST)
|
|
.I IBLIST("DYNAMIC"),'$G(IBLIST("CLRM")) W !,"You can not edit the contents of this list - it is determined at print time!" D PAUSE^IBDFU5 Q
|
|
.;I '$G(IBLIST("CLRM")) D EN^VALM("IBDF DISPLAY GROUPS FOR EDIT")
|
|
.I $G(IBLIST("CLRM")) S IBLIST("EDITING CLRM")=1
|
|
.D EN^VALM("IBDF DISPLAY GROUPS FOR EDIT")
|
|
.K IBLIST
|
|
.D UNCMPBLK^IBDF19(IBBLK)
|
|
.I '$G(IBFASTXT) D
|
|
..D IDXBLOCK^IBDFU4
|
|
..S VALMBCK="R",VALMBG=IBVALMBG
|
|
Q
|
|
ONENTRY ;
|
|
D IDXGRP
|
|
Q
|
|
ONEXIT ;
|
|
K @VALMAR
|
|
Q
|
|
SELECT ;
|
|
; -- dic("s") passed in from ibdfgrp
|
|
S IBLIST=""
|
|
Q:'$G(IBBLK)
|
|
S DIC="^IBE(357.2,",DIC(0)="EQ",D="C",X=IBBLK
|
|
D IX^DIC K DIC
|
|
S:+Y>0 IBLIST=+Y
|
|
Q
|
|
ADDBLANK() ;
|
|
N IGRP
|
|
S GRP="" F S GRP=$O(^IBE(357.4,"D",IBLIST,GRP)) Q:'GRP Q:$P(^IBE(357.4,GRP,0),"^")="BLANK"
|
|
I 'GRP D
|
|
.K DIC,DD,DO,DINUM S DIC="^IBE(357.4,",DIC(0)="",X="BLANK",DIC(0)=""
|
|
.D FILE^DICN K DIC
|
|
.S GRP=$S(+Y<0:"",1:+Y)
|
|
I GRP K DA,DIE S DA=GRP,DIE="^IBE(357.4,",DR=".02////0;.03////"_IBLIST D ^DIE K DIE,DA,DR
|
|
Q GRP
|
|
IDXGRP ;build an index of groups in print order for list processor
|
|
N GRP,GRPODR
|
|
K @VALMAR
|
|
S VALMCNT=0
|
|
S GRPODR="" F S GRPODR=$O(^IBE(357.4,"APO",IBLIST,GRPODR)) Q:GRPODR="" D
|
|
.S GRP="" F S GRP=$O(^IBE(357.4,"APO",IBLIST,GRPODR,GRP)) Q:'GRP D
|
|
..;
|
|
..;make sure the index is correct
|
|
..I $P($G(^IBE(357.4,GRP,0)),"^",3)'=IBLIST K DIK,DA S DIK="^IBE(357.4,",DA=GRP D IX^DIK K DIK,DA,^IBE(357.4,"APO",IBLIST,GRPODR,GRP) Q
|
|
..;
|
|
..S VALMCNT=VALMCNT+1
|
|
..S @VALMAR@(VALMCNT,0)=$$DISPLAY(GRP,VALMCNT),@VALMAR@("IDX",VALMCNT,VALMCNT)=GRP
|
|
..D FLDCTRL^VALM10(VALMCNT,"ID") ;set video for ID column
|
|
Q
|
|
LMGRPHDR ;sets the screen hdr
|
|
S VALMHDR(1)="PRINT GROUPS CURRENTLY DEFINED FOR '"_$$LISTNAME_"' SELECTION LIST"
|
|
Q
|
|
DISPLAY(GRP,ROW) ;
|
|
N NODE0,NAME,INV
|
|
S NODE0=$G(^IBE(357.4,GRP,0)),NAME=$P(NODE0,"^"),INV=$P(NODE0,"^",4)
|
|
I NAME="BLANK" S NAME="*i BLANK (Not Displayed)"
|
|
I NAME'="BLANK",INV="I" S NAME="*i "_NAME
|
|
I NAME'="BLANK",INV'="I" S NAME=" "_NAME
|
|
Q $$PADRIGHT^IBDFU(ROW,6)_$J($P(NODE0,"^",2),6)_$J("",3)_$$PADRIGHT^IBDFU(NAME,40)_$J($$SLCTNCNT(GRP),6)_" selection(s)"
|
|
SLCTNCNT(GRP) ;
|
|
N CNT,SLCTN
|
|
S CNT=0,SLCTN=""
|
|
F S SLCTN=$O(^IBE(357.3,"D",GRP,SLCTN)) Q:'SLCTN S CNT=CNT+1
|
|
Q CNT
|
|
LISTNAME() ;
|
|
Q $P($G(^IBE(357.2,IBLIST,0)),"^",1)
|
|
ADDGRP ;
|
|
N NAME,QUIT,GRP
|
|
S QUIT=0
|
|
F D Q:QUIT
|
|
.K DIR S DIR(0)="357.4,.01O",DIR("B")="" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q
|
|
.S NAME=Y
|
|
.K DIC,DD,DO,DINUM S DIC="^IBE(357.4,",X=NAME,DIC(0)=""
|
|
.D FILE^DICN K DIC,DIE,DA
|
|
.I +Y<0 W !,"Unable to create a new record!" D PAUSE^VALM1 S QUIT=1 Q
|
|
.I +Y>0 K DA S DA=+Y,DIE="^IBE(357.4,",DIE("NO^")="Any value",DR=".02;.04;.03////"_IBLIST D ^DIE K DIC,DIE,DR,DA
|
|
.W !,"Now Another!",!
|
|
D IDXGRP
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
ADDEMPTY ;adds a blank group - a place holder that takes up space on the form
|
|
;
|
|
N ORDER,QUIT,GRP
|
|
S QUIT=0
|
|
F D Q:QUIT
|
|
.K DIR S DIR(0)="357.4,.02O",DIR("B")="" D ^DIR K DIR I (Y="")!$D(DIRUT) S QUIT=1 Q
|
|
.S ORDER=Y
|
|
.K DIC,DD,DO,DINUM S DIC="^IBE(357.4,",X=" ",DIC(0)=""
|
|
.D FILE^DICN K DIC,DIE,DA
|
|
.I +Y<0 W !,"Unable to create a new group record!" D PAUSE^VALM1 S QUIT=1 Q
|
|
.I +Y>0 K DA S DA=+Y,DIE="^IBE(357.4,",DIE("NO^")="Any value",DR=".02////"_ORDER_";.03////"_IBLIST D ^DIE K DIC,DIE,DR,DA
|
|
.W !,"Now Another!",!
|
|
D IDXGRP
|
|
S VALMBCK="R"
|
|
Q
|
|
EDTSLCTN ;
|
|
N SEL,IBGRP S SEL=""
|
|
I $G(VALMCNT) D
|
|
.D EN^VALM2($G(XQORNOD(0)),"S")
|
|
.S SEL=$O(VALMY(""))
|
|
I SEL="" D
|
|
.S IBGRP=$$ADDBLANK Q:'IBGRP
|
|
E S IBGRP=$G(@VALMAR@("IDX",SEL,SEL))
|
|
D:IBGRP SLCTNS^IBDF4,IDXGRP
|
|
S VALMBCK="R"
|
|
Q
|
|
EDITGRP ;
|
|
N SEL,GRP
|
|
S VALMBCK="R"
|
|
D EN^VALM2($G(XQORNOD(0)),"S")
|
|
S SEL="" F S SEL=$O(VALMY(SEL)) Q:'SEL D
|
|
.S GRP=$G(@VALMAR@("IDX",SEL,SEL))
|
|
.D:GRP
|
|
..K DIE,DA S DIE=357.4,DA=GRP,DR=".01;.02;.04" D ^DIE
|
|
..I '$D(DA) D DELSLCTN
|
|
..K DIE,DA,DR,DIC
|
|
D IDXGRP
|
|
S VALMBCK="R"
|
|
Q
|
|
DELSLCTN ;deletes a group's selections
|
|
N SLCTN
|
|
S SLCTN="",DIK="^IBE(357.3,"
|
|
F S SLCTN=$O(^IBE(357.3,"D",GRP,SLCTN)) Q:'SLCTN I $P($G(^IBE(357.3,SLCTN,0)),"^",4)=GRP K DA S DA=SLCTN D ^DIK
|
|
K DIK,DA
|
|
Q
|
|
DELGRP ;delete a group and all of its selections
|
|
N SEL,GRP
|
|
S VALMBCK="R"
|
|
D EN^VALM2($G(XQORNOD(0)))
|
|
S SEL="" F S SEL=$O(VALMY(SEL)) Q:'SEL D
|
|
.S GRP=$G(@VALMAR@("IDX",SEL,SEL))
|
|
.Q:'$$RUSURE^IBDFU5($P($G(^IBE(357.4,GRP,0)),"^"))
|
|
.I GRP D DELSLCTN K DA S DIK="^IBE(357.4,",DA=GRP D ^DIK K DIK
|
|
D IDXGRP
|
|
S VALMBCK="R"
|
|
Q
|