Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD1A.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD1A.m (modified) (2 diffs)

FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD1A.m

@@ -1 @@
-RAORD1A ;HISC/FPT-Request an Exam ;7/27/07  08:00
- ;;5.0;Radiology/Nuclear Medicine;**1,86**;Mar 16, 1998;Build 7
+RAORD1A ;HISC/FPT-Request an Exam ;9/29/97  10:40
+ ;;5.0;Radiology/Nuclear Medicine;**1**;Mar 16, 1998
  ;
- ;Call to WIN^DGPMDDCF (Supported IA #1246) from the SCREENW function
- ;Supported IA #10039 reference to ^DIC(42
- ;Supported IA #10040 reference to ^SC
- ;Supported IA #10061 reference to ^VADPT
- ;Supported IA #10103 reference to ^XLFDT
+CS ; Category of exam switch. Called from [RA ORDER EXAM] input template
+ ; when requesting an exam. User can change category of exam from
+ ; (1) inpatient to outpatient and select a clinic patient location OR
+ ; (2) outpatient to inpatient and select a ward patient location.
  ;
-SCREEN(RAINPAT,RACPRS27) ; screen for active clinics/wards
+ N RAA,RAB,X,Y K DIR
+ S RAA=$S($E(RACAT)="I":"INPATIENT",1:"OUTPATIENT")
+ S RAB=$S($E(RAA)="I":"OUTPATIENT",1:"INPATIENT")
+ W ! S DIR("A",1)="CATEGORY OF EXAM is currently "_RAA
+ S DIR("A",2)=" "
+ S DIR("A")="Want to change CATEGORY OF EXAM to "_RAB
+ S DIR(0)="Y"
+ D ^DIR K DIR
+ I $D(DIRUT) S RALIFN("OUT")="" Q
+ I Y=0 S RALIFN("NO")="" Q
+REQLOC ; select patient location
+ N DIC,RAHL,RAHLWD,RASCI W !
+ASK S DIC("A")="Patient Location: ",DIC="^SC(",DIC(0)="AEMQ"
+ I $E(RAB)="O" S DIC("S")="I $$TYPE^RAORD1A(RAB,+Y),$$SCREEN^RAORD1A" I '$D(RAOERRFG) S:$P($G(^SC(+RALIFN,0)),U,3)="C" DIC("B")=$P(^SC(+RALIFN,0),U,1)
+ I $E(RAB)="I" S DIC("S")="I $$TYPE^RAORD1A(RAB,+Y),$$SCREEN^RAORD1A" I '$D(RAOERRFG) S:$P($G(^SC(+RALIFN,0)),U,3)="W" DIC("B")=$P(^SC(+RALIFN,0),U,1)
+ D ^DIC K DIC
+ I +Y'>0 S RALIFN("OUT")="" Q
+ I $E(RAB)="I" S RAHLWD=+$G(^SC(+Y,42)) I RAHLWD S RAHL=+$G(^DIC(42,RAHLWD,44)) I RAHL,RAHL'=+Y W !!,*7,"This Hospital Location points to ",$P($G(^DIC(42,+Y,0)),U,1) G ASK
+ S RALIFN=+Y,RACAT=RAB
+ Q:$D(RAOERFLG)  ;quit if REQLOC was called from REQLOC1 
+ K:$E(RAB)="O" RAWARD
+ S:$E(RAB)="I" RAWARD=$P(^SC(+Y,0),U,1)
+ Q
+SCREEN() ; screen for active clinics/wards
  ; This code is also called from RAORD1 (screen for the Patient Location
- ; prompt which is a pointer to the HOSPITAL LOCATION (#44) file.)
- ; We want to EXCLUDE from our selection the following types of
- ; hospital locations:
+ ; prompt)
+ Q:$D(^SC(+Y,"OOS")) 0 ; don't want Occasion Of Service (OOS) locations
+ N RA44 S RA44=$G(^SC(+Y,0))
+ Q:"FI"[$P(RA44,"^",3) 0 ; File areas & Imaging Types are not selectable
+ I $P(RA44,"^",3)="W" G SCREENW ; ward check
+ ; check inactivation & reactivation dates of clinic/operating
+ ; room in file #44
+ I '$D(^SC(+Y,"I")) Q 1
+ ; This Hospital Location has an "I" node.  We have to check INACTIVATE
+ ; DATE & REACTIVATE DATE fields to determine if the Hosp. Location is
+ ; active.
+ N RASCA S RASCI=$G(^SC(+Y,"I")),RASCA=+$P(RASCI,"^",2)
+ ; RASCA is the REACTIVATE DATE
+ ; Not selectable if REACTIVATE DATE is beyond DT or null (0).
+ S RASCA=$S(RASCA=0:0,RASCA>DT:0,1:RASCA)
+ I +RASCI=0 Q 1 ; no INACTIVATE DATE
+ I +RASCI>DT Q 1 ; INACTIVATE DATE exceeds today's date
+ ; Check INACTIVATE DATE against REACTIVATE DATE
+ ; if REACTIVATE DATE exists and is not after (or is equal to) the
+ ; INACTIVATE DATE the location is not active.
+ I RASCA,(+RASCI<RASCA) Q 1
+ Q 0
+SCREENW ; check currently out-of-service field of ward file (#42)
+ N D0,DGPMOS,X
+ S D0=+$G(^SC(+Y,42)) I 'D0 Q 0
+ I '$D(^DIC(42,D0,0)) Q 0
+ S:$D(RAWHEN) DGPMOS=$P(RAWHEN,".",1)
+ D WIN^DGPMDDCF
+ S X=$S(X=0:1,1:0)
+ Q X
  ;
- ;  1) Occasion of Service (OOS) locations (fld: 50.01) 'OOS' node
- ;  2) File Area ("F") or Imaging ("I") locations (fld: 2)
- ;  3) Inactivate Date (fld: 2505) 'I' node
+REQLOC1 ; Requesting Location does not go with Category of Exam
+ ; Category of Exam = Inpatient  -> Requesting Location = Ward
+ ; Category of Exam = Outpatient -> Requesting Location = Clinic
+ ; Called from [RA OERR EDIT] and [RA QUICK EXAM ORDER] input templates
+ W !!?5,*7,"When the CATEGORY OF EXAM is "_$S(RAX="I":"Inpatient",1:"Outpatient")_" the REQUESTING LOCATION",!?5,"must be a "_$S(RAX="I":"Ward",1:"Clinic")_" or OR.",!
+ W !?5,"The current REQUESTING LOCATION is ",$S($P($G(^SC(+RALIFN,0)),U,1)]"":$P($G(^SC(+RALIFN,0)),U,1),1:"Unknown"),!
+ N RAB,X,Y
+ S RAX=$S(RAX="I":"INPATIENT",1:"OUTPATIENT"),RAB=RAX,RAOERRFG=""
+ D REQLOC
+ K RAOERRFG
+ Q
+TYPE(RACAT,Y) ; Indicates whether a Hospital Location is a valid selection.
+ ; If the patient is an inpatient, all operating room location types &
+ ; all wards are valid selections.  If the patient is an outpatient, all
+ ; operating room location types & all clinics are valid selections.
+ ; Input Variables: RACAT=$S(Inpatient:"I",1:"O") "O" for outpatient
+ ; Input Variables: Y=IEN of entries in the Hospital Location file
+ ; This fuction returns 1 if valid, 0 if not valid
+ N RAX S RAX=0
+ I $E(RACAT,1)="I" D
+ . I $P(^SC(+Y,0),U,3)="W"!($P(^SC(+Y,0),U,3)="OR") S RAX=1
+ . Q
+ E  D
+ . I $P(^SC(+Y,0),U,3)="C"!($P(^SC(+Y,0),U,3)="OR") S RAX=1
+ . Q
+ Q RAX
+MATCH(RACAT,RALOC) ; Detect mismatched req loc type and cat. of exam
+ ;                 and return code for correct category of exam
+ ; Input Variable: 'RACAT' - the value for the 'Category Of Exam' field.
+ ;                 Only passed in if either 'I' or 'O'.
+ ;                 'RALOC' - The ien of the 'Requesting Location'
+ ; Output: correct category (I or O)_"^"_$S(Category='I':ward,1:"")
  ;
- ; input: RAINPAT=1 if the patient is an inpatient located on a ward, else 0.
- ;        RACPRS27=1 if the environment is running CPRS GUI v27, else 0.
- ;
- Q:$D(^SC(+Y,"OOS"))#2 0 ; #1
- N RA44 S RA44=$G(^SC(+Y,0)),RA44(42)=$P($G(^SC(+Y,42)),U)
- Q:"^F^I^"[(U_$P(RA44,U,3)_U) 0 ; #2
- ;
- ; if the hospital location is defined as a ward set RAWARD to 1, else 0
- N RAWARD S RAWARD=0
- ;check the pointer to the WARD LOCATION file.
- I RA44(42)>0 D  Q:RAWARD=-1 0
- .;Error; the HOSPITAL LOCATION cannot be of TYPE 'Clinic' & point to a ward
- .I $P(RA44,U,3)="C" S RAWARD=-1 Q
- .;Error; bad pointers between files 42 & 44
- .I $P($G(^DIC(42,RA44(42),44)),U)'=+Y S RAWARD=-1 Q
- .;ok, set ward flag...
- .S RAWARD=1
- .Q
- ;
- ; 1) if the hospital location is a ward check if we should screen by ward
- ; 2) the hosp location=ward, facility is running v26, and we have an
- ;    outpatient quit zero (default of the $S)
- I RAWARD  Q $S(RACPRS27!RAINPAT:$$SCREENW(+Y),1:0)
- ;
- ; if the hospital location is a clinic, we have an inpatient, and the
- ; facility is not running CPRS v27 return 0
- I 'RACPRS27,(RAINPAT) Q 0
- ;
- ; Check INACTIVATE DATE against REACTIVATE DATE
- ; inactivate date = reactivate date (allow)
- ; inactivate date > reactivate date (disallow)
- ; inactivate date < reactivate date (allow)
- ;
- N RASCA,RASCI,RASCINDE S RASCINDE=$G(^SC(+Y,"I"))
- S RASCI=+$P(RASCINDE,U),RASCA=+$P(RASCINDE,U,2)
- ;
- Q $S(RASCI'>0:1,RASCI>DT:1,1:RASCI'>RASCA)
- ;
-SCREENW(Y) ; check the out-of-service field of the WARD LOCATION (#42) record.
- ;input Y: ien of the HOSPITAL LOCATION record
- ; RAWHEN: DATE DESIRED (Not guaranteed) (file: 75.1, fld: 21) optional
- ;output : '0' if not valid, else '1' if valid 
- N D0,DGPMOS,X
- S D0=+$G(^SC(Y,42))
- Q:'D0 0
- Q:'($D(^DIC(42,D0,0))#2) 0
- ;
- ;WIN^DGPMDDCF (Supported IA #1246) Is the ward active?
- ; Input
- ;  D0 "Dee zero" (req): IEN of WARD LOCATION file.  
- ;  DGPMOS (opt): defaults to DT. Is the ward in service on this date?  
- ; Output
- ;  X: 1 if out of service, 0 if in service, or -1 if input variables
- ;     not defined properly. Be careful; note the difference in their
- ;     boolean definition ('0'=success) and ours ('0'=failure)
- ;
- S:$D(RAWHEN)#2 DGPMOS=$P(RAWHEN,".",1)
- D WIN^DGPMDDCF
- Q 'X  ;alter 'X' (the WIN^DGPMDDCF output value) to meet our ($$SCREENW) output definition
+ N RA44 S RA44=$G(^SC(+RALOC,0))
+ I $E(RACAT,1)'="I",$E(RACAT,1)'="O" Q RACAT
+ I $E(RACAT,1)="O",$P(RA44,U,3)'="C",($P(RA44,U,3)'="OR") S RACAT="INPATIENT"
+ I $E(RACAT,1)="I",$P(RA44,U,3)'="W",($P(RA44,U,3)'="OR") S RACAT="OUTPATIENT"
+ Q RACAT_"^"_$S($E(RACAT,1)="I":$P(RA44,"^"),1:"")
  ;
 PREG(RADFN,RADT) ; Subroutine will display the pregnancy prompt to the
@@ -105 +129 @@
  F  S RACNT=$O(RAMOD(RACNT),-1) Q:RACNT=""!(X=0)  S:RAMOD(RACNT)=Y X=0
  Q X
- ;