source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPSAPI3.m@ 1240

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

initial load of WorldVistAEHR
File size: 8.4 KB
RevLine 
[613]1RAPSAPI3 ;HOIFO/SG - INPUT TEMPLATE UTILS FOR PHARM. POINTERS ; 4/13/07 10:45am
2 ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #2056 GET1^DIQ
7 ; #2052 FIELD^DID
8 ; #2055 ROOT^DILFD
9 ; #10007 DO^DIC1
10 ; #4551 DIC^PSSDI looks up & screens records from file #50
11 ;
12 Q
13 ;
14 ;***** RETURNS IEN OF THE DEFAULT RECORD OF THE MULTIPLE
15 ;
16 ; Note: This is an internal function. Do not call it from outside
17 ; of this routine.
18 ;
19DFLTREC() ;
20 Q $S($G(RADESCR("SELCNT"))'>1:+$O(@(RADESCR("ROOT"))@(" "),-1),1:0)
21 ;
22 ;***** EDITS RADIOLOGY SCREENED POINTER TO THE DRUG FILE (#50)
23 ;
24 ; RADESCR Flags that control execution
25 ; "P" Medications
26 ; "R" Radiopharms
27 ;
28 ; RAIENS IENS of the edited record (e.g. "1,")
29 ;
30 ; RAFILE Radiology file number (e.g. 71.9)
31 ;
32 ; RAFIELD Field number of the pointer to the file #50 (e.g. 5)
33 ;
34 ; [RADATE] Date for screening medications
35 ;
36 ; Return values:
37 ; "" Field was empty and the value has not changed
38 ; "@" Clear the field
39 ; "^" Exit the record editing
40 ; ^Field "^"-jump to other field (e.g. "^KIT")
41 ; `IEN Pointer to the record of the file #50 (e.g. "`234")
42 ;
43RXEDIT(RADESCR,RAIENS,RAFILE,RAFIELD,RADATE) ;
44 N PSSDIY,RA50IEN,RABUF,RADIC,RAENTRY,RALABEL,RAMSG,RARC,RAVACL,TMP
45 ;=== Validate and parse parameters
46 S RADESCR=$G(RADESCR)
47 S:(RADESCR'["P")&(RADESCR'["R") RADESCR=RADESCR_"P"
48 S:$G(RADATE)'>0 RADATE=""
49 ;
50 ;=== Get field info from the data dictionary
51 D FIELD^DID(RAFILE,RAFIELD,,"LABEL;MULTIPLE-VALUED","RABUF","RAMSG")
52 I $G(RABUF("MULTIPLE-VALUED")) S TMP=$T(+0) D Q "^"
53 . W !!,"$$RXEDIT^"_TMP_" cannot be used for multiples!"
54 . W !,"Use $$RXMEDIT^"_TMP_" instead.",!
55 S RALABEL=RABUF("LABEL")_": "
56 K RABUF
57 ;
58 ;===
59 F D Q:$D(RARC)
60 . ;--- Get the current internal value of the field
61 . S RA50IEN=+$$GET1^DIQ(RAFILE,RAIENS,RAFIELD,"I",,"RAMSG")
62 . ;--- Get the external value of the field
63 . I RA50IEN>0 D
64 . . S TMP=$$EN1^RAPSAPI(RA50IEN,.01)
65 . . S:TMP="" TMP=RA50IEN
66 . E S TMP=""
67 . ;--- Display the prompt and get a user response
68 . W !,RALABEL_$S(TMP'="":TMP_"// ",1:"")
69 . R RAENTRY:DTIME E S RARC="^" Q
70 . ;--- Keep the current value
71 . I RAENTRY="" S RARC=$S(RA50IEN>0:"`"_RA50IEN,1:"") Q
72 . ;--- Exit or "^"-jump
73 . I RAENTRY?1"^".E S RARC=RAENTRY Q
74 . ;--- @ entered
75 . I RAENTRY="@" S:$$DELCONF^RAPSAPI2(+RAIENS,RA50IEN) RARC="@" Q
76 . ;--- ? or ?? entered
77 . D:RAENTRY?1"?".1"?" HELP^RAPSAPI2(RAENTRY,RAFILE,RAFIELD)
78 . ;--- Something else entered
79 . S RADIC="^PSDRUG(",RADIC(0)="EQMZ",RADIC("A")=RALABEL
80 . D SETVACL^RAPSAPI2(RADESCR)
81 . D DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADATE,,.RAVACL)
82 . S:Y>0 RARC="`"_(+Y)
83 ;
84 ;===
85 Q RARC
86 ;
87 ;***** EDITS .01 POINTER (MULTIPLE) TO THE DRUG FILE (#50)
88 ;
89 ; .RADESCR( Flags that control execution
90 ; "P" Medications
91 ; "R" Radiopharms
92 ;
93 ; When this function finishes editing the multiple,
94 ; this parameter is KILL'ed automatically.
95 ;
96 ; Subscripts of this parameter store the state between
97 ; calls. Do not access them outside of this function!
98 ; The only exception is the RADESCR("RESULT") that
99 ; stores the latest value returned by the function.
100 ;
101 ; "EDITONLY") The function is in "edit-only" mode of the .01 field
102 ; of the multiple.
103 ;
104 ; "FLDNAME") Name of the .01 field of the multiple
105 ; "MLTNAME") Name of the multiple
106 ; "RESULT") The latest result returned by this function
107 ; "ROOT") Closed root of the multiple's sub-file
108 ; "SCRDATE") Date for screening meds (value of the RADATE param.)
109 ;
110 ; "SELCNT") Number of times the function was called in selection
111 ; mode ($G("EDITONLY")=0) without resetting the state.
112 ;
113 ; "SUBFILE") Number of the multiple's sub-file
114 ;
115 ; RAIENS IENS of a multiple/subfile (e.g. ",1,") or IENS
116 ; of a record of the multiple (e.g. "2,3,"). In the
117 ; latter case, the function switches to "edit-only"
118 ; mode.
119 ;
120 ; [RAFILE] Radiology file number (e.g. 70.2)
121 ;
122 ; [RAMULT] Field number of the multiple (e.g. 100)
123 ;
124 ; [RADATE] Date for screening medications
125 ;
126 ; Return values:
127 ; "" Exit the multiple
128 ; "@" Delete the value of the .01 field
129 ; "^" Exit the record editing
130 ; ^Field "^"-jump to other field (e.g. "^KIT")
131 ; `IEN Pointer to the record of the file #50 or IEN of
132 ; an existing record of the multiple (e.g. "`234")
133 ;
134RXMEDIT(RADESCR,RAIENS,RAFILE,RAMULT,RADATE) ;
135 N RASUBIEN ; IEN of the record of the multiple
136 ;
137 N PSSDIY,RA50IEN,RADEFDIS,RADEFVAL,RADIC,RADUP,RAENTRY,RAMIEN,RAMSG,RARC,RAVACL,RAXNODE,TMP
138 ;=== Validate and parse parameters
139 S RADESCR=$G(RADESCR)
140 S:(RADESCR'["P")&(RADESCR'["R") RADESCR=RADESCR_"P"
141 S RASUBIEN=+$P(RAIENS,","),$P(RAIENS,",")=""
142 ;
143 ;=== Get file/field info from the data dictionary
144 I '$G(RADESCR("SELCNT")) D I $D(RARC) K RADESCR Q RARC
145 . N RABUF,SUBFILE
146 . S TMP="LABEL;MULTIPLE-VALUED;SPECIFIER"
147 . D FIELD^DID(RAFILE,RAMULT,,TMP,"RABUF","RAMSG")
148 . ;---
149 . I '$G(RABUF("MULTIPLE-VALUED")) S TMP=$T(+0) D S RARC="^" Q
150 . . W !!,"$$RXMEDIT^"_TMP_" cannot be used for single-value fields!"
151 . . W !,"Use $$RXEDIT^"_TMP_" instead.",!
152 . ;---
153 . S RADESCR("MLTNAME")=RABUF("LABEL")
154 . S (RADESCR("SUBFILE"),SUBFILE)=+RABUF("SPECIFIER")
155 . S RADESCR("FLDNAME")=$$GET1^DID(SUBFILE,.01,,"LABEL",,"RAMSG")
156 . S RADESCR("ROOT")=$$ROOT^DILFD(SUBFILE,RAIENS,1)
157 . S RADESCR("SCRDATE")=$S($G(RADATE)>0:+RADATE,1:"")
158 ;
159 ;=== Determine the execution mode
160 I RASUBIEN'>0 D K RADESCR("EDITONLY")
161 . S RADESCR("SELCNT")=$G(RADESCR("SELCNT"))+1
162 . S RASUBIEN=$$DFLTREC()
163 E S RADESCR("EDITONLY")=1
164 ;
165 ;===
166 F D Q:$D(RARC)
167 . ;--- Get the current internal value of the .01 field
168 . I RASUBIEN>0 D
169 . . S TMP=RASUBIEN_RAIENS
170 . . S RA50IEN=+$$GET1^DIQ(RADESCR("SUBFILE"),TMP,.01,"I",,"RAMSG")
171 . E S RA50IEN=0
172 . ;--- Get the external value of the .01 field
173 . I RA50IEN>0 D
174 . . S RADEFVAL=$$EN1^RAPSAPI(RA50IEN,.01)
175 . . S:RADEFVAL="" RADEFVAL=RA50IEN
176 . E S RADEFVAL=""
177 . S RADEFDIS=": "_$S(RADEFVAL'="":RADEFVAL_"// ",1:"")
178 . ;--- Display the prompt and get a user response
179 . W ! W:'$G(RADESCR("EDITONLY")) "Select "
180 . W RADESCR("FLDNAME")_RADEFDIS
181 . R RAENTRY:DTIME E S RARC="^" Q
182 . ;--- Keep the current value or exit if there is no current record
183 . I RAENTRY="" D Q
184 . . I RASUBIEN'>0 S RARC="" Q
185 . . ;--- If selecting a record, return IEN in the multiple
186 . . I '$G(RADESCR("EDITONLY")) S RARC="`"_RASUBIEN Q
187 . . ;--- If just editing the .01 field, return IEN in the DRUG file
188 . . S RARC=$S(RA50IEN>0:"`"_RA50IEN,1:"")
189 . ;--- Exit or "^"-jump
190 . I RAENTRY?1"^".E S RARC=RAENTRY Q
191 . ;--- @ entered
192 . I RAENTRY="@" D:$$DELCONF^RAPSAPI2(RASUBIEN,RA50IEN) Q
193 . . ;--- Let the FileMan delete the value of the .01 field
194 . . I $G(RADESCR("EDITONLY")) S RARC="@" Q
195 . . ;--- Delete the record at "Select ..." prompt
196 . . D DELETE^RAPSAPI2(RADESCR("SUBFILE"),RASUBIEN_RAIENS)
197 . . S RASUBIEN=$$DFLTREC()
198 . ;--- Record IEN entered
199 . I RAENTRY?1"`"1.N S:$$IEN^RAPSAPI2(.RAENTRY) RARC=RAENTRY Q
200 . ;--- Add duplicate entry (value in double quotes)
201 . I RAENTRY?1""""1.E1"""" D S RADUP=1
202 . . S RAENTRY=$E(RAENTRY,2,$L(RAENTRY)-1) ; Remove quotes
203 . E S RADUP=0
204 . ;--- ? or ?? entered
205 . I RAENTRY?1"?".1"?" D S RADUP=0
206 . . I $G(RADESCR("EDITONLY")) D Q
207 . . . D HELP^RAPSAPI2(RAENTRY,RADESCR("SUBFILE"),.01)
208 . . D HELP^RAPSAPI2(RAENTRY,RAFILE,RAMULT,RAIENS)
209 . ;--- Everything else
210 . S RADIC="^PSDRUG(",RADIC(0)="EQMZ"
211 . S RADIC("A")=RADESCR("FLDNAME")_": "
212 . D SETVACL^RAPSAPI2(RADESCR)
213 . D DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADESCR("SCRDATE"),,.RAVACL)
214 . Q:Y'>0
215 . ;--- If just editing the .01 field, return IEN in the DRUG file
216 . I $G(RADESCR("EDITONLY")) S RARC="`"_(+Y) Q
217 . ;--- Try to find the drug in the multiple.
218 . ;--- If not found or duplication is forced, add the drug.
219 . S RAXNODE=$NA(@(RADESCR("ROOT"))@("B",+Y))
220 . S RAMIEN=+$O(@RAXNODE@(0))
221 . I (RAMIEN'>0)!RADUP S RARC="""`"_(+Y)_"""" Q
222 . ;--- Otherwise, select a record from the multiple.
223 . I $O(@RAXNODE@(RAMIEN))>0 D Q:RAMIEN'>0
224 . . S RAMIEN=$$MULTSEL^RAPSAPI2(RAXNODE,RADESCR("MLTNAME"),$P(Y,U,2))
225 . S RARC="`"_RAMIEN
226 ;
227 ;=== Cleanup
228 S RADESCR("RESULT")=RARC
229 D:'$G(RADESCR("EDITONLY"))
230 . K:(RARC="^")!((RARC="")&(RA50IEN'>0)) RADESCR
231 Q RARC
Note: See TracBrowser for help on using the repository browser.