source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPSAPI2.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.7 KB
RevLine 
[613]1RAPSAPI2 ;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 ;
26DELCONF(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 ;
41DELETE(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 ;
60HELP(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 ;
88HLPDESCR(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 ;
104HLPMULT(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 ;
142HLPROMPT(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 ;
167HLPWR(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 ;
189IEN(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 ;
213MULTSEL(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 ;
241SETVACL(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
Note: See TracBrowser for help on using the repository browser.