- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RANMED1.m
r613 r623 1 RANMED1 ;HISC/SWM-Nuclear Medicine Enter/Edit Routine ;1/21/97 11:07 2 ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 3 ; 4 ;Supported IA #10142 reference to EN^DDIOL 5 ;DBIA: 4551 DIC^PSSDI looks up & screens records from file #50 6 ROUTE ; Enter/Edit file 71.6 7 W ! N RA1,RA2 S RA1=0 8 S DIC="^RAMIS(71.6,",DIC(0)="AEQLMZ" D ^DIC 9 G:+Y<1 EXIT S DA=+Y,DIE=DIC,DR=".01;100" D ^DIE 10 W !!?5,"Current parameters for entry of sites for this route :" 11 W !!?5,"PROMPT FOR FREE TEXT SITE? = ",$P(^RAMIS(71.6,DA,0),U,3) 12 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 " " 13 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'" 14 S DIR(0)="SO^P:PROMPT FOR FREE TEXT SITE?;V:VALID SITES OF ADMINISTRATION" 15 S DIR("A")="Edit which field" 16 D ^DIR 17 G:$G(DIRUT) ROUTE 18 S DR=$S(X="V":2,X="P":3,1:"") G:'DR ROUTE 19 D ^DIE 20 G ROUTE 21 SITE ; Enter/Edit file 71.7 22 W ! 23 S DIC="^RAMIS(71.7,",DIC(0)="AEQLMZ" D ^DIC 24 G:+Y<1 EXIT S DA=+Y S DIE=DIC,DR=".01:999" D ^DIE 25 G SITE 26 SOURCE ; Enter/Edit file 71.8 27 W ! 28 S DIC="^RAMIS(71.8,",DIC(0)="AEQLMZ" D ^DIC 29 G:+Y<1 EXIT S DA=+Y S DIE=DIC,DR=".01:999" D ^DIE 30 G SOURCE 31 LOT ; Enter/Edit file 71.9 32 ;RA*5*65 SG 33 N DA,DIC,DIDEL,DIE,DINUM,DLAYGO,DR,DTOUT,DUOUT,EXIT,TMP,X,Y 34 S EXIT=0 35 F D Q:EXIT 36 . ;--- Select a record 37 . S DIC="^RAMIS(71.9,",DIC(0)="AEQLMSZ" 38 . W ! D ^DIC 39 . I Y'>0 S EXIT=1 Q 40 . ;--- Edit the record 41 . S DA=+Y,DIE=DIC 42 . S DR=".01:4;5///^S X=$$RXEDIT^RAPSAPI3(""R"","""_DA_","",71.9,5,DT);6" 43 . D ^DIE 44 Q 45 WARN ; Warn if dose is out-of-range, called from [RA EXAM EDIT] 46 Q:'$D(RADTI)!('$D(RADFN)) 47 N RA1,RAXDIV,RADOT S RA1=0 ; RAXDIV=exam's division 48 S $P(RADOT,"o ",40)="" 49 S RAXDIV=+$P(^RADPT(RADFN,"DT",RADTI,0),U,3) 50 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 51 W !,RADOT 52 F S RA1=$O(^RA(79,RAXDIV,"RWARN",RA1)) Q:'RA1 W !?((80-$L(^(RA1,0)))/2),^(0) 53 W !,RADOT,! 54 Q 55 EXIT K DIC,DIE,DIR,DA,DR,DIRUT 56 K C,D,D0,DDH,DG,DI,DISYS,DQ,DST,DUOUT,I,POP 57 K RA719IEN,RAFDA,DIE,DA,DR,RAVACL,RAYN,RAENTRY,RA50IEN,RANODEL,RASTUFF 58 K RAHLP3,RAFIN 59 Q 60 DUPL ;check for duplicate entry into file 71.9 61 Q:'$O(^RAMIS(71.9,"B",X,0)) 62 Q:'$D(RAOPT("NM EDIT LOT")) ;prevent msg appearing in other options 63 N RA 64 S RA(1)="**WARNING** An entry already exists for LOT NUMBER/ID = "_X 65 S RA(1,"F")="!!?7,*7" 66 S RA(2)="If you want to add another LOT NUMBER/ID with the same value" 67 S RA(2,"F")="!!?7" 68 S RA(3)="then put "" "" around the value, eg. """_X_"""" 69 S RA(3,"F")="!?7" 70 S RA(4)="" 71 S RA(4,"F")="!!" 72 D EN^DDIOL(.RA) 73 Q 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
Note:
See TracChangeset
for help on using the changeset viewer.
