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 Sep 23, 2025@20:15 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
