- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANMED1 2892 printed Feb 19, 2025@00:03:43 Page 2
- 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