source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RANMED1.m@ 1361

Last change on this file since 1361 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 2.3 KB
Line 
1RANMED1 ;HISC/SWM-Nuclear Medicine Enter/Edit Routine ;1/21/97 11:07
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3ROUTE ; 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
18SITE ; 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
23SOURCE ; 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
28LOT ; 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
33WARN ; 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
43EXIT K DIC,DIE,DIR,DA,DR,DIRUT
44 K C,D,D0,DDH,DG,DI,DISYS,DQ,DST,DUOUT,I,POP
45 Q
46DUPL ;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
Note: See TracBrowser for help on using the repository browser.