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

RASTREQ1.m

Go to the documentation of this file.
  1. RASTREQ1 ;HISC/CAH,GJC AISC/MJK-Cont. of RASTREQ status reqmts ck ;5/29/97 12:52
  1. ;;5.0;Radiology/Nuclear Medicine;**34,85**;Mar 16, 1998;Build 4
  1. ;
  1. ; STUFF -- Called from UP1^RAUTL1 for editing an exam
  1. ; LOOP -- Called from RASTREQ for status tracking
  1. ; and from RASTREQ for cancel an exam
  1. ;
  1. ;Determine whether exam status can be updated to next higher status
  1. ;After this subrtn is executed, the following variables will exist:
  1. ; RAOR= order seq no., = -1 if not eligible for an update
  1. ; RASN= new status external format (or same status if not updateable)
  1. ; RASTI= ien of new status if updateable
  1. ;This subrtn does not write any data to the status field, it only
  1. ;checks to see what the next status would be
  1. ;RABEFORE = status level BEFORE change
  1. ;RAAFTER = status level AFTER change
  1. ;
  1. ; 06/11/2007 BAY/KAM RA*5*85 Remedy Call 174790 Change exam cancel
  1. ; to allow only descendent with stub/images
  1. ;
  1. STUFF ; initialize RAOR=-1 to assume NO change if early quit
  1. S RAJ=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0)),RAOR=-1
  1. S RABEFORE=$P($G(^RA(72,+$P(RAJ,U,3),0)),U,3)
  1. S RAORDIFN=+$P(RAJ,"^",11),RACS=$P(RAJ,"^",24),RAPRIT=$P(RAJ,"^",2)
  1. I $D(^RA(72,+$P(RAJ,"^",3),0)) S RASN=$P(^(0),"^") Q:$P(^(0),"^",3)'>0
  1. I $P(RAJ,"^",6)]"" S RAF5=$P(RAJ,"^",6)
  1. S RAIMGTYI=$P($G(^RADPT(DA(2),"DT",DA(1),0)),U,2),RAIMGTYJ=$P(^RA(79.2,RAIMGTYI,0),U)
  1. ; set RAOR, RASN, RASTI to lowest level's, to allow event when
  1. ; none of the levels meet all the requirements for that level
  1. LOOP S RAOR=$S($O(^RA(72,"AA",RAIMGTYJ,0))>0:$O(^(0)),1:1)
  1. S RASTI=+$O(^RA(72,"AA",RAIMGTYJ,RAOR,0)),RASN=$P($G(^RA(72,+RASTI,0)),U)
  1. ;
  1. N RA
  1. F K=0:0 S K=$O(^RA(72,"AA",RAIMGTYJ,K)) Q:K'>0 D
  1. . S X="",E=+$O(^RA(72,"AA",RAIMGTYJ,K,0)) Q:E'>0
  1. . I $D(^RA(72,E,0)) D
  1. .. S RA(0)=$G(^RA(72,E,0)),N=$P(RA(0),"^"),RAS=$G(^RA(72,E,.1))
  1. .. I '$L(RAS) S RAS="N"
  1. .. D HELP1^RASTREQ I $D(X),K>RAOR S RAOR=K,RASTI=E,RASN=N
  1. .. Q
  1. . Q
  1. S RAAFTER=RAOR
  1. I $D(RASTI),RASTI=$P(RAJ,"^",3) S RAOR=-1
  1. K RAZ,RAK,RAE,RAIMGTYI,RAIMGTYJ,E,RAS,RAJ,RAJ1,N,K,FL
  1. Q
  1. CANCEL ; cancel an exam
  1. S RAOR=0,RASTI=RAXX,RASN=$P($G(^RA(72,RAXX,0)),"^")
  1. S RAAFTER=RAOR
  1. Q:$D(RAOPT("DELETEXAM")) ; 1st chk skip, 2nd chk done already<-- delxam
  1. ; check again: 'allow cancelling' and if report exists
  1. ; in case Fileman enter/edit was used directly on the EXAM STATUS field
  1. ; if either check fails, set RAAFTER=RABEFORE so status can't change
  1. I $D(^RA(72,+$P(RAJ,U,3),0)),$P(^(0),"^",6)'="y" W !,"This exam is in the '",$P(^(0),"^"),"' status and cannot be 'CANCELLED'" S RAAFTER=RABEFORE Q
  1. ; ok to cancel descendent exam w images if stub rpt and user has RA MGR key
  1. ; 06/11/2007 *85 Added descendent check to next line
  1. I $P(RAJ,U,17)'="",$$STUB^RAEDCN1($P(RAJ,U,17)),($$PSET^RAEDCN1(RADFN,RADTI,RACNI)),$D(^XUSEC("RA MGR",+$G(DUZ))) Q
  1. ; can't cancel exam if report isn't stub
  1. I $P(RAJ,U,17)'="" W !,"A report has been filed for this case. Therefore cancellation is not allowed !" S RAAFTER=RABEFORE
  1. Q