| 1 | RAPSAPI2 ;HOIFO/SG - INPUT TEMPLATE UTILS FOR PHARM. POINTERS ; 4/6/07 3:43pm
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
|
|---|
| 3 | ;
|
|---|
| 4 | ;Supported IA #2053 reference to FILE^DIE
|
|---|
| 5 | ;Supported IA #2052 reference to FIELD^DID and GET1^DID
|
|---|
| 6 | ;Supported IA #2055 reference to ROOT^DILFD and OREF^DILFD
|
|---|
| 7 | ;Supported IA #10007 reference to DO^DIC1
|
|---|
| 8 | ;Supported IA #4551 reference to DIC^PSSDI
|
|---|
| 9 | ;Supported IA #10029 reference to ^DIWW
|
|---|
| 10 | ;
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | ;***** DISPLAYS RECORD DELETE PROMPT AND GETS USER RESPONSE
|
|---|
| 14 | ;
|
|---|
| 15 | ; RAIEN IEN of the record of the multiple
|
|---|
| 16 | ;
|
|---|
| 17 | ; IEN50 Internal value of the .01 field
|
|---|
| 18 | ;
|
|---|
| 19 | ; Return values:
|
|---|
| 20 | ; 0 Keep the record or there is nothing to delete
|
|---|
| 21 | ; 1 Delete the record
|
|---|
| 22 | ;
|
|---|
| 23 | ; Note: This is an internal function. Do not call it from outside
|
|---|
| 24 | ; of the RAPSAPI3 routine.
|
|---|
| 25 | ;
|
|---|
| 26 | DELCONF(RAIEN,IEN50) ;
|
|---|
| 27 | I (RAIEN'>0)!(IEN50'>0) W "??" Q 0
|
|---|
| 28 | N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,TMP,X,Y
|
|---|
| 29 | S DIR(0)="YAO"
|
|---|
| 30 | S DIR("A")=" SURE YOU WANT TO DELETE",TMP=$G(RADESCR("FLDNAME"))
|
|---|
| 31 | S DIR("A")=DIR("A")_$S(TMP'="":" THE ENTIRE "_TMP,1:"")_"? "
|
|---|
| 32 | D ^DIR
|
|---|
| 33 | W:Y'=1 " <NOTHING DELETED>"
|
|---|
| 34 | Q (Y=1)
|
|---|
| 35 | ;
|
|---|
| 36 | ;***** DELETES A (SUB)FILE RECORD
|
|---|
| 37 | ;
|
|---|
| 38 | ; FILE File/subfile number
|
|---|
| 39 | ; IENS IENS of the record
|
|---|
| 40 | ;
|
|---|
| 41 | DELETE(FILE,IENS) ;
|
|---|
| 42 | N RAFDA,RAMSG
|
|---|
| 43 | S RAFDA(FILE,IENS,.01)="@"
|
|---|
| 44 | D FILE^DIE(,"RAFDA","RAMSG")
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | ;***** DISPLAYS HELP (? and ??)
|
|---|
| 48 | ;
|
|---|
| 49 | ; VAL User input ("?" or "??")
|
|---|
| 50 | ;
|
|---|
| 51 | ; FILE File number
|
|---|
| 52 | ;
|
|---|
| 53 | ; FIELD Field number
|
|---|
| 54 | ;
|
|---|
| 55 | ; [IENS] IENS of the multiple defined by the FIELD parameter
|
|---|
| 56 | ; (1st comma piece should be empty). Specify this
|
|---|
| 57 | ; parameter if help information for a "Select..."
|
|---|
| 58 | ; prompt is needed.
|
|---|
| 59 | ;
|
|---|
| 60 | HELP(VAL,FILE,FIELD,IENS) ;
|
|---|
| 61 | Q:'($G(VAL)?1"?".1"?")
|
|---|
| 62 | N LM,RABUF,RAMSG,TMP
|
|---|
| 63 | S TMP="LABEL;MULTIPLE-VALUED;SPECIFIER"
|
|---|
| 64 | D FIELD^DID(FILE,FIELD,,TMP,"RABUF","RAMSG")
|
|---|
| 65 | Q:$G(RABUF("LABEL"))=""
|
|---|
| 66 | ;---
|
|---|
| 67 | I $G(RABUF("MULTIPLE-VALUED")) D S LM=9
|
|---|
| 68 | . S FILE=+$G(RABUF("SPECIFIER")),FIELD=.01
|
|---|
| 69 | . S TMP=$$ROOT^DILFD(FILE,$G(IENS),1)
|
|---|
| 70 | . D:TMP'="" HLPMULT(VAL,TMP,RABUF("LABEL"))
|
|---|
| 71 | E S LM=5
|
|---|
| 72 | ;---
|
|---|
| 73 | I VAL="?" D
|
|---|
| 74 | . D HLPROMPT(LM,FILE,FIELD)
|
|---|
| 75 | E D HLPDESCR(9,FILE,FIELD)
|
|---|
| 76 | ;---
|
|---|
| 77 | W !
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | ;***** DISPLAYS FIELD DESCRIPTION
|
|---|
| 81 | ;
|
|---|
| 82 | ; LM Left margin for the output
|
|---|
| 83 | ;
|
|---|
| 84 | ; FILE File number
|
|---|
| 85 | ;
|
|---|
| 86 | ; FIELD Field number
|
|---|
| 87 | ;
|
|---|
| 88 | HLPDESCR(LM,FILE,FIELD) ;
|
|---|
| 89 | N I,RAHLP,RAMSG
|
|---|
| 90 | S I=$$GET1^DID(FILE,FIELD,,"DESCRIPTION","RAHLP","RAMSG")
|
|---|
| 91 | D:$D(RAHLP)>1 HLPWR(LM,.RAHLP)
|
|---|
| 92 | Q
|
|---|
| 93 | ;
|
|---|
| 94 | ;***** DISPLAYS CONTENT OF THE MULTIPLE AND RELATED PROMPTS
|
|---|
| 95 | ;
|
|---|
| 96 | ; VAL User input ("?" or "??")
|
|---|
| 97 | ;
|
|---|
| 98 | ; LM Left margin for the output
|
|---|
| 99 | ;
|
|---|
| 100 | ; RAROOT Closed root of the multiple's sub-file
|
|---|
| 101 | ;
|
|---|
| 102 | ; MLTNAME Name of the multiple
|
|---|
| 103 | ;
|
|---|
| 104 | HLPMULT(VAL,RAROOT,MLTNAME) ;
|
|---|
| 105 | N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DO,DUOUT,RA50IEN,RAI,RARC,RAY,TMP,X,Y
|
|---|
| 106 | S RARC=0
|
|---|
| 107 | I $O(@RAROOT@(0))>0 D Q:RARC
|
|---|
| 108 | . ;--- Get confirmation if the multiple contains more than 10 records
|
|---|
| 109 | . S DIC=$$OREF^DILF(RAROOT),DIC(0)=""
|
|---|
| 110 | . D DO^DIC1
|
|---|
| 111 | . I VAL'="??",$P(DO,U,4)>10 D I 'Y S RARC=1 Q
|
|---|
| 112 | . . K DIR S DIR(0)="YAO"
|
|---|
| 113 | . . S DIR("A")="Do you want the entire "_$P(DO,U,4)_"-Entry "_MLTNAME_" List? "
|
|---|
| 114 | . . D ^DIR
|
|---|
| 115 | . ;--- Write related prompts
|
|---|
| 116 | . S RAY=$Y-1
|
|---|
| 117 | . W !?4,$S(VAL="?":"Answer with "_MLTNAME,1:"")
|
|---|
| 118 | . W !?3,"Choose from:"
|
|---|
| 119 | . ;--- Write content of the multiple
|
|---|
| 120 | . S RAI=0
|
|---|
| 121 | . F S RAI=$O(@RAROOT@(RAI)) Q:RAI'>0 D Q:'RAI
|
|---|
| 122 | . . S RA50IEN=+$P($G(@RAROOT@(RAI,0)),U)
|
|---|
| 123 | . . I ($Y-RAY)'<IOSL D S RAY=$Y-1 I 'Y S RAI=0 Q
|
|---|
| 124 | . . . K DIR S DIR(0)="EOA"
|
|---|
| 125 | . . . S DIR("A")=" '^' TO STOP: "
|
|---|
| 126 | . . . D ^DIR
|
|---|
| 127 | . . S TMP=$$EN1^RAPSAPI(RA50IEN,.01)
|
|---|
| 128 | . . W !?3,$S(TMP'="":TMP,1:RA50IEN)
|
|---|
| 129 | . W !
|
|---|
| 130 | ;===
|
|---|
| 131 | W !?8,"You may enter a new "_MLTNAME_", if you wish"
|
|---|
| 132 | Q
|
|---|
| 133 | ;
|
|---|
| 134 | ;***** DISPLAYS HELP PROMPT AND SCREEN DESCRIPTION
|
|---|
| 135 | ;
|
|---|
| 136 | ; LM Left margin for the output
|
|---|
| 137 | ;
|
|---|
| 138 | ; FILE File number
|
|---|
| 139 | ;
|
|---|
| 140 | ; FIELD Field number
|
|---|
| 141 | ;
|
|---|
| 142 | HLPROMPT(LM,FILE,FIELD) ;
|
|---|
| 143 | ;;70.15^.01^Only pharmaceuticals that are active on this exam date are allowed.
|
|---|
| 144 | ;;70.21^.01^Enter only active radiopharmaceuticals with an appropriate drug classification.
|
|---|
| 145 | ;;71.055^.01^Only active non-radiopharmaceuticals may be selected.
|
|---|
| 146 | ;;71.08^.01^Only active radiopharmaceuticals are valid.
|
|---|
| 147 | ;;71.9^5^Only active radiopharmaceuticals are valid.
|
|---|
| 148 | ;
|
|---|
| 149 | N RAI,RAMSG,TMP
|
|---|
| 150 | ;--- Help prompt
|
|---|
| 151 | S TMP=$$GET1^DID(FILE,FIELD,,"HELP-PROMPT",,"RAMSG")
|
|---|
| 152 | D:TMP'="" HLPWR(LM,TMP)
|
|---|
| 153 | ;--- Optional screen description
|
|---|
| 154 | F RAI=1:1 S TMP=$P($T(HLPROMPT+RAI),";;",2) Q:TMP="" D Q:TMP=""
|
|---|
| 155 | . I +TMP=FILE,$P(TMP,U,2)=FIELD D HLPWR(LM,$P(TMP,U,3)) S TMP=""
|
|---|
| 156 | Q
|
|---|
| 157 | ;
|
|---|
| 158 | ;***** FORMATS THE TEXT AND WRITES IT TO THE CURRRENT DEVICE
|
|---|
| 159 | ;
|
|---|
| 160 | ; DIWL Left margin for the text
|
|---|
| 161 | ;
|
|---|
| 162 | ; [.]TEXT Either a string or a reference to a local array
|
|---|
| 163 | ; that contains the text
|
|---|
| 164 | ;
|
|---|
| 165 | ; Note: This function uses the ^UTILITY($J,"W") global node.
|
|---|
| 166 | ;
|
|---|
| 167 | HLPWR(DIWL,TEXT) ;
|
|---|
| 168 | N DIWF,DIWR,RAI,X
|
|---|
| 169 | K ^UTILITY($J,"W")
|
|---|
| 170 | S DIWF="W",DIWR=IOM-3
|
|---|
| 171 | I $D(TEXT)>1 S RAI="" D
|
|---|
| 172 | . F S RAI=$O(TEXT(RAI)) Q:RAI="" S X=TEXT(RAI) D ^DIWP
|
|---|
| 173 | E S X=$G(TEXT) D ^DIWP
|
|---|
| 174 | D ^DIWW
|
|---|
| 175 | K ^UTILITY($J,"W")
|
|---|
| 176 | Q
|
|---|
| 177 | ;
|
|---|
| 178 | ;***** VALIDATES DIRECT IEN INPUT (i.e. `IEN)
|
|---|
| 179 | ;
|
|---|
| 180 | ; .VAL User input (`IEN)
|
|---|
| 181 | ;
|
|---|
| 182 | ; Return values:
|
|---|
| 183 | ; 0 Ignore the input
|
|---|
| 184 | ; 1 Process the input
|
|---|
| 185 | ;
|
|---|
| 186 | ; Note: This is an internal function. Do not call it from outside
|
|---|
| 187 | ; of the RAPSAPI3 routine.
|
|---|
| 188 | ;
|
|---|
| 189 | IEN(VAL) ;
|
|---|
| 190 | N IEN,RADIC,PSSDIY
|
|---|
| 191 | S IEN=+$P(VAL,"`",2,$L(VAL))
|
|---|
| 192 | I IEN'>0 W "??" Q 0
|
|---|
| 193 | S VAL="`"_IEN
|
|---|
| 194 | ;--- Check the multiple
|
|---|
| 195 | Q:$D(@(RADESCR("ROOT"))@(IEN)) 1
|
|---|
| 196 | ;--- Check the DRUG file (#50)
|
|---|
| 197 | S RADIC="^PSDRUG(",RADIC(0)=""
|
|---|
| 198 | D SETVACL(RADESCR)
|
|---|
| 199 | D DIC^PSSDI(50,"RA",.RADIC,VAL,,RADESCR("SCRDATE"),,.RAVACL)
|
|---|
| 200 | W:Y'>0 "??"
|
|---|
| 201 | Q (Y>0)
|
|---|
| 202 | ;
|
|---|
| 203 | ;***** SELECTS A RECORD FROM THE MULTIPLE
|
|---|
| 204 | ;
|
|---|
| 205 | ; NODE Node of the cross-reference
|
|---|
| 206 | ; MLTNAME Name of the multiple
|
|---|
| 207 | ; DRUGNAME Drug name
|
|---|
| 208 | ;
|
|---|
| 209 | ; Return values:
|
|---|
| 210 | ; 0 No selection
|
|---|
| 211 | ; >0 IEN of a multiple's record
|
|---|
| 212 | ;
|
|---|
| 213 | MULTSEL(NODE,MLTNAME,DRUGNAME) ;
|
|---|
| 214 | N CNT,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAI,RATMP,RC,TMP,X,Y
|
|---|
| 215 | S RATMP=$NA(^TMP($J,$T(+0)_"-MULTSEL")) K @RATMP
|
|---|
| 216 | ;===
|
|---|
| 217 | S (CNT,IEN,RC)=0
|
|---|
| 218 | F D Q:RC!(IEN'>0)
|
|---|
| 219 | . ;--- Display the next portion of records
|
|---|
| 220 | . F RAI=1:1:5 S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
|
|---|
| 221 | . . S CNT=CNT+1,@RATMP@(CNT)=IEN
|
|---|
| 222 | . . W !?5,CNT,?9,DRUGNAME
|
|---|
| 223 | . Q:CNT'>0
|
|---|
| 224 | . ;--- Ask the user
|
|---|
| 225 | . K DIR S DIR(0)="NAO^1:"_CNT_":0"
|
|---|
| 226 | . S DIR("A")="CHOOSE 1-"_CNT_": "
|
|---|
| 227 | . I IEN>0 D:$O(@NODE@(IEN))>0
|
|---|
| 228 | . . S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, OR"
|
|---|
| 229 | . S DIR("?")="Select a record of the "_MLTNAME_" multivalued field."
|
|---|
| 230 | . D ^DIR
|
|---|
| 231 | . I $D(DTOUT)!$D(DUOUT) S RC=-1 Q
|
|---|
| 232 | . S:X'="" IEN=+@RATMP@(+Y),RC=1
|
|---|
| 233 | ;=== Cleanup
|
|---|
| 234 | K @RATMP
|
|---|
| 235 | Q $S(RC>0:IEN,1:0)
|
|---|
| 236 | ;
|
|---|
| 237 | ;***** INITIALIZES THE RAVACL ARRAY FOR SCREENING MEDS
|
|---|
| 238 | ;
|
|---|
| 239 | ; FLAGS Mode flags
|
|---|
| 240 | ;
|
|---|
| 241 | SETVACL(FLAGS) ;
|
|---|
| 242 | N I
|
|---|
| 243 | F I="DX200","DX201","DX202" S RAVACL(I)=""
|
|---|
| 244 | S:FLAGS["P" RAVACL("P")=""
|
|---|
| 245 | S:FLAGS["R" RAVACL("R")=""
|
|---|
| 246 | Q
|
|---|
