| 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
 | 
|---|