72 lines
2.5 KiB
Mathematica
72 lines
2.5 KiB
Mathematica
|
IBDF9B3 ;ALB/CJM - ENCOUNTER FORM - (edit,delete,add data fields) ;FEB 1,1993
|
||
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
||
|
|
;
|
||
|
|
LABELS ;Create, Edit, or Delete LABELS from the form
|
||
|
|
I Y="I" D LABELS^IBDF9B3 Q
|
||
|
|
;
|
||
|
|
N IBVALMBG,QUIT
|
||
|
|
S QUIT=0
|
||
|
|
S IBVALMBG=VALMBG
|
||
|
|
S VALMBCK="R"
|
||
|
|
;
|
||
|
|
F D Q:QUIT
|
||
|
|
.D FULL^VALM1
|
||
|
|
.K DIR S DIR("?",1)="You can Create, Edit, or Delete labels, Shift all of the labels AND data",DIR("?")="fields within a range up or down."
|
||
|
|
.W !!,DIR("?",1),!,DIR("?"),!
|
||
|
|
.S DIR("B")="C",DIR(0)="SB^C:Create;E:Edit;D:Delete;S:Shift;Q:Quit",DIR("A")="[C]reate, [D]elete, [E]dit, [S]hift, [Q]uit"
|
||
|
|
.D ^DIR K DIR I $D(DIRUT)!(Y<0) S QUIT=1 Q
|
||
|
|
.I Y="Q" S QUIT=1 Q
|
||
|
|
.D @$S(Y="C":"NEWFLD",Y="E":"EDITFLD",Y="D":"DLTFLD",Y="S":"SHIFT",1:"")
|
||
|
|
.D RE^VALM4
|
||
|
|
S VALMBCK="R",VALMBG=IBVALMBG
|
||
|
|
Q
|
||
|
|
SHIFT ;expects IBBLK to be defined - shifts all fields within range supplied by user
|
||
|
|
D SHIFT^IBDF10("D")
|
||
|
|
D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
||
|
|
Q
|
||
|
|
EDITFLD ;expects IBBLK to be defined
|
||
|
|
N IBFIELD,NOD
|
||
|
|
N IBI,IBOLD,IBX,IBY,IBW,IBDELETE ;these are used in the input template
|
||
|
|
D SELECT
|
||
|
|
I IBFIELD D
|
||
|
|
.D RE^VALM4
|
||
|
|
.S IBOLD=1,(IBX,IBY)=""
|
||
|
|
.K DR,DIE,DA S DIE=357.5,DA=IBFIELD,DR="[IBDF EDIT LABEL FIELD]",DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DR,DA
|
||
|
|
.D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
||
|
|
Q
|
||
|
|
SELECT ;
|
||
|
|
S IBFIELD=0
|
||
|
|
Q:'$G(IBBLK)
|
||
|
|
I '$O(^IBE(357.5,"C",IBBLK,0)) W !,"There is no label only field!" D PAUSE^IBDFU5 Q
|
||
|
|
AGAIN K DIC S DIC="^IBE(357.5,",DIC(0)="EFQ",DIC("B")="",D="C",X=IBBLK
|
||
|
|
S DIC("S")="I $P(^(0),U,2)=IBBLK,+$P(^(0),U,3)=0"
|
||
|
|
D IX^DIC K DIC
|
||
|
|
S:+Y>0 IBFIELD=+Y
|
||
|
|
I 'IBFIELD,'$D(DTOUT),'$D(DUOUT) K DIR S DIR(0)="Y",DIR("A")="No label selected! Try again",DIR("B")="YES" D ^DIR K DIR I '$D(DIRUT),Y=1 G AGAIN
|
||
|
|
Q
|
||
|
|
DLTFLD ;expects IBBLK to be defined
|
||
|
|
N IBFIELD
|
||
|
|
D SELECT
|
||
|
|
I IBFIELD D
|
||
|
|
.Q:'$$RUSURE^IBDFU5($P($G(^IBE(357.5,IBFIELD,0)),"^"))
|
||
|
|
.D DLTFLD^IBDFU3(357.5,IBBLK,IBFIELD)
|
||
|
|
.D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
||
|
|
Q
|
||
|
|
NEWFLD ;adds a new field, expects IBBLK to be defined
|
||
|
|
N NAME,FIELD,NODE,IBRTN,DLAYGO
|
||
|
|
N IBX,IBY,IBW,IBDELETE,IBOLD ;these are used in the input template
|
||
|
|
S NAME=$$NEWNAME^IBDF9B Q:NAME=-1
|
||
|
|
S IBOLD=0,(IBX,IBY)=""
|
||
|
|
K DIC,DIE,DD,DO,DINUM S DIC="^IBE(357.5,",DIC(0)="FL",X=NAME,DLAYGO=357.5
|
||
|
|
D FILE^DICN K DIC,DIE,DA
|
||
|
|
S FIELD=$S(+Y<0:"",1:+Y)
|
||
|
|
I 'FIELD D
|
||
|
|
.W !,"Unable to create a new label!" D PAUSE^IBDFU5
|
||
|
|
I FIELD D
|
||
|
|
.S IBDELETE=1
|
||
|
|
.D RE^VALM4
|
||
|
|
.K DIE,DA,DR S DIE=357.5,DA=FIELD,DR="[IBDF EDIT LABEL FIELD]",DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DR,DA,DIC
|
||
|
|
.I IBDELETE K DA S DIK="^IBE(357.5,",DA=FIELD D ^DIK K DIK,DA Q
|
||
|
|
.D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
||
|
|
Q
|