| 1 | IBDF9B4 ;ALB/CJM - ENCOUNTER FORM - (edit,delete,add Hand Print fields) ;JUL 20,1994
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | HFIELD ;Create, Edit, or Delete a Hand Print field from the form
|
|---|
| 5 | ;
|
|---|
| 6 | N IBVALMBG,QUIT
|
|---|
| 7 | S IBVALMBG=VALMBG
|
|---|
| 8 | S QUIT=0
|
|---|
| 9 | S VALMBCK="R"
|
|---|
| 10 | ;
|
|---|
| 11 | F D Q:QUIT
|
|---|
| 12 | .D FULL^VALM1
|
|---|
| 13 | .K DIR S DIR("?",1)="You can Create, Edit, or Delete an hand print field, or Shift all of the hand print fields",DIR("?")="within a definable range either up or down."
|
|---|
| 14 | .W !!,DIR("?",1),!,DIR("?"),!
|
|---|
| 15 | .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"
|
|---|
| 16 | .D ^DIR K DIR I $D(DIRUT)!(Y<0) S QUIT=1 Q
|
|---|
| 17 | .I Y="Q" S QUIT=1 Q
|
|---|
| 18 | .D @$S(Y="C":"NEWFLD",Y="E":"EDITFLD",Y="D":"DLTFLD",Y="S":"SHIFT",1:"")
|
|---|
| 19 | .D RE^VALM4
|
|---|
| 20 | S VALMBCK="R",VALMBG=IBVALMBG
|
|---|
| 21 | Q
|
|---|
| 22 | SHIFT ;expects IBBLK to be defined - shifts all hand print fields within range supplied by user
|
|---|
| 23 | D SHIFT^IBDF10("H")
|
|---|
| 24 | D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
|---|
| 25 | Q
|
|---|
| 26 | EDITFLD ;expects IBBLK to be defined
|
|---|
| 27 | N IBFIELD,RTN,NODE
|
|---|
| 28 | N IBOLD,IBDELETE,IBX,IBY,IBLEN,IBTYPE ;these are used in the input template
|
|---|
| 29 | D SELECT
|
|---|
| 30 | I IBFIELD D
|
|---|
| 31 | .D RE^VALM4
|
|---|
| 32 | .S (IBX,IBY,IBLEN)=0
|
|---|
| 33 | .S IBOLD=1,IBTYPE=$P($G(^IBE(359.94,IBFIELD,0)),"^",5)
|
|---|
| 34 | .K DR,DIE,DA S DIE=359.94,DA=IBFIELD,DR="[IBDF EDIT HAND PRINT FIELD]",DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DR,DA
|
|---|
| 35 | .D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
|---|
| 36 | Q
|
|---|
| 37 | SELECT ;
|
|---|
| 38 | S IBFIELD=0
|
|---|
| 39 | Q:'$G(IBBLK)
|
|---|
| 40 | I '$O(^IBE(359.94,"C",IBBLK,0)) W !,"There is no hand print field!" D PAUSE^IBDFU5 Q
|
|---|
| 41 | AGAIN K DIC S DIC="^IBE(359.94,",DIC(0)="EFQ",DIC("B")="",D="C",X=IBBLK
|
|---|
| 42 | S DIC("S")="I $P($G(^(0)),U,8)=IBBLK"
|
|---|
| 43 | D IX^DIC K DIC
|
|---|
| 44 | S:+Y>0 IBFIELD=+Y
|
|---|
| 45 | I 'IBFIELD,'$D(DTOUT),'$D(DUOUT) K DIR S DIR(0)="Y",DIR("A")="No hand print field selected! Try again",DIR("B")="YES" D ^DIR K DIR I '$D(DIRUT),Y=1 G AGAIN
|
|---|
| 46 | Q
|
|---|
| 47 | DLTFLD ;expects IBBLK to be defined
|
|---|
| 48 | N IBFIELD
|
|---|
| 49 | D SELECT
|
|---|
| 50 | I IBFIELD D
|
|---|
| 51 | .Q:'$$RUSURE^IBDFU5($P($G(^IBE(359.94,IBFIELD,0)),"^"))
|
|---|
| 52 | .D DLTHFLD^IBDFU3(359.94,IBBLK,IBFIELD)
|
|---|
| 53 | .D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
|---|
| 54 | Q
|
|---|
| 55 | NEWFLD ;adds a new field, expects IBBLK to be defined
|
|---|
| 56 | N NAME,FIELD,NODE,IBRTN,DLAYGO
|
|---|
| 57 | N IBX,IBY,IBLEN,IBDELETE,IBOLD,IBTYPE ;these are used in the input template
|
|---|
| 58 | S NAME=$$NEWNAME^IBDF9B Q:NAME=-1
|
|---|
| 59 | S IBOLD=0,(IBX,IBY,IBLEN)=""
|
|---|
| 60 | K DIC,DIE,DD,DO,DINUM S DIC="^IBE(359.94,",DIC(0)="FL",X=NAME,DLAYGO=359.94
|
|---|
| 61 | D FILE^DICN K DIC,DIE,DA
|
|---|
| 62 | S FIELD=$S(+Y<0:"",1:+Y)
|
|---|
| 63 | I 'FIELD D
|
|---|
| 64 | .W !,"Unable to create a new hand print field!" D PAUSE^IBDFU5
|
|---|
| 65 | I FIELD D
|
|---|
| 66 | .S IBDELETE=1
|
|---|
| 67 | .K DIE,DA,DR S DIE=359.94,DA=FIELD,DR="[IBDF EDIT HAND PRINT FIELD]",DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DR,DA,DIC
|
|---|
| 68 | .I IBDELETE K DA S DIK="^IBE(359.94,",DA=FIELD D ^DIK K DIK,DA Q
|
|---|
| 69 | .D UNCMPBLK^IBDF19(IBBLK),IDXBLOCK^IBDFU4
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | LENGTHDT(TYPE) ;
|
|---|
| 73 | Q:'$G(TYPE) 0
|
|---|
| 74 | N NODE,LEN
|
|---|
| 75 | S NODE=$G(^IBE(359.1,TYPE,0))
|
|---|
| 76 | S LEN=$L($P(NODE,"^",11))
|
|---|
| 77 | S:LEN LEN=LEN+1
|
|---|
| 78 | S LEN=LEN+(4*$P(NODE,"^",6))
|
|---|
| 79 | Q LEN
|
|---|
