- RAPSAPI2 ;HOIFO/SG - INPUT TEMPLATE UTILS FOR PHARM. POINTERS ; 4/6/07 3:43pm
- ;;5.0;Radiology/Nuclear Medicine;**65,138**;Mar 16, 1998;Build 22
- ;
- ;Supported IA #2053 reference to FILE^DIE
- ;Supported IA #2052 reference to FIELD^DID and GET1^DID
- ;Supported IA #2055 reference to ROOT^DILFD and OREF^DILFD
- ;Supported IA #10007 reference to DO^DIC1
- ;Supported IA #4551 reference to DIC^PSSDI
- ;Supported IA #10029 reference to ^DIWW
- ;
- Q
- ;
- ;***** DISPLAYS RECORD DELETE PROMPT AND GETS USER RESPONSE
- ;
- ; RAIEN IEN of the record of the multiple
- ;
- ; IEN50 Internal value of the .01 field
- ;
- ; Return values:
- ; 0 Keep the record or there is nothing to delete
- ; 1 Delete the record
- ;
- ; Note: This is an internal function. Do not call it from outside
- ; of the RAPSAPI3 routine.
- ;
- DELCONF(RAIEN,IEN50) ;
- I (RAIEN'>0)!(IEN50'>0) W "??" Q 0
- N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,TMP,X,Y
- S DIR(0)="YAO"
- S DIR("A")=" SURE YOU WANT TO DELETE",TMP=$G(RADESCR("FLDNAME"))
- S DIR("A")=DIR("A")_$S(TMP'="":" THE ENTIRE "_TMP,1:"")_"? "
- D ^DIR
- W:Y'=1 " <NOTHING DELETED>"
- Q (Y=1)
- ;
- ;***** DELETES A (SUB)FILE RECORD
- ;
- ; FILE File/subfile number
- ; IENS IENS of the record
- ;
- DELETE(FILE,IENS) ;
- N RAFDA,RAMSG
- S RAFDA(FILE,IENS,.01)="@"
- D FILE^DIE(,"RAFDA","RAMSG")
- Q
- ;
- ;***** DISPLAYS HELP (? and ??)
- ;
- ; VAL User input ("?" or "??")
- ;
- ; FILE File number
- ;
- ; FIELD Field number
- ;
- ; [IENS] IENS of the multiple defined by the FIELD parameter
- ; (1st comma piece should be empty). Specify this
- ; parameter if help information for a "Select..."
- ; prompt is needed.
- ;
- HELP(VAL,FILE,FIELD,IENS) ;
- Q:'($G(VAL)?1"?".1"?")
- N LM,RABUF,RAMSG,TMP
- S TMP="LABEL;MULTIPLE-VALUED;SPECIFIER"
- D FIELD^DID(FILE,FIELD,,TMP,"RABUF","RAMSG")
- Q:$G(RABUF("LABEL"))=""
- ;---
- I $G(RABUF("MULTIPLE-VALUED")) D S LM=9
- . S FILE=+$G(RABUF("SPECIFIER")),FIELD=.01
- . S TMP=$$ROOT^DILFD(FILE,$G(IENS),1)
- . D:TMP'="" HLPMULT(VAL,TMP,RABUF("LABEL"))
- E S LM=5
- ;---
- I VAL="?" D
- . D HLPROMPT(LM,FILE,FIELD)
- E D HLPDESCR(9,FILE,FIELD)
- ;---
- W !
- Q
- ;
- ;***** DISPLAYS FIELD DESCRIPTION
- ;
- ; LM Left margin for the output
- ;
- ; FILE File number
- ;
- ; FIELD Field number
- ;
- HLPDESCR(LM,FILE,FIELD) ;
- N I,RAHLP,RAMSG
- S I=$$GET1^DID(FILE,FIELD,,"DESCRIPTION","RAHLP","RAMSG")
- D:$D(RAHLP)>1 HLPWR(LM,.RAHLP)
- Q
- ;
- ;***** DISPLAYS CONTENT OF THE MULTIPLE AND RELATED PROMPTS
- ;
- ; VAL User input ("?" or "??")
- ;
- ; LM Left margin for the output
- ;
- ; RAROOT Closed root of the multiple's sub-file
- ;
- ; MLTNAME Name of the multiple
- ;
- HLPMULT(VAL,RAROOT,MLTNAME) ;
- N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DO,DUOUT,RA50IEN,RAI,RARC,RAY,TMP,X,Y
- S RARC=0
- I $O(@RAROOT@(0))>0 D Q:RARC
- . ;--- Get confirmation if the multiple contains more than 10 records
- . S DIC=$$OREF^DILF(RAROOT),DIC(0)=""
- . D DO^DIC1
- . I VAL'="??",$P(DO,U,4)>10 D I 'Y S RARC=1 Q
- . . K DIR S DIR(0)="YAO"
- . . S DIR("A")="Do you want the entire "_$P(DO,U,4)_"-Entry "_MLTNAME_" List? "
- . . D ^DIR
- . ;--- Write related prompts
- . S RAY=$Y-1
- . W !?4,$S(VAL="?":"Answer with "_MLTNAME,1:"")
- . W !?3,"Choose from:"
- . ;--- Write content of the multiple
- . S RAI=0
- . F S RAI=$O(@RAROOT@(RAI)) Q:RAI'>0 D Q:'RAI
- . . S RA50IEN=+$P($G(@RAROOT@(RAI,0)),U)
- . . I ($Y-RAY)'<IOSL D S RAY=$Y-1 I 'Y S RAI=0 Q
- . . . K DIR S DIR(0)="EOA"
- . . . S DIR("A")=" '^' TO STOP: "
- . . . D ^DIR
- . . S TMP=$$EN1^RAPSAPI(RA50IEN,.01)
- . . W !?3,$S(TMP'="":TMP,1:RA50IEN)
- . W !
- ;===
- W !?8,"You may enter a new "_MLTNAME_", if you wish"
- Q
- ;
- ;***** DISPLAYS HELP PROMPT AND SCREEN DESCRIPTION
- ;
- ; LM Left margin for the output
- ;
- ; FILE File number
- ;
- ; FIELD Field number
- ;
- HLPROMPT(LM,FILE,FIELD) ;
- ;;70.15^.01^Only pharmaceuticals that are active on this exam date are allowed.
- ;;70.21^.01^Enter only active radiopharmaceuticals with an appropriate drug classification.
- ;;71.055^.01^Only active non-radiopharmaceuticals may be selected.
- ;;71.08^.01^Only active radiopharmaceuticals are valid.
- ;;71.9^5^Only active radiopharmaceuticals are valid.
- ;
- N RAI,RAMSG,TMP
- ;--- Help prompt
- S TMP=$$GET1^DID(FILE,FIELD,,"HELP-PROMPT",,"RAMSG")
- D:TMP'="" HLPWR(LM,TMP)
- ;--- Optional screen description
- F RAI=1:1 S TMP=$P($T(HLPROMPT+RAI),";;",2) Q:TMP="" D Q:TMP=""
- . I +TMP=FILE,$P(TMP,U,2)=FIELD D HLPWR(LM,$P(TMP,U,3)) S TMP=""
- Q
- ;
- ;***** FORMATS THE TEXT AND WRITES IT TO THE CURRRENT DEVICE
- ;
- ; DIWL Left margin for the text
- ;
- ; [.]TEXT Either a string or a reference to a local array
- ; that contains the text
- ;
- ; Note: This function uses the ^UTILITY($J,"W") global node.
- ;
- HLPWR(DIWL,TEXT) ;
- N DIWF,DIWR,RAI,X
- K ^UTILITY($J,"W")
- S DIWF="W",DIWR=IOM-3
- I $D(TEXT)>1 S RAI="" D
- . F S RAI=$O(TEXT(RAI)) Q:RAI="" D
- .. I $D(TEXT(RAI))#2 S X=TEXT(RAI) D ^DIWP
- .. ; JCH/RA*5.0*138 - Accomodate additional text in sub-nodes of TEXT(RAI)
- .. I $O(TEXT(RAI,"")) N RAI2 S RAI2=0 F S RAI2=$O(TEXT(RAI,RAI2)) Q:'RAI2 D
- ... I $D(TEXT(RAI,RAI2))#2 S X=$G(TEXT(RAI,RAI2)) D ^DIWP
- E S X=$G(TEXT) D ^DIWP
- D ^DIWW
- K ^UTILITY($J,"W")
- Q
- ;
- ;***** VALIDATES DIRECT IEN INPUT (i.e. `IEN)
- ;
- ; .VAL User input (`IEN)
- ;
- ; Return values:
- ; 0 Ignore the input
- ; 1 Process the input
- ;
- ; Note: This is an internal function. Do not call it from outside
- ; of the RAPSAPI3 routine.
- ;
- IEN(VAL) ;
- N IEN,RADIC,PSSDIY
- S IEN=+$P(VAL,"`",2,$L(VAL))
- I IEN'>0 W "??" Q 0
- S VAL="`"_IEN
- ;--- Check the multiple
- Q:$D(@(RADESCR("ROOT"))@(IEN)) 1
- ;--- Check the DRUG file (#50)
- S RADIC="^PSDRUG(",RADIC(0)=""
- D SETVACL(RADESCR)
- D DIC^PSSDI(50,"RA",.RADIC,VAL,,RADESCR("SCRDATE"),,.RAVACL)
- W:Y'>0 "??"
- Q (Y>0)
- ;
- ;***** SELECTS A RECORD FROM THE MULTIPLE
- ;
- ; NODE Node of the cross-reference
- ; MLTNAME Name of the multiple
- ; DRUGNAME Drug name
- ;
- ; Return values:
- ; 0 No selection
- ; >0 IEN of a multiple's record
- ;
- MULTSEL(NODE,MLTNAME,DRUGNAME) ;
- N CNT,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAI,RATMP,RC,TMP,X,Y
- S RATMP=$NA(^TMP($J,$T(+0)_"-MULTSEL")) K @RATMP
- ;===
- S (CNT,IEN,RC)=0
- F D Q:RC!(IEN'>0)
- . ;--- Display the next portion of records
- . F RAI=1:1:5 S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
- . . S CNT=CNT+1,@RATMP@(CNT)=IEN
- . . W !?5,CNT,?9,DRUGNAME
- . Q:CNT'>0
- . ;--- Ask the user
- . K DIR S DIR(0)="NAO^1:"_CNT_":0"
- . S DIR("A")="CHOOSE 1-"_CNT_": "
- . I IEN>0 D:$O(@NODE@(IEN))>0
- . . S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, OR"
- . S DIR("?")="Select a record of the "_MLTNAME_" multivalued field."
- . D ^DIR
- . I $D(DTOUT)!$D(DUOUT) S RC=-1 Q
- . S:X'="" IEN=+@RATMP@(+Y),RC=1
- ;=== Cleanup
- K @RATMP
- Q $S(RC>0:IEN,1:0)
- ;
- ;***** INITIALIZES THE RAVACL ARRAY FOR SCREENING MEDS
- ;
- ; FLAGS Mode flags
- ;
- SETVACL(FLAGS) ;
- N I
- F I="DX200","DX201","DX202" S RAVACL(I)=""
- S:FLAGS["P" RAVACL("P")=""
- S:FLAGS["R" RAVACL("R")=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPSAPI2 7378 printed Feb 19, 2025@00:05:11 Page 2
- RAPSAPI2 ;HOIFO/SG - INPUT TEMPLATE UTILS FOR PHARM. POINTERS ; 4/6/07 3:43pm
- +1 ;;5.0;Radiology/Nuclear Medicine;**65,138**;Mar 16, 1998;Build 22
- +2 ;
- +3 ;Supported IA #2053 reference to FILE^DIE
- +4 ;Supported IA #2052 reference to FIELD^DID and GET1^DID
- +5 ;Supported IA #2055 reference to ROOT^DILFD and OREF^DILFD
- +6 ;Supported IA #10007 reference to DO^DIC1
- +7 ;Supported IA #4551 reference to DIC^PSSDI
- +8 ;Supported IA #10029 reference to ^DIWW
- +9 ;
- +10 QUIT
- +11 ;
- +12 ;***** DISPLAYS RECORD DELETE PROMPT AND GETS USER RESPONSE
- +13 ;
- +14 ; RAIEN IEN of the record of the multiple
- +15 ;
- +16 ; IEN50 Internal value of the .01 field
- +17 ;
- +18 ; Return values:
- +19 ; 0 Keep the record or there is nothing to delete
- +20 ; 1 Delete the record
- +21 ;
- +22 ; Note: This is an internal function. Do not call it from outside
- +23 ; of the RAPSAPI3 routine.
- +24 ;
- DELCONF(RAIEN,IEN50) ;
- +1 IF (RAIEN'>0)!(IEN50'>0)
- WRITE "??"
- QUIT 0
- +2 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,TMP,X,Y
- +3 SET DIR(0)="YAO"
- +4 SET DIR("A")=" SURE YOU WANT TO DELETE"
- SET TMP=$GET(RADESCR("FLDNAME"))
- +5 SET DIR("A")=DIR("A")_$SELECT(TMP'="":" THE ENTIRE "_TMP,1:"")_"? "
- +6 DO ^DIR
- +7 if Y'=1
- WRITE " <NOTHING DELETED>"
- +8 QUIT (Y=1)
- +9 ;
- +10 ;***** DELETES A (SUB)FILE RECORD
- +11 ;
- +12 ; FILE File/subfile number
- +13 ; IENS IENS of the record
- +14 ;
- DELETE(FILE,IENS) ;
- +1 NEW RAFDA,RAMSG
- +2 SET RAFDA(FILE,IENS,.01)="@"
- +3 DO FILE^DIE(,"RAFDA","RAMSG")
- +4 QUIT
- +5 ;
- +6 ;***** DISPLAYS HELP (? and ??)
- +7 ;
- +8 ; VAL User input ("?" or "??")
- +9 ;
- +10 ; FILE File number
- +11 ;
- +12 ; FIELD Field number
- +13 ;
- +14 ; [IENS] IENS of the multiple defined by the FIELD parameter
- +15 ; (1st comma piece should be empty). Specify this
- +16 ; parameter if help information for a "Select..."
- +17 ; prompt is needed.
- +18 ;
- HELP(VAL,FILE,FIELD,IENS) ;
- +1 if '($GET(VAL)?1"?".1"?")
- QUIT
- +2 NEW LM,RABUF,RAMSG,TMP
- +3 SET TMP="LABEL;MULTIPLE-VALUED;SPECIFIER"
- +4 DO FIELD^DID(FILE,FIELD,,TMP,"RABUF","RAMSG")
- +5 if $GET(RABUF("LABEL"))=""
- QUIT
- +6 ;---
- +7 IF $GET(RABUF("MULTIPLE-VALUED"))
- Begin DoDot:1
- +8 SET FILE=+$GET(RABUF("SPECIFIER"))
- SET FIELD=.01
- +9 SET TMP=$$ROOT^DILFD(FILE,$GET(IENS),1)
- +10 if TMP'=""
- DO HLPMULT(VAL,TMP,RABUF("LABEL"))
- End DoDot:1
- SET LM=9
- +11 IF '$TEST
- SET LM=5
- +12 ;---
- +13 IF VAL="?"
- Begin DoDot:1
- +14 DO HLPROMPT(LM,FILE,FIELD)
- End DoDot:1
- +15 IF '$TEST
- DO HLPDESCR(9,FILE,FIELD)
- +16 ;---
- +17 WRITE !
- +18 QUIT
- +19 ;
- +20 ;***** DISPLAYS FIELD DESCRIPTION
- +21 ;
- +22 ; LM Left margin for the output
- +23 ;
- +24 ; FILE File number
- +25 ;
- +26 ; FIELD Field number
- +27 ;
- HLPDESCR(LM,FILE,FIELD) ;
- +1 NEW I,RAHLP,RAMSG
- +2 SET I=$$GET1^DID(FILE,FIELD,,"DESCRIPTION","RAHLP","RAMSG")
- +3 if $DATA(RAHLP)>1
- DO HLPWR(LM,.RAHLP)
- +4 QUIT
- +5 ;
- +6 ;***** DISPLAYS CONTENT OF THE MULTIPLE AND RELATED PROMPTS
- +7 ;
- +8 ; VAL User input ("?" or "??")
- +9 ;
- +10 ; LM Left margin for the output
- +11 ;
- +12 ; RAROOT Closed root of the multiple's sub-file
- +13 ;
- +14 ; MLTNAME Name of the multiple
- +15 ;
- HLPMULT(VAL,RAROOT,MLTNAME) ;
- +1 NEW DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DO,DUOUT,RA50IEN,RAI,RARC,RAY,TMP,X,Y
- +2 SET RARC=0
- +3 IF $ORDER(@RAROOT@(0))>0
- Begin DoDot:1
- +4 ;--- Get confirmation if the multiple contains more than 10 records
- +5 SET DIC=$$OREF^DILF(RAROOT)
- SET DIC(0)=""
- +6 DO DO^DIC1
- +7 IF VAL'="??"
- IF $PIECE(DO,U,4)>10
- Begin DoDot:2
- +8 KILL DIR
- SET DIR(0)="YAO"
- +9 SET DIR("A")="Do you want the entire "_$PIECE(DO,U,4)_"-Entry "_MLTNAME_" List? "
- +10 DO ^DIR
- End DoDot:2
- IF 'Y
- SET RARC=1
- QUIT
- +11 ;--- Write related prompts
- +12 SET RAY=$Y-1
- +13 WRITE !?4,$SELECT(VAL="?":"Answer with "_MLTNAME,1:"")
- +14 WRITE !?3,"Choose from:"
- +15 ;--- Write content of the multiple
- +16 SET RAI=0
- +17 FOR
- SET RAI=$ORDER(@RAROOT@(RAI))
- if RAI'>0
- QUIT
- Begin DoDot:2
- +18 SET RA50IEN=+$PIECE($GET(@RAROOT@(RAI,0)),U)
- +19 IF ($Y-RAY)'<IOSL
- Begin DoDot:3
- +20 KILL DIR
- SET DIR(0)="EOA"
- +21 SET DIR("A")=" '^' TO STOP: "
- +22 DO ^DIR
- End DoDot:3
- SET RAY=$Y-1
- IF 'Y
- SET RAI=0
- QUIT
- +23 SET TMP=$$EN1^RAPSAPI(RA50IEN,.01)
- +24 WRITE !?3,$SELECT(TMP'="":TMP,1:RA50IEN)
- End DoDot:2
- if 'RAI
- QUIT
- +25 WRITE !
- End DoDot:1
- if RARC
- QUIT
- +26 ;===
- +27 WRITE !?8,"You may enter a new "_MLTNAME_", if you wish"
- +28 QUIT
- +29 ;
- +30 ;***** DISPLAYS HELP PROMPT AND SCREEN DESCRIPTION
- +31 ;
- +32 ; LM Left margin for the output
- +33 ;
- +34 ; FILE File number
- +35 ;
- +36 ; FIELD Field number
- +37 ;
- HLPROMPT(LM,FILE,FIELD) ;
- +1 ;;70.15^.01^Only pharmaceuticals that are active on this exam date are allowed.
- +2 ;;70.21^.01^Enter only active radiopharmaceuticals with an appropriate drug classification.
- +3 ;;71.055^.01^Only active non-radiopharmaceuticals may be selected.
- +4 ;;71.08^.01^Only active radiopharmaceuticals are valid.
- +5 ;;71.9^5^Only active radiopharmaceuticals are valid.
- +6 ;
- +7 NEW RAI,RAMSG,TMP
- +8 ;--- Help prompt
- +9 SET TMP=$$GET1^DID(FILE,FIELD,,"HELP-PROMPT",,"RAMSG")
- +10 if TMP'=""
- DO HLPWR(LM,TMP)
- +11 ;--- Optional screen description
- +12 FOR RAI=1:1
- SET TMP=$PIECE($TEXT(HLPROMPT+RAI),";;",2)
- if TMP=""
- QUIT
- Begin DoDot:1
- +13 IF +TMP=FILE
- IF $PIECE(TMP,U,2)=FIELD
- DO HLPWR(LM,$PIECE(TMP,U,3))
- SET TMP=""
- End DoDot:1
- if TMP=""
- QUIT
- +14 QUIT
- +15 ;
- +16 ;***** FORMATS THE TEXT AND WRITES IT TO THE CURRRENT DEVICE
- +17 ;
- +18 ; DIWL Left margin for the text
- +19 ;
- +20 ; [.]TEXT Either a string or a reference to a local array
- +21 ; that contains the text
- +22 ;
- +23 ; Note: This function uses the ^UTILITY($J,"W") global node.
- +24 ;
- HLPWR(DIWL,TEXT) ;
- +1 NEW DIWF,DIWR,RAI,X
- +2 KILL ^UTILITY($JOB,"W")
- +3 SET DIWF="W"
- SET DIWR=IOM-3
- +4 IF $DATA(TEXT)>1
- SET RAI=""
- Begin DoDot:1
- +5 FOR
- SET RAI=$ORDER(TEXT(RAI))
- if RAI=""
- QUIT
- Begin DoDot:2
- +6 IF $DATA(TEXT(RAI))#2
- SET X=TEXT(RAI)
- DO ^DIWP
- +7 ; JCH/RA*5.0*138 - Accomodate additional text in sub-nodes of TEXT(RAI)
- +8 IF $ORDER(TEXT(RAI,""))
- NEW RAI2
- SET RAI2=0
- FOR
- SET RAI2=$ORDER(TEXT(RAI,RAI2))
- if 'RAI2
- QUIT
- Begin DoDot:3
- +9 IF $DATA(TEXT(RAI,RAI2))#2
- SET X=$GET(TEXT(RAI,RAI2))
- DO ^DIWP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 IF '$TEST
- SET X=$GET(TEXT)
- DO ^DIWP
- +11 DO ^DIWW
- +12 KILL ^UTILITY($JOB,"W")
- +13 QUIT
- +14 ;
- +15 ;***** VALIDATES DIRECT IEN INPUT (i.e. `IEN)
- +16 ;
- +17 ; .VAL User input (`IEN)
- +18 ;
- +19 ; Return values:
- +20 ; 0 Ignore the input
- +21 ; 1 Process the input
- +22 ;
- +23 ; Note: This is an internal function. Do not call it from outside
- +24 ; of the RAPSAPI3 routine.
- +25 ;
- IEN(VAL) ;
- +1 NEW IEN,RADIC,PSSDIY
- +2 SET IEN=+$PIECE(VAL,"`",2,$LENGTH(VAL))
- +3 IF IEN'>0
- WRITE "??"
- QUIT 0
- +4 SET VAL="`"_IEN
- +5 ;--- Check the multiple
- +6 if $DATA(@(RADESCR("ROOT"))@(IEN))
- QUIT 1
- +7 ;--- Check the DRUG file (#50)
- +8 SET RADIC="^PSDRUG("
- SET RADIC(0)=""
- +9 DO SETVACL(RADESCR)
- +10 DO DIC^PSSDI(50,"RA",.RADIC,VAL,,RADESCR("SCRDATE"),,.RAVACL)
- +11 if Y'>0
- WRITE "??"
- +12 QUIT (Y>0)
- +13 ;
- +14 ;***** SELECTS A RECORD FROM THE MULTIPLE
- +15 ;
- +16 ; NODE Node of the cross-reference
- +17 ; MLTNAME Name of the multiple
- +18 ; DRUGNAME Drug name
- +19 ;
- +20 ; Return values:
- +21 ; 0 No selection
- +22 ; >0 IEN of a multiple's record
- +23 ;
- MULTSEL(NODE,MLTNAME,DRUGNAME) ;
- +1 NEW CNT,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAI,RATMP,RC,TMP,X,Y
- +2 SET RATMP=$NAME(^TMP($JOB,$TEXT(+0)_"-MULTSEL"))
- KILL @RATMP
- +3 ;===
- +4 SET (CNT,IEN,RC)=0
- +5 FOR
- Begin DoDot:1
- +6 ;--- Display the next portion of records
- +7 FOR RAI=1:1:5
- SET IEN=$ORDER(@NODE@(IEN))
- if IEN'>0
- QUIT
- Begin DoDot:2
- +8 SET CNT=CNT+1
- SET @RATMP@(CNT)=IEN
- +9 WRITE !?5,CNT,?9,DRUGNAME
- End DoDot:2
- +10 if CNT'>0
- QUIT
- +11 ;--- Ask the user
- +12 KILL DIR
- SET DIR(0)="NAO^1:"_CNT_":0"
- +13 SET DIR("A")="CHOOSE 1-"_CNT_": "
- +14 IF IEN>0
- if $ORDER(@NODE@(IEN))>0
- Begin DoDot:2
- +15 SET DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, OR"
- End DoDot:2
- +16 SET DIR("?")="Select a record of the "_MLTNAME_" multivalued field."
- +17 DO ^DIR
- +18 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET RC=-1
- QUIT
- +19 if X'=""
- SET IEN=+@RATMP@(+Y)
- SET RC=1
- End DoDot:1
- if RC!(IEN'>0)
- QUIT
- +20 ;=== Cleanup
- +21 KILL @RATMP
- +22 QUIT $SELECT(RC>0:IEN,1:0)
- +23 ;
- +24 ;***** INITIALIZES THE RAVACL ARRAY FOR SCREENING MEDS
- +25 ;
- +26 ; FLAGS Mode flags
- +27 ;
- SETVACL(FLAGS) ;
- +1 NEW I
- +2 FOR I="DX200","DX201","DX202"
- SET RAVACL(I)=""
- +3 if FLAGS["P"
- SET RAVACL("P")=""
- +4 if FLAGS["R"
- SET RAVACL("R")=""
- +5 QUIT