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

RAORD1A.m

Go to the documentation of this file. 
  1. RAORD1A ;HISC/FPT-Request an Exam ;05/05/09  07:45
  1.  ;;5.0;Radiology/Nuclear Medicine;**1,86,99**;Mar 16, 1998;Build 5
  1.  ;
  1.  ;Call to WIN^DGPMDDCF (Supported IA #1246) from the SCREENW function
  1.  ;Supported IA #10039 reference to ^DIC(42
  1.  ;Supported IA #10040 reference to ^SC
  1.  ;Supported IA #10061 reference to ^VADPT
  1.  ;Supported IA #10103 reference to ^XLFDT
  1.  ;Supported IA #2056 reference to ^DIQ
  1.  ;
  1. SCREEN(RAINPAT,RACPRS27) ; screen for active clinics/wards
  1.  ; This code is also called from RAORD1 (screen for the Patient Location
  1.  ; prompt which is a pointer to the HOSPITAL LOCATION (#44) file.)
  1.  ; We want to EXCLUDE from our selection the following types of
  1.  ; hospital locations:
  1.  ;
  1.  ;  1) Occasion of Service (OOS) locations (fld: 50.01) 'OOS' node
  1.  ;  2) File Area ("F") or Imaging ("I") locations (fld: 2)
  1.  ;  3) Inactivate Date (fld: 2505) 'I' node
  1.  ;
  1.  ; input: RAINPAT=1 if the patient is an inpatient located on a ward, else 0.
  1.  ;        RACPRS27=1 if the environment is running CPRS GUI v27, else 0.
  1.  ;
  1.  Q:$D(^SC(+Y,"OOS"))#2 0 ; #1
  1.  N RA44 S RA44=$G(^SC(+Y,0)),RA44(42)=$P($G(^SC(+Y,42)),U)
  1.  Q:"^F^I^"[(U_$P(RA44,U,3)_U) 0 ; #2
  1.  ;
  1.  ; if the hospital location is defined as a ward set RAWARD to 1, else 0
  1.  N RAWARD S RAWARD=0
  1.  ;check the pointer to the WARD LOCATION file.
  1.  I RA44(42)>0 D  Q:RAWARD=-1 0
  1.  .;Error; the HOSPITAL LOCATION cannot be of TYPE 'Clinic' & point to a ward
  1.  .I $P(RA44,U,3)="C" S RAWARD=-1 Q
  1.  .;Error; bad pointers between files 42 & 44
  1.  .I $P($G(^DIC(42,RA44(42),44)),U)'=+Y S RAWARD=-1 Q
  1.  .;ok, set ward flag...
  1.  .S RAWARD=1
  1.  .Q
  1.  ;
  1.  ; 1) if the hospital location is a ward check if we should screen by ward
  1.  ; 2) the hosp location=ward, facility is running v26, and we have an
  1.  ;    outpatient quit zero (default of the $S)
  1.  I RAWARD  Q $S(RACPRS27!RAINPAT:$$SCREENW(+Y),1:0)
  1.  ;
  1.  ; if the hospital location is a clinic, we have an inpatient, and the
  1.  ; facility is not running CPRS v27 return 0
  1.  I 'RACPRS27,(RAINPAT) Q 0
  1.  ;
  1.  ; Check INACTIVATE DATE against REACTIVATE DATE
  1.  ; inactivate date = reactivate date (allow)
  1.  ; inactivate date > reactivate date (disallow)
  1.  ; inactivate date < reactivate date (allow)
  1.  ;
  1.  N RASCA,RASCI,RASCINDE S RASCINDE=$G(^SC(+Y,"I"))
  1.  S RASCI=+$P(RASCINDE,U),RASCA=+$P(RASCINDE,U,2)
  1.  ;
  1.  Q $S(RASCI'>0:1,RASCI>DT:1,1:RASCI'>RASCA)
  1.  ;
  1. SCREENW(Y) ; check the out-of-service field of the WARD LOCATION (#42) record.
  1.  ;input Y: ien of the HOSPITAL LOCATION record
  1.  ; RAWHEN: DATE DESIRED (Not guaranteed) (file: 75.1, fld: 21) optional
  1.  ;output : '0' if not valid, else '1' if valid 
  1.  N D0,DGPMOS,X
  1.  S D0=+$G(^SC(Y,42))
  1.  Q:'D0 0
  1.  Q:'($D(^DIC(42,D0,0))#2) 0
  1.  ;
  1.  ;WIN^DGPMDDCF (Supported IA #1246) Is the ward active?
  1.  ; Input
  1.  ;  D0 "Dee zero" (req): IEN of WARD LOCATION file.  
  1.  ;  DGPMOS (opt): defaults to DT. Is the ward in service on this date?  
  1.  ; Output
  1.  ;  X: 1 if out of service, 0 if in service, or -1 if input variables
  1.  ;     not defined properly. Be careful; note the difference in their
  1.  ;     boolean definition ('0'=success) and ours ('0'=failure)
  1.  ;
  1.  S:$D(RAWHEN)#2 DGPMOS=$P(RAWHEN,".",1)
  1.  D WIN^DGPMDDCF
  1.  Q 'X  ;alter 'X' (the WIN^DGPMDDCF output value) to meet our ($$SCREENW) output definition
  1.  ;
  1. PREG(RADFN,RADT) ; Subroutine will display the pregnancy prompt to the
  1.  ; user if the patient is between the ages of 12 - 55 inclusive.
  1.  ; Called from CREATE1^RAORD1.
  1.  ; Input : RADFN - Patient, RADT - Today's date
  1.  ; Output: Patient Pregnant? (yes, no, unknown or no default)
  1.  ;   Note: (may set RAOUT if the user times out or '^' out)
  1.  Q:RASEX'="F" "" ; not a female
  1.  S:RADT="" RADT=$$DT^XLFDT()
  1.  N RADAYS,VADM D DEM^VADPT ; $P(VADM(3),"^") DOB of patient, internal
  1.  S RADAYS=$$FMDIFF^XLFDT(RADT,$P(VADM(3),"^"),3)   ;P#99 correct/replace variable RAWHEN to RADT
  1.  Q:((RADAYS\365.25)<12) "" ; too young
  1.  Q:((RADAYS\365.25)>55) "" ; too old
  1.  ;if RA ADDEXAM option, display and copy pregnany status from previous active order
  1.  I $D(RAOPT("ADDEXAM")) W !,"PREGNANT AT TIME OF ORDER ENTRY: ",$$GET1^DIQ(75.1,$$PRACTO^RAUTL8(RADFN),13) Q $$GET1^DIQ(75.1,$$PRACTO^RAUTL8(RADFN),13,"I")
  1.  N DIR,DIROUT,DIRUT,DUOUT,DTOUT S DIR(0)="75.1,13",DIR("A")="PREGNANT AT TIME OF ORDER ENTRY" D ^DIR
  1.  S:$D(DIRUT) RAOUT="^" Q:$D(RAOUT) ""
  1.  Q $P(Y,"^")
  1.  ;
  1. INIMOD(Y) ; check if the user has selected the same
  1.  ; modifier more than once when the order is requested.
  1.  ; The 'Request an Exam' option.  Called from MODS^RAORD1
  1.  ; Input: 'Y' the name of the procedure modifier
  1.  ; Output: 'X' if the user has not entered this modifier in
  1.  ;             the past return one (1).  Else return zero (0).
  1.  Q:'$D(RAMOD) 1 ; must allow the selection of the first modifier
  1.  ; after this, it is assumed that the RAMOD array is defined.
  1.  N RACNT,X S X=1,RACNT=99999
  1.  F  S RACNT=$O(RAMOD(RACNT),-1) Q:RACNT=""!(X=0)  S:RAMOD(RACNT)=Y X=0
  1.  Q X
  1.  ;