1 | RANMED1 ;HISC/SWM-Nuclear Medicine Enter/Edit Routine ;1/21/97 11:07
|
---|
2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
---|
3 | ROUTE ; Enter/Edit file 71.6
|
---|
4 | W ! N RA1,RA2 S RA1=0
|
---|
5 | S DIC="^RAMIS(71.6,",DIC(0)="AEQLMZ" D ^DIC
|
---|
6 | G:+Y<1 EXIT S DA=+Y,DIE=DIC,DR=".01;100" D ^DIE
|
---|
7 | W !!?5,"Current parameters for entry of sites for this route :"
|
---|
8 | W !!?5,"PROMPT FOR FREE TEXT SITE? = ",$P(^RAMIS(71.6,DA,0),U,3)
|
---|
9 | W !?5,"VALID SITES OF ADMINISTRATION = " F S RA1=$O(^RAMIS(71.6,DA,"SITE",RA1)) Q:'RA1 I +^(RA1,0) S RA2=$P(^RAMIS(71.7,+^(0),0),U) W:($L(RA2)+2+$X)>80 !?10 W RA2 W:$O(^RAMIS(71.6,DA,"SITE",RA1)) ";" W " "
|
---|
10 | W !!?21,"-- NOTE -- ",!?10,"If 'PROMPT FOR FREE TEXT SITE?' is 'Y',",!?10,"then users will not be given a selection",!?10,"of predefined 'VALID SITES'"
|
---|
11 | S DIR(0)="SO^P:PROMPT FOR FREE TEXT SITE?;V:VALID SITES OF ADMINISTRATION"
|
---|
12 | S DIR("A")="Edit which field"
|
---|
13 | D ^DIR
|
---|
14 | G:$G(DIRUT) ROUTE
|
---|
15 | S DR=$S(X="V":2,X="P":3,1:"") G:'DR ROUTE
|
---|
16 | D ^DIE
|
---|
17 | G ROUTE
|
---|
18 | SITE ; Enter/Edit file 71.7
|
---|
19 | W !
|
---|
20 | S DIC="^RAMIS(71.7,",DIC(0)="AEQLMZ" D ^DIC
|
---|
21 | G:+Y<1 EXIT S DA=+Y S DIE=DIC,DR=".01:999" D ^DIE
|
---|
22 | G SITE
|
---|
23 | SOURCE ; Enter/Edit file 71.8
|
---|
24 | W !
|
---|
25 | S DIC="^RAMIS(71.8,",DIC(0)="AEQLMZ" D ^DIC
|
---|
26 | G:+Y<1 EXIT S DA=+Y S DIE=DIC,DR=".01:999" D ^DIE
|
---|
27 | G SOURCE
|
---|
28 | LOT ; Enter/Edit file 71.9
|
---|
29 | W !
|
---|
30 | S DIC="^RAMIS(71.9,",DIC(0)="AEQLMSZ" D ^DIC
|
---|
31 | G:+Y<1 EXIT S DA=+Y S DIE=DIC,DR=".01:999" D ^DIE
|
---|
32 | G LOT
|
---|
33 | WARN ; Warn if dose is out-of-range, called from [RA EXAM EDIT]
|
---|
34 | Q:'$D(RADTI)!('$D(RADFN))
|
---|
35 | N RA1,RAXDIV,RADOT S RA1=0 ; RAXDIV=exam's division
|
---|
36 | S $P(RADOT,"o ",40)=""
|
---|
37 | S RAXDIV=+$P(^RADPT(RADFN,"DT",RADTI,0),U,3)
|
---|
38 | I '$O(^RA(79,RAXDIV,"RWARN",0)) W !!,RADOT,!?14,"This dose level requires a written, dated and signed",!?27,"directive by a physician.",!,RADOT,! Q
|
---|
39 | W !,RADOT
|
---|
40 | F S RA1=$O(^RA(79,RAXDIV,"RWARN",RA1)) Q:'RA1 W !?((80-$L(^(RA1,0)))/2),^(0)
|
---|
41 | W !,RADOT,!
|
---|
42 | Q
|
---|
43 | EXIT K DIC,DIE,DIR,DA,DR,DIRUT
|
---|
44 | K C,D,D0,DDH,DG,DI,DISYS,DQ,DST,DUOUT,I,POP
|
---|
45 | Q
|
---|
46 | DUPL ;check for duplicate entry into file 71.9
|
---|
47 | Q:'$O(^RAMIS(71.9,"B",X,0))
|
---|
48 | Q:'$D(RAOPT("NM EDIT LOT")) ;prevent msg appearing in other options
|
---|
49 | N RA
|
---|
50 | S RA(1)="**WARNING** An entry already exists for LOT NUMBER/ID = "_X
|
---|
51 | S RA(1,"F")="!!?7,*7"
|
---|
52 | S RA(2)="If you want to add another LOT NUMBER/ID with the same value"
|
---|
53 | S RA(2,"F")="!!?7"
|
---|
54 | S RA(3)="then put "" "" around the value, eg. """_X_""""
|
---|
55 | S RA(3,"F")="!?7"
|
---|
56 | S RA(4)=""
|
---|
57 | S RA(4,"F")="!!"
|
---|
58 | D EN^DDIOL(.RA)
|
---|
59 | Q
|
---|