source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD1A.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1RAORD1A ;HISC/FPT-Request an Exam ;7/27/07 08:00
2 ;;5.0;Radiology/Nuclear Medicine;**1,86**;Mar 16, 1998;Build 7
3 ;
4 ;Call to WIN^DGPMDDCF (Supported IA #1246) from the SCREENW function
5 ;Supported IA #10039 reference to ^DIC(42
6 ;Supported IA #10040 reference to ^SC
7 ;Supported IA #10061 reference to ^VADPT
8 ;Supported IA #10103 reference to ^XLFDT
9 ;
10SCREEN(RAINPAT,RACPRS27) ; screen for active clinics/wards
11 ; This code is also called from RAORD1 (screen for the Patient Location
12 ; prompt which is a pointer to the HOSPITAL LOCATION (#44) file.)
13 ; We want to EXCLUDE from our selection the following types of
14 ; hospital locations:
15 ;
16 ; 1) Occasion of Service (OOS) locations (fld: 50.01) 'OOS' node
17 ; 2) File Area ("F") or Imaging ("I") locations (fld: 2)
18 ; 3) Inactivate Date (fld: 2505) 'I' node
19 ;
20 ; input: RAINPAT=1 if the patient is an inpatient located on a ward, else 0.
21 ; RACPRS27=1 if the environment is running CPRS GUI v27, else 0.
22 ;
23 Q:$D(^SC(+Y,"OOS"))#2 0 ; #1
24 N RA44 S RA44=$G(^SC(+Y,0)),RA44(42)=$P($G(^SC(+Y,42)),U)
25 Q:"^F^I^"[(U_$P(RA44,U,3)_U) 0 ; #2
26 ;
27 ; if the hospital location is defined as a ward set RAWARD to 1, else 0
28 N RAWARD S RAWARD=0
29 ;check the pointer to the WARD LOCATION file.
30 I RA44(42)>0 D Q:RAWARD=-1 0
31 .;Error; the HOSPITAL LOCATION cannot be of TYPE 'Clinic' & point to a ward
32 .I $P(RA44,U,3)="C" S RAWARD=-1 Q
33 .;Error; bad pointers between files 42 & 44
34 .I $P($G(^DIC(42,RA44(42),44)),U)'=+Y S RAWARD=-1 Q
35 .;ok, set ward flag...
36 .S RAWARD=1
37 .Q
38 ;
39 ; 1) if the hospital location is a ward check if we should screen by ward
40 ; 2) the hosp location=ward, facility is running v26, and we have an
41 ; outpatient quit zero (default of the $S)
42 I RAWARD Q $S(RACPRS27!RAINPAT:$$SCREENW(+Y),1:0)
43 ;
44 ; if the hospital location is a clinic, we have an inpatient, and the
45 ; facility is not running CPRS v27 return 0
46 I 'RACPRS27,(RAINPAT) Q 0
47 ;
48 ; Check INACTIVATE DATE against REACTIVATE DATE
49 ; inactivate date = reactivate date (allow)
50 ; inactivate date > reactivate date (disallow)
51 ; inactivate date < reactivate date (allow)
52 ;
53 N RASCA,RASCI,RASCINDE S RASCINDE=$G(^SC(+Y,"I"))
54 S RASCI=+$P(RASCINDE,U),RASCA=+$P(RASCINDE,U,2)
55 ;
56 Q $S(RASCI'>0:1,RASCI>DT:1,1:RASCI'>RASCA)
57 ;
58SCREENW(Y) ; check the out-of-service field of the WARD LOCATION (#42) record.
59 ;input Y: ien of the HOSPITAL LOCATION record
60 ; RAWHEN: DATE DESIRED (Not guaranteed) (file: 75.1, fld: 21) optional
61 ;output : '0' if not valid, else '1' if valid
62 N D0,DGPMOS,X
63 S D0=+$G(^SC(Y,42))
64 Q:'D0 0
65 Q:'($D(^DIC(42,D0,0))#2) 0
66 ;
67 ;WIN^DGPMDDCF (Supported IA #1246) Is the ward active?
68 ; Input
69 ; D0 "Dee zero" (req): IEN of WARD LOCATION file.
70 ; DGPMOS (opt): defaults to DT. Is the ward in service on this date?
71 ; Output
72 ; X: 1 if out of service, 0 if in service, or -1 if input variables
73 ; not defined properly. Be careful; note the difference in their
74 ; boolean definition ('0'=success) and ours ('0'=failure)
75 ;
76 S:$D(RAWHEN)#2 DGPMOS=$P(RAWHEN,".",1)
77 D WIN^DGPMDDCF
78 Q 'X ;alter 'X' (the WIN^DGPMDDCF output value) to meet our ($$SCREENW) output definition
79 ;
80PREG(RADFN,RADT) ; Subroutine will display the pregnancy prompt to the
81 ; user if the patient is between the ages of 12 - 55 inclusive.
82 ; Called from CREATE1^RAORD1.
83 ; Input : RADFN - Patient, RADT - Today's date
84 ; Output: Patient Pregnant? (yes, no, unknown or no default)
85 ; Note: (may set RAOUT if the user times out or '^' out)
86 Q:RASEX'="F" "" ; not a female
87 S:RADT="" RADT=$$DT^XLFDT()
88 N RADAYS,VADM D DEM^VADPT ; $P(VADM(3),"^") DOB of patient, internal
89 S RADAYS=$$FMDIFF^XLFDT(RAWHEN,$P(VADM(3),"^"),3)
90 Q:((RADAYS\365.25)<12) "" ; too young
91 Q:((RADAYS\365.25)>55) "" ; too old
92 N DIR,DIROUT,DIRUT,DUOUT,DTOUT S DIR(0)="75.1,13" D ^DIR
93 S:$D(DIRUT) RAOUT="^" Q:$D(RAOUT) ""
94 Q $P(Y,"^")
95 ;
96INIMOD(Y) ; check if the user has selected the same
97 ; modifier more than once when the order is requested.
98 ; The 'Request an Exam' option. Called from MODS^RAORD1
99 ; Input: 'Y' the name of the procedure modifier
100 ; Output: 'X' if the user has not entered this modifier in
101 ; the past return one (1). Else return zero (0).
102 Q:'$D(RAMOD) 1 ; must allow the selection of the first modifier
103 ; after this, it is assumed that the RAMOD array is defined.
104 N RACNT,X S X=1,RACNT=99999
105 F S RACNT=$O(RAMOD(RACNT),-1) Q:RACNT=""!(X=0) S:RAMOD(RACNT)=Y X=0
106 Q X
107 ;
Note: See TracBrowser for help on using the repository browser.