RANMED1 ;HISC/SWM-Nuclear Medicine Enter/Edit Routine ;1/21/97 11:07
;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
;
;Supported IA #10142 reference to EN^DDIOL
;DBIA: 4551 DIC^PSSDI looks up & screens records from file #50
ROUTE ; Enter/Edit file 71.6
W ! N RA1,RA2 S RA1=0
S DIC="^RAMIS(71.6,",DIC(0)="AEQLMZ" D ^DIC
G:+Y<1 EXIT S DA=+Y,DIE=DIC,DR=".01;100" D ^DIE
W !!?5,"Current parameters for entry of sites for this route :"
W !!?5,"PROMPT FOR FREE TEXT SITE? = ",$P(^RAMIS(71.6,DA,0),U,3)
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 " "
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'"
S DIR(0)="SO^P:PROMPT FOR FREE TEXT SITE?;V:VALID SITES OF ADMINISTRATION"
S DIR("A")="Edit which field"
D ^DIR
G:$G(DIRUT) ROUTE
S DR=$S(X="V":2,X="P":3,1:"") G:'DR ROUTE
D ^DIE
G ROUTE
SITE ; Enter/Edit file 71.7
W !
S DIC="^RAMIS(71.7,",DIC(0)="AEQLMZ" D ^DIC
G:+Y<1 EXIT S DA=+Y S DIE=DIC,DR=".01:999" D ^DIE
G SITE
SOURCE ; Enter/Edit file 71.8
W !
S DIC="^RAMIS(71.8,",DIC(0)="AEQLMZ" D ^DIC
G:+Y<1 EXIT S DA=+Y S DIE=DIC,DR=".01:999" D ^DIE
G SOURCE
LOT ; Enter/Edit file 71.9
;RA*5*65 SG
N DA,DIC,DIDEL,DIE,DINUM,DLAYGO,DR,DTOUT,DUOUT,EXIT,TMP,X,Y
S EXIT=0
F D Q:EXIT
. ;--- Select a record
. S DIC="^RAMIS(71.9,",DIC(0)="AEQLMSZ"
. W ! D ^DIC
. I Y'>0 S EXIT=1 Q
. ;--- Edit the record
. S DA=+Y,DIE=DIC
. S DR=".01:4;5///^S X=$$RXEDIT^RAPSAPI3(""R"","""_DA_","",71.9,5,DT);6"
. D ^DIE
Q
WARN ; Warn if dose is out-of-range, called from [RA EXAM EDIT]
Q:'$D(RADTI)!('$D(RADFN))
N RA1,RAXDIV,RADOT S RA1=0 ; RAXDIV=exam's division
S $P(RADOT,"o ",40)=""
S RAXDIV=+$P(^RADPT(RADFN,"DT",RADTI,0),U,3)
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
W !,RADOT
F S RA1=$O(^RA(79,RAXDIV,"RWARN",RA1)) Q:'RA1 W !?((80-$L(^(RA1,0)))/2),^(0)
W !,RADOT,!
Q
EXIT K DIC,DIE,DIR,DA,DR,DIRUT
K C,D,D0,DDH,DG,DI,DISYS,DQ,DST,DUOUT,I,POP
K RA719IEN,RAFDA,DIE,DA,DR,RAVACL,RAYN,RAENTRY,RA50IEN,RANODEL,RASTUFF
K RAHLP3,RAFIN
Q
DUPL ;check for duplicate entry into file 71.9
Q:'$O(^RAMIS(71.9,"B",X,0))
Q:'$D(RAOPT("NM EDIT LOT")) ;prevent msg appearing in other options
N RA
S RA(1)="**WARNING** An entry already exists for LOT NUMBER/ID = "_X
S RA(1,"F")="!!?7,*7"
S RA(2)="If you want to add another LOT NUMBER/ID with the same value"
S RA(2,"F")="!!?7"
S RA(3)="then put "" "" around the value, eg. """_X_""""
S RA(3,"F")="!?7"
S RA(4)=""
S RA(4,"F")="!!"
D EN^DDIOL(.RA)
Q
RANMED1 ;HISC/SWM-Nuclear Medicine Enter/Edit Routine ;1/21/97 11:07
+1 ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
+2 ;
+3 ;Supported IA #10142 reference to EN^DDIOL
+4 ;DBIA: 4551 DIC^PSSDI looks up & screens records from file #50
ROUTE ; Enter/Edit file 71.6
+1 WRITE !
NEW RA1,RA2
SET RA1=0
+2 SET DIC="^RAMIS(71.6,"
SET DIC(0)="AEQLMZ"
DO ^DIC
+3 IF +Y<1
GOTO EXIT
SET DA=+Y
SET DIE=DIC
SET DR=".01;100"
DO ^DIE
+4 WRITE !!?5,"Current parameters for entry of sites for this route :"
+5 WRITE !!?5,"PROMPT FOR FREE TEXT SITE? = ",$PIECE(^RAMIS(71.6,DA,0),U,3)
+6 WRITE !?5,"VALID SITES OF ADMINISTRATION = "
FOR
SET RA1=$ORDER(^RAMIS(71.6,DA,"SITE",RA1))
IF 'RA1
QUIT
IF +^(RA1,0)
SET RA2=$PIECE(^RAMIS(71.7,+^(0),0),U)
IF ($LENGTH(RA2)+2+$X)>80
WRITE !?10
WRITE RA2
IF $ORDER(^RAMIS(71.6,DA,"SITE",RA1))
WRITE ";"
WRITE " "
+7 WRITE !!?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'"
+8 SET DIR(0)="SO^P:PROMPT FOR FREE TEXT SITE?;V:VALID SITES OF ADMINISTRATION"
+9 SET DIR("A")="Edit which field"
+10 DO ^DIR
+11 IF $GET(DIRUT)
GOTO ROUTE
+12 SET DR=$SELECT(X="V":2,X="P":3,1:"")
IF 'DR
GOTO ROUTE
+13 DO ^DIE
+14 GOTO ROUTE
SITE ; Enter/Edit file 71.7
+1 WRITE !
+2 SET DIC="^RAMIS(71.7,"
SET DIC(0)="AEQLMZ"
DO ^DIC
+3 IF +Y<1
GOTO EXIT
SET DA=+Y
SET DIE=DIC
SET DR=".01:999"
DO ^DIE
+4 GOTO SITE
SOURCE ; Enter/Edit file 71.8
+1 WRITE !
+2 SET DIC="^RAMIS(71.8,"
SET DIC(0)="AEQLMZ"
DO ^DIC
+3 IF +Y<1
GOTO EXIT
SET DA=+Y
SET DIE=DIC
SET DR=".01:999"
DO ^DIE
+4 GOTO SOURCE
LOT ; Enter/Edit file 71.9
+1 ;RA*5*65 SG
+2 NEW DA,DIC,DIDEL,DIE,DINUM,DLAYGO,DR,DTOUT,DUOUT,EXIT,TMP,X,Y
+3 SET EXIT=0
+4 FOR
Begin DoDot:1
+5 ;--- Select a record
+6 SET DIC="^RAMIS(71.9,"
SET DIC(0)="AEQLMSZ"
+7 WRITE !
DO ^DIC
+8 IF Y'>0
SET EXIT=1
QUIT
+9 ;--- Edit the record
+10 SET DA=+Y
SET DIE=DIC
+11 SET DR=".01:4;5///^S X=$$RXEDIT^RAPSAPI3(""R"","""_DA_","",71.9,5,DT);6"
+12 DO ^DIE
End DoDot:1
IF EXIT
QUIT
+13 QUIT
WARN ; Warn if dose is out-of-range, called from [RA EXAM EDIT]
+1 IF '$DATA(RADTI)!('$DATA(RADFN))
QUIT
+2 ; RAXDIV=exam's division
NEW RA1,RAXDIV,RADOT
SET RA1=0
+3 SET $PIECE(RADOT,"o ",40)=""
+4 SET RAXDIV=+$PIECE(^RADPT(RADFN,"DT",RADTI,0),U,3)
+5 IF '$ORDER(^RA(79,RAXDIV,"RWARN",0))
WRITE !!,RADOT,!?14,"This dose level requires a written, dated and signed",!?27,"directive by a physician.",!,RADOT,!
QUIT
+6 WRITE !,RADOT
+7 FOR
SET RA1=$ORDER(^RA(79,RAXDIV,"RWARN",RA1))
IF 'RA1
QUIT
WRITE !?((80-$LENGTH(^(RA1,0)))/2),^(0)
+8 WRITE !,RADOT,!
+9 QUIT
EXIT KILL DIC,DIE,DIR,DA,DR,DIRUT
+1 KILL C,D,D0,DDH,DG,DI,DISYS,DQ,DST,DUOUT,I,POP
+2 KILL RA719IEN,RAFDA,DIE,DA,DR,RAVACL,RAYN,RAENTRY,RA50IEN,RANODEL,RASTUFF
+3 KILL RAHLP3,RAFIN
+4 QUIT
DUPL ;check for duplicate entry into file 71.9
+1 IF '$ORDER(^RAMIS(71.9,"B",X,0))
QUIT
+2 ;prevent msg appearing in other options
IF '$DATA(RAOPT("NM EDIT LOT"))
QUIT
+3 NEW RA
+4 SET RA(1)="**WARNING** An entry already exists for LOT NUMBER/ID = "_X
+5 SET RA(1,"F")="!!?7,*7"
+6 SET RA(2)="If you want to add another LOT NUMBER/ID with the same value"
+7 SET RA(2,"F")="!!?7"
+8 SET RA(3)="then put "" "" around the value, eg. """_X_""""
+9 SET RA(3,"F")="!?7"
+10 SET RA(4)=""
+11 SET RA(4,"F")="!!"
+12 DO EN^DDIOL(.RA)
+13 QUIT
