Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAPSAPI2

RAPSAPI2.m

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