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

IBDF9D ;ALB/CJM - ENCOUNTER FORM (create/edit/delete lines);MARCH 20, 1993
 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
LINE ;Create, Edit, or Delete a line on the block
 S VALMBCK="R"
 K DIR S DIR("?",1)="You can add vertical or horizontal lines to the block, or edit or delete",DIR("?")="a line already there IF it was created through this action."
 S DIR("B")="C",DIR(0)="SB^C:Create;E:Edit;D:Delete",DIR("A")="[C]reate , [D]elete, or [E]dit a line"
 D ^DIR K DIR I $D(DIRUT)!(Y<0) Q
 D @$S(Y="C":"NEWLINE",Y="E":"EDITLINE",Y="D":"DLTLINE",1:"")
 S VALMBCK="R"
 Q
EDITLINE ;expects IBBLK to be defined - edits an already existing line
 N IBLINE,IBDFDONE
 ;IBDFDONE is used in the imput template
 D FULL^VALM1
 D SELECT
 I IBLINE D
 .D RE^VALM4
 .K DIE,DA S DIE=357.7,DA=IBLINE,DR="[IBDF FORM LINE]",DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DR,DA
 .D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
 Q
SELECT ;select a line on the block
 S IBLINE=0
 Q:'$G(IBBLK)
 I '$O(^IBE(357.7,"C",IBBLK,0)) W !,"There is no line!" D PAUSE^IBDFU5 Q
AGAIN K DIC S DIC="^IBE(357.7,",DIC(0)="EFQ",DIC("B")="",D="C",X=IBBLK
 S DIC("S")="I $P($G(^(0)),U,6)=IBBLK"
 D IX^DIC K DIC
 S:+Y>0 IBLINE=+Y
 I 'IBLINE,'$D(DTOUT),'$D(DUOUT) K DIR S DIR(0)="Y",DIR("A")="No data line selected! Try again",DIR("B")="YES" D ^DIR K DIR I '$D(DIRUT),Y=1 G AGAIN
 Q
DLTLINE ;expects IBBLK to be defined - deletes one of the blocks lines
 N IBLINE
 D FULL^VALM1
 D SELECT
 I IBLINE D
 .Q:'$$RUSURE^IBDFU5($P($G(^IBE(357.7,IBLINE,0)),"^"))
 .D DLTLINE^IBDFU3(357.7,IBBLK,IBLINE)
 .D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
 Q
NEWLINE ;adds a new line, expects IBBLK to be defined
 N IBLINE,NODE,IBDFDONE,DLAYGO
 ;IBDONE - a flag used in the input template to indicate if the input template was completed - delete the line if not completed
 ;S NAME=$$NEWNAME Q:NAME=-1
 K DIC,DIE,DD,DO,DINUM S DIC="^IBE(357.7,",DIC(0)="FL",X="NAME",DLAYGO=357.7
 D FILE^DICN K DIC,DIE,DA,DO
 S IBLINE=+Y
 I 'IBLINE D
 .W !,"Unable to create a new line!" D PAUSE^IBDFU5
 I IBLINE D
 .K DIE,DA S DIE=357.7,DA=IBLINE,DR="[IBDF FORM LINE]",DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DR,DA
 .I 'IBDFDONE K DA S DIK="^IBE(357.7,",DA=IBLINE D ^DIK K DIK Q
 .D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
 Q
NEWNAME(IBLINE) ;
 N NODE,NAME S NODE=$G(^IBE(357.7,IBLINE,0))
 Q:NODE="" "LINE"
 S NAME=$P(NODE,"^",4)_"("_(+$P(NODE,"^",3)+1)_","_(+$P(NODE,"^",2)+1)_")"
 Q NAME
MAXLEN() ;returns the maximum length of the line=IBLINE that will fit in the block=IBBLK
 N LEN,TYPE,NODE,POS
 S NODE=$G(^IBE(357.7,IBLINE,0))
 S TYPE=$P(NODE,"^",4)
 S POS=$S(TYPE="H":$P(NODE,"^",2),1:$P(NODE,"^",3))
 Q ((1+$S(TYPE="H":$$MAXX^IBDFU1B,1:$$MAXY^IBDFU1B))-POS)
 ;
TOOMANY() ;are there too many lines in the box? returns 0 or 1
 ;IBBLK is assumed to be defined=the block
 N SPACING,NODE,START,NUMBER
 Q:'$G(IBLINE) 0
 Q:'$G(IBBLK) 0
 S NODE=$G(^IBE(357.7,IBLINE,0))
 S START=$P(NODE,"^",3),SPACING=$P(NODE,"^",8),NUMBER=$P(NODE,"^",7)
 S SPACING=$S(SPACING="d":2,SPACING="t":3,1:1)
 I (START+(SPACING*NUMBER)-(SPACING-1))>$$MAXY^IBDFU1B
 Q $T