RAPSAPI3 ;HOIFO/SG - INPUT TEMPLATE UTILS FOR PHARM. POINTERS ; 4/13/07 10:45am
;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
;
; This routine uses the following IAs:
;
; #2056 GET1^DIQ
; #2052 FIELD^DID
; #2055 ROOT^DILFD
; #10007 DO^DIC1
; #4551 DIC^PSSDI looks up & screens records from file #50
;
Q
;
;***** RETURNS IEN OF THE DEFAULT RECORD OF THE MULTIPLE
;
; Note: This is an internal function. Do not call it from outside
; of this routine.
;
DFLTREC() ;
Q $S($G(RADESCR("SELCNT"))'>1:+$O(@(RADESCR("ROOT"))@(" "),-1),1:0)
;
;***** EDITS RADIOLOGY SCREENED POINTER TO THE DRUG FILE (#50)
;
; RADESCR Flags that control execution
; "P" Medications
; "R" Radiopharms
;
; RAIENS IENS of the edited record (e.g. "1,")
;
; RAFILE Radiology file number (e.g. 71.9)
;
; RAFIELD Field number of the pointer to the file #50 (e.g. 5)
;
; [RADATE] Date for screening medications
;
; Return values:
; "" Field was empty and the value has not changed
; "@" Clear the field
; "^" Exit the record editing
; ^Field "^"-jump to other field (e.g. "^KIT")
; `IEN Pointer to the record of the file #50 (e.g. "`234")
;
RXEDIT(RADESCR,RAIENS,RAFILE,RAFIELD,RADATE) ;
N PSSDIY,RA50IEN,RABUF,RADIC,RAENTRY,RALABEL,RAMSG,RARC,RAVACL,TMP
;=== Validate and parse parameters
S RADESCR=$G(RADESCR)
S:(RADESCR'["P")&(RADESCR'["R") RADESCR=RADESCR_"P"
S:$G(RADATE)'>0 RADATE=""
;
;=== Get field info from the data dictionary
D FIELD^DID(RAFILE,RAFIELD,,"LABEL;MULTIPLE-VALUED","RABUF","RAMSG")
I $G(RABUF("MULTIPLE-VALUED")) S TMP=$T(+0) D Q "^"
. W !!,"$$RXEDIT^"_TMP_" cannot be used for multiples!"
. W !,"Use $$RXMEDIT^"_TMP_" instead.",!
S RALABEL=RABUF("LABEL")_": "
K RABUF
;
;===
F D Q:$D(RARC)
. ;--- Get the current internal value of the field
. S RA50IEN=+$$GET1^DIQ(RAFILE,RAIENS,RAFIELD,"I",,"RAMSG")
. ;--- Get the external value of the field
. I RA50IEN>0 D
. . S TMP=$$EN1^RAPSAPI(RA50IEN,.01)
. . S:TMP="" TMP=RA50IEN
. E S TMP=""
. ;--- Display the prompt and get a user response
. W !,RALABEL_$S(TMP'="":TMP_"// ",1:"")
. R RAENTRY:DTIME E S RARC="^" Q
. ;--- Keep the current value
. I RAENTRY="" S RARC=$S(RA50IEN>0:"`"_RA50IEN,1:"") Q
. ;--- Exit or "^"-jump
. I RAENTRY?1"^".E S RARC=RAENTRY Q
. ;--- @ entered
. I RAENTRY="@" S:$$DELCONF^RAPSAPI2(+RAIENS,RA50IEN) RARC="@" Q
. ;--- ? or ?? entered
. D:RAENTRY?1"?".1"?" HELP^RAPSAPI2(RAENTRY,RAFILE,RAFIELD)
. ;--- Something else entered
. S RADIC="^PSDRUG(",RADIC(0)="EQMZ",RADIC("A")=RALABEL
. D SETVACL^RAPSAPI2(RADESCR)
. D DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADATE,,.RAVACL)
. S:Y>0 RARC="`"_(+Y)
;
;===
Q RARC
;
;***** EDITS .01 POINTER (MULTIPLE) TO THE DRUG FILE (#50)
;
; .RADESCR( Flags that control execution
; "P" Medications
; "R" Radiopharms
;
; When this function finishes editing the multiple,
; this parameter is KILL'ed automatically.
;
; Subscripts of this parameter store the state between
; calls. Do not access them outside of this function!
; The only exception is the RADESCR("RESULT") that
; stores the latest value returned by the function.
;
; "EDITONLY") The function is in "edit-only" mode of the .01 field
; of the multiple.
;
; "FLDNAME") Name of the .01 field of the multiple
; "MLTNAME") Name of the multiple
; "RESULT") The latest result returned by this function
; "ROOT") Closed root of the multiple's sub-file
; "SCRDATE") Date for screening meds (value of the RADATE param.)
;
; "SELCNT") Number of times the function was called in selection
; mode ($G("EDITONLY")=0) without resetting the state.
;
; "SUBFILE") Number of the multiple's sub-file
;
; RAIENS IENS of a multiple/subfile (e.g. ",1,") or IENS
; of a record of the multiple (e.g. "2,3,"). In the
; latter case, the function switches to "edit-only"
; mode.
;
; [RAFILE] Radiology file number (e.g. 70.2)
;
; [RAMULT] Field number of the multiple (e.g. 100)
;
; [RADATE] Date for screening medications
;
; Return values:
; "" Exit the multiple
; "@" Delete the value of the .01 field
; "^" Exit the record editing
; ^Field "^"-jump to other field (e.g. "^KIT")
; `IEN Pointer to the record of the file #50 or IEN of
; an existing record of the multiple (e.g. "`234")
;
RXMEDIT(RADESCR,RAIENS,RAFILE,RAMULT,RADATE) ;
N RASUBIEN ; IEN of the record of the multiple
;
N PSSDIY,RA50IEN,RADEFDIS,RADEFVAL,RADIC,RADUP,RAENTRY,RAMIEN,RAMSG,RARC,RAVACL,RAXNODE,TMP
;=== Validate and parse parameters
S RADESCR=$G(RADESCR)
S:(RADESCR'["P")&(RADESCR'["R") RADESCR=RADESCR_"P"
S RASUBIEN=+$P(RAIENS,","),$P(RAIENS,",")=""
;
;=== Get file/field info from the data dictionary
I '$G(RADESCR("SELCNT")) D I $D(RARC) K RADESCR Q RARC
. N RABUF,SUBFILE
. S TMP="LABEL;MULTIPLE-VALUED;SPECIFIER"
. D FIELD^DID(RAFILE,RAMULT,,TMP,"RABUF","RAMSG")
. ;---
. I '$G(RABUF("MULTIPLE-VALUED")) S TMP=$T(+0) D S RARC="^" Q
. . W !!,"$$RXMEDIT^"_TMP_" cannot be used for single-value fields!"
. . W !,"Use $$RXEDIT^"_TMP_" instead.",!
. ;---
. S RADESCR("MLTNAME")=RABUF("LABEL")
. S (RADESCR("SUBFILE"),SUBFILE)=+RABUF("SPECIFIER")
. S RADESCR("FLDNAME")=$$GET1^DID(SUBFILE,.01,,"LABEL",,"RAMSG")
. S RADESCR("ROOT")=$$ROOT^DILFD(SUBFILE,RAIENS,1)
. S RADESCR("SCRDATE")=$S($G(RADATE)>0:+RADATE,1:"")
;
;=== Determine the execution mode
I RASUBIEN'>0 D K RADESCR("EDITONLY")
. S RADESCR("SELCNT")=$G(RADESCR("SELCNT"))+1
. S RASUBIEN=$$DFLTREC()
E S RADESCR("EDITONLY")=1
;
;===
F D Q:$D(RARC)
. ;--- Get the current internal value of the .01 field
. I RASUBIEN>0 D
. . S TMP=RASUBIEN_RAIENS
. . S RA50IEN=+$$GET1^DIQ(RADESCR("SUBFILE"),TMP,.01,"I",,"RAMSG")
. E S RA50IEN=0
. ;--- Get the external value of the .01 field
. I RA50IEN>0 D
. . S RADEFVAL=$$EN1^RAPSAPI(RA50IEN,.01)
. . S:RADEFVAL="" RADEFVAL=RA50IEN
. E S RADEFVAL=""
. S RADEFDIS=": "_$S(RADEFVAL'="":RADEFVAL_"// ",1:"")
. ;--- Display the prompt and get a user response
. W ! W:'$G(RADESCR("EDITONLY")) "Select "
. W RADESCR("FLDNAME")_RADEFDIS
. R RAENTRY:DTIME E S RARC="^" Q
. ;--- Keep the current value or exit if there is no current record
. I RAENTRY="" D Q
. . I RASUBIEN'>0 S RARC="" Q
. . ;--- If selecting a record, return IEN in the multiple
. . I '$G(RADESCR("EDITONLY")) S RARC="`"_RASUBIEN Q
. . ;--- If just editing the .01 field, return IEN in the DRUG file
. . S RARC=$S(RA50IEN>0:"`"_RA50IEN,1:"")
. ;--- Exit or "^"-jump
. I RAENTRY?1"^".E S RARC=RAENTRY Q
. ;--- @ entered
. I RAENTRY="@" D:$$DELCONF^RAPSAPI2(RASUBIEN,RA50IEN) Q
. . ;--- Let the FileMan delete the value of the .01 field
. . I $G(RADESCR("EDITONLY")) S RARC="@" Q
. . ;--- Delete the record at "Select ..." prompt
. . D DELETE^RAPSAPI2(RADESCR("SUBFILE"),RASUBIEN_RAIENS)
. . S RASUBIEN=$$DFLTREC()
. ;--- Record IEN entered
. I RAENTRY?1"`"1.N S:$$IEN^RAPSAPI2(.RAENTRY) RARC=RAENTRY Q
. ;--- Add duplicate entry (value in double quotes)
. I RAENTRY?1""""1.E1"""" D S RADUP=1
. . S RAENTRY=$E(RAENTRY,2,$L(RAENTRY)-1) ; Remove quotes
. E S RADUP=0
. ;--- ? or ?? entered
. I RAENTRY?1"?".1"?" D S RADUP=0
. . I $G(RADESCR("EDITONLY")) D Q
. . . D HELP^RAPSAPI2(RAENTRY,RADESCR("SUBFILE"),.01)
. . D HELP^RAPSAPI2(RAENTRY,RAFILE,RAMULT,RAIENS)
. ;--- Everything else
. S RADIC="^PSDRUG(",RADIC(0)="EQMZ"
. S RADIC("A")=RADESCR("FLDNAME")_": "
. D SETVACL^RAPSAPI2(RADESCR)
. D DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADESCR("SCRDATE"),,.RAVACL)
. Q:Y'>0
. ;--- If just editing the .01 field, return IEN in the DRUG file
. I $G(RADESCR("EDITONLY")) S RARC="`"_(+Y) Q
. ;--- Try to find the drug in the multiple.
. ;--- If not found or duplication is forced, add the drug.
. S RAXNODE=$NA(@(RADESCR("ROOT"))@("B",+Y))
. S RAMIEN=+$O(@RAXNODE@(0))
. I (RAMIEN'>0)!RADUP S RARC="""`"_(+Y)_"""" Q
. ;--- Otherwise, select a record from the multiple.
. I $O(@RAXNODE@(RAMIEN))>0 D Q:RAMIEN'>0
. . S RAMIEN=$$MULTSEL^RAPSAPI2(RAXNODE,RADESCR("MLTNAME"),$P(Y,U,2))
. S RARC="`"_RAMIEN
;
;=== Cleanup
S RADESCR("RESULT")=RARC
D:'$G(RADESCR("EDITONLY"))
. K:(RARC="^")!((RARC="")&(RA50IEN'>0)) RADESCR
Q RARC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPSAPI3 8837 printed Dec 13, 2024@02:38:56 Page 2
RAPSAPI3 ;HOIFO/SG - INPUT TEMPLATE UTILS FOR PHARM. POINTERS ; 4/13/07 10:45am
+1 ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #2056 GET1^DIQ
+6 ; #2052 FIELD^DID
+7 ; #2055 ROOT^DILFD
+8 ; #10007 DO^DIC1
+9 ; #4551 DIC^PSSDI looks up & screens records from file #50
+10 ;
+11 QUIT
+12 ;
+13 ;***** RETURNS IEN OF THE DEFAULT RECORD OF THE MULTIPLE
+14 ;
+15 ; Note: This is an internal function. Do not call it from outside
+16 ; of this routine.
+17 ;
DFLTREC() ;
+1 QUIT $SELECT($GET(RADESCR("SELCNT"))'>1:+$ORDER(@(RADESCR("ROOT"))@(" "),-1),1:0)
+2 ;
+3 ;***** EDITS RADIOLOGY SCREENED POINTER TO THE DRUG FILE (#50)
+4 ;
+5 ; RADESCR Flags that control execution
+6 ; "P" Medications
+7 ; "R" Radiopharms
+8 ;
+9 ; RAIENS IENS of the edited record (e.g. "1,")
+10 ;
+11 ; RAFILE Radiology file number (e.g. 71.9)
+12 ;
+13 ; RAFIELD Field number of the pointer to the file #50 (e.g. 5)
+14 ;
+15 ; [RADATE] Date for screening medications
+16 ;
+17 ; Return values:
+18 ; "" Field was empty and the value has not changed
+19 ; "@" Clear the field
+20 ; "^" Exit the record editing
+21 ; ^Field "^"-jump to other field (e.g. "^KIT")
+22 ; `IEN Pointer to the record of the file #50 (e.g. "`234")
+23 ;
RXEDIT(RADESCR,RAIENS,RAFILE,RAFIELD,RADATE) ;
+1 NEW PSSDIY,RA50IEN,RABUF,RADIC,RAENTRY,RALABEL,RAMSG,RARC,RAVACL,TMP
+2 ;=== Validate and parse parameters
+3 SET RADESCR=$GET(RADESCR)
+4 if (RADESCR'["P")&(RADESCR'["R")
SET RADESCR=RADESCR_"P"
+5 if $GET(RADATE)'>0
SET RADATE=""
+6 ;
+7 ;=== Get field info from the data dictionary
+8 DO FIELD^DID(RAFILE,RAFIELD,,"LABEL;MULTIPLE-VALUED","RABUF","RAMSG")
+9 IF $GET(RABUF("MULTIPLE-VALUED"))
SET TMP=$TEXT(+0)
Begin DoDot:1
+10 WRITE !!,"$$RXEDIT^"_TMP_" cannot be used for multiples!"
+11 WRITE !,"Use $$RXMEDIT^"_TMP_" instead.",!
End DoDot:1
QUIT "^"
+12 SET RALABEL=RABUF("LABEL")_": "
+13 KILL RABUF
+14 ;
+15 ;===
+16 FOR
Begin DoDot:1
+17 ;--- Get the current internal value of the field
+18 SET RA50IEN=+$$GET1^DIQ(RAFILE,RAIENS,RAFIELD,"I",,"RAMSG")
+19 ;--- Get the external value of the field
+20 IF RA50IEN>0
Begin DoDot:2
+21 SET TMP=$$EN1^RAPSAPI(RA50IEN,.01)
+22 if TMP=""
SET TMP=RA50IEN
End DoDot:2
+23 IF '$TEST
SET TMP=""
+24 ;--- Display the prompt and get a user response
+25 WRITE !,RALABEL_$SELECT(TMP'="":TMP_"// ",1:"")
+26 READ RAENTRY:DTIME
IF '$TEST
SET RARC="^"
QUIT
+27 ;--- Keep the current value
+28 IF RAENTRY=""
SET RARC=$SELECT(RA50IEN>0:"`"_RA50IEN,1:"")
QUIT
+29 ;--- Exit or "^"-jump
+30 IF RAENTRY?1"^".E
SET RARC=RAENTRY
QUIT
+31 ;--- @ entered
+32 IF RAENTRY="@"
if $$DELCONF^RAPSAPI2(+RAIENS,RA50IEN)
SET RARC="@"
QUIT
+33 ;--- ? or ?? entered
+34 if RAENTRY?1"?".1"?"
DO HELP^RAPSAPI2(RAENTRY,RAFILE,RAFIELD)
+35 ;--- Something else entered
+36 SET RADIC="^PSDRUG("
SET RADIC(0)="EQMZ"
SET RADIC("A")=RALABEL
+37 DO SETVACL^RAPSAPI2(RADESCR)
+38 DO DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADATE,,.RAVACL)
+39 if Y>0
SET RARC="`"_(+Y)
End DoDot:1
if $DATA(RARC)
QUIT
+40 ;
+41 ;===
+42 QUIT RARC
+43 ;
+44 ;***** EDITS .01 POINTER (MULTIPLE) TO THE DRUG FILE (#50)
+45 ;
+46 ; .RADESCR( Flags that control execution
+47 ; "P" Medications
+48 ; "R" Radiopharms
+49 ;
+50 ; When this function finishes editing the multiple,
+51 ; this parameter is KILL'ed automatically.
+52 ;
+53 ; Subscripts of this parameter store the state between
+54 ; calls. Do not access them outside of this function!
+55 ; The only exception is the RADESCR("RESULT") that
+56 ; stores the latest value returned by the function.
+57 ;
+58 ; "EDITONLY") The function is in "edit-only" mode of the .01 field
+59 ; of the multiple.
+60 ;
+61 ; "FLDNAME") Name of the .01 field of the multiple
+62 ; "MLTNAME") Name of the multiple
+63 ; "RESULT") The latest result returned by this function
+64 ; "ROOT") Closed root of the multiple's sub-file
+65 ; "SCRDATE") Date for screening meds (value of the RADATE param.)
+66 ;
+67 ; "SELCNT") Number of times the function was called in selection
+68 ; mode ($G("EDITONLY")=0) without resetting the state.
+69 ;
+70 ; "SUBFILE") Number of the multiple's sub-file
+71 ;
+72 ; RAIENS IENS of a multiple/subfile (e.g. ",1,") or IENS
+73 ; of a record of the multiple (e.g. "2,3,"). In the
+74 ; latter case, the function switches to "edit-only"
+75 ; mode.
+76 ;
+77 ; [RAFILE] Radiology file number (e.g. 70.2)
+78 ;
+79 ; [RAMULT] Field number of the multiple (e.g. 100)
+80 ;
+81 ; [RADATE] Date for screening medications
+82 ;
+83 ; Return values:
+84 ; "" Exit the multiple
+85 ; "@" Delete the value of the .01 field
+86 ; "^" Exit the record editing
+87 ; ^Field "^"-jump to other field (e.g. "^KIT")
+88 ; `IEN Pointer to the record of the file #50 or IEN of
+89 ; an existing record of the multiple (e.g. "`234")
+90 ;
RXMEDIT(RADESCR,RAIENS,RAFILE,RAMULT,RADATE) ;
+1 ; IEN of the record of the multiple
NEW RASUBIEN
+2 ;
+3 NEW PSSDIY,RA50IEN,RADEFDIS,RADEFVAL,RADIC,RADUP,RAENTRY,RAMIEN,RAMSG,RARC,RAVACL,RAXNODE,TMP
+4 ;=== Validate and parse parameters
+5 SET RADESCR=$GET(RADESCR)
+6 if (RADESCR'["P")&(RADESCR'["R")
SET RADESCR=RADESCR_"P"
+7 SET RASUBIEN=+$PIECE(RAIENS,",")
SET $PIECE(RAIENS,",")=""
+8 ;
+9 ;=== Get file/field info from the data dictionary
+10 IF '$GET(RADESCR("SELCNT"))
Begin DoDot:1
+11 NEW RABUF,SUBFILE
+12 SET TMP="LABEL;MULTIPLE-VALUED;SPECIFIER"
+13 DO FIELD^DID(RAFILE,RAMULT,,TMP,"RABUF","RAMSG")
+14 ;---
+15 IF '$GET(RABUF("MULTIPLE-VALUED"))
SET TMP=$TEXT(+0)
Begin DoDot:2
+16 WRITE !!,"$$RXMEDIT^"_TMP_" cannot be used for single-value fields!"
+17 WRITE !,"Use $$RXEDIT^"_TMP_" instead.",!
End DoDot:2
SET RARC="^"
QUIT
+18 ;---
+19 SET RADESCR("MLTNAME")=RABUF("LABEL")
+20 SET (RADESCR("SUBFILE"),SUBFILE)=+RABUF("SPECIFIER")
+21 SET RADESCR("FLDNAME")=$$GET1^DID(SUBFILE,.01,,"LABEL",,"RAMSG")
+22 SET RADESCR("ROOT")=$$ROOT^DILFD(SUBFILE,RAIENS,1)
+23 SET RADESCR("SCRDATE")=$SELECT($GET(RADATE)>0:+RADATE,1:"")
End DoDot:1
IF $DATA(RARC)
KILL RADESCR
QUIT RARC
+24 ;
+25 ;=== Determine the execution mode
+26 IF RASUBIEN'>0
Begin DoDot:1
+27 SET RADESCR("SELCNT")=$GET(RADESCR("SELCNT"))+1
+28 SET RASUBIEN=$$DFLTREC()
End DoDot:1
KILL RADESCR("EDITONLY")
+29 IF '$TEST
SET RADESCR("EDITONLY")=1
+30 ;
+31 ;===
+32 FOR
Begin DoDot:1
+33 ;--- Get the current internal value of the .01 field
+34 IF RASUBIEN>0
Begin DoDot:2
+35 SET TMP=RASUBIEN_RAIENS
+36 SET RA50IEN=+$$GET1^DIQ(RADESCR("SUBFILE"),TMP,.01,"I",,"RAMSG")
End DoDot:2
+37 IF '$TEST
SET RA50IEN=0
+38 ;--- Get the external value of the .01 field
+39 IF RA50IEN>0
Begin DoDot:2
+40 SET RADEFVAL=$$EN1^RAPSAPI(RA50IEN,.01)
+41 if RADEFVAL=""
SET RADEFVAL=RA50IEN
End DoDot:2
+42 IF '$TEST
SET RADEFVAL=""
+43 SET RADEFDIS=": "_$SELECT(RADEFVAL'="":RADEFVAL_"// ",1:"")
+44 ;--- Display the prompt and get a user response
+45 WRITE !
if '$GET(RADESCR("EDITONLY"))
WRITE "Select "
+46 WRITE RADESCR("FLDNAME")_RADEFDIS
+47 READ RAENTRY:DTIME
IF '$TEST
SET RARC="^"
QUIT
+48 ;--- Keep the current value or exit if there is no current record
+49 IF RAENTRY=""
Begin DoDot:2
+50 IF RASUBIEN'>0
SET RARC=""
QUIT
+51 ;--- If selecting a record, return IEN in the multiple
+52 IF '$GET(RADESCR("EDITONLY"))
SET RARC="`"_RASUBIEN
QUIT
+53 ;--- If just editing the .01 field, return IEN in the DRUG file
+54 SET RARC=$SELECT(RA50IEN>0:"`"_RA50IEN,1:"")
End DoDot:2
QUIT
+55 ;--- Exit or "^"-jump
+56 IF RAENTRY?1"^".E
SET RARC=RAENTRY
QUIT
+57 ;--- @ entered
+58 IF RAENTRY="@"
if $$DELCONF^RAPSAPI2(RASUBIEN,RA50IEN)
Begin DoDot:2
+59 ;--- Let the FileMan delete the value of the .01 field
+60 IF $GET(RADESCR("EDITONLY"))
SET RARC="@"
QUIT
+61 ;--- Delete the record at "Select ..." prompt
+62 DO DELETE^RAPSAPI2(RADESCR("SUBFILE"),RASUBIEN_RAIENS)
+63 SET RASUBIEN=$$DFLTREC()
End DoDot:2
QUIT
+64 ;--- Record IEN entered
+65 IF RAENTRY?1"`"1.N
if $$IEN^RAPSAPI2(.RAENTRY)
SET RARC=RAENTRY
QUIT
+66 ;--- Add duplicate entry (value in double quotes)
+67 IF RAENTRY?1""""1.E1""""
Begin DoDot:2
+68 ; Remove quotes
SET RAENTRY=$EXTRACT(RAENTRY,2,$LENGTH(RAENTRY)-1)
End DoDot:2
SET RADUP=1
+69 IF '$TEST
SET RADUP=0
+70 ;--- ? or ?? entered
+71 IF RAENTRY?1"?".1"?"
Begin DoDot:2
+72 IF $GET(RADESCR("EDITONLY"))
Begin DoDot:3
+73 DO HELP^RAPSAPI2(RAENTRY,RADESCR("SUBFILE"),.01)
End DoDot:3
QUIT
+74 DO HELP^RAPSAPI2(RAENTRY,RAFILE,RAMULT,RAIENS)
End DoDot:2
SET RADUP=0
+75 ;--- Everything else
+76 SET RADIC="^PSDRUG("
SET RADIC(0)="EQMZ"
+77 SET RADIC("A")=RADESCR("FLDNAME")_": "
+78 DO SETVACL^RAPSAPI2(RADESCR)
+79 DO DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADESCR("SCRDATE"),,.RAVACL)
+80 if Y'>0
QUIT
+81 ;--- If just editing the .01 field, return IEN in the DRUG file
+82 IF $GET(RADESCR("EDITONLY"))
SET RARC="`"_(+Y)
QUIT
+83 ;--- Try to find the drug in the multiple.
+84 ;--- If not found or duplication is forced, add the drug.
+85 SET RAXNODE=$NAME(@(RADESCR("ROOT"))@("B",+Y))
+86 SET RAMIEN=+$ORDER(@RAXNODE@(0))
+87 IF (RAMIEN'>0)!RADUP
SET RARC="""`"_(+Y)_""""
QUIT
+88 ;--- Otherwise, select a record from the multiple.
+89 IF $ORDER(@RAXNODE@(RAMIEN))>0
Begin DoDot:2
+90 SET RAMIEN=$$MULTSEL^RAPSAPI2(RAXNODE,RADESCR("MLTNAME"),$PIECE(Y,U,2))
End DoDot:2
if RAMIEN'>0
QUIT
+91 SET RARC="`"_RAMIEN
End DoDot:1
if $DATA(RARC)
QUIT
+92 ;
+93 ;=== Cleanup
+94 SET RADESCR("RESULT")=RARC
+95 if '$GET(RADESCR("EDITONLY"))
Begin DoDot:1
+96 if (RARC="^")!((RARC="")&(RA50IEN'>0))
KILL RADESCR
End DoDot:1
+97 QUIT RARC
