source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RASTREQ1.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1RASTREQ1 ;HISC/CAH,GJC AISC/MJK-Cont. of RASTREQ status reqmts ck ;5/29/97 12:52
2 ;;5.0;Radiology/Nuclear Medicine;**34,85**;Mar 16, 1998;Build 4
3 ;
4 ; STUFF -- Called from UP1^RAUTL1 for editing an exam
5 ; LOOP -- Called from RASTREQ for status tracking
6 ; and from RASTREQ for cancel an exam
7 ;
8 ;Determine whether exam status can be updated to next higher status
9 ;After this subrtn is executed, the following variables will exist:
10 ; RAOR= order seq no., = -1 if not eligible for an update
11 ; RASN= new status external format (or same status if not updateable)
12 ; RASTI= ien of new status if updateable
13 ;This subrtn does not write any data to the status field, it only
14 ;checks to see what the next status would be
15 ;RABEFORE = status level BEFORE change
16 ;RAAFTER = status level AFTER change
17 ;
18 ; 06/11/2007 BAY/KAM RA*5*85 Remedy Call 174790 Change exam cancel
19 ; to allow only descendent with stub/images
20 ;
21STUFF ; initialize RAOR=-1 to assume NO change if early quit
22 S RAJ=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0)),RAOR=-1
23 S RABEFORE=$P($G(^RA(72,+$P(RAJ,U,3),0)),U,3)
24 S RAORDIFN=+$P(RAJ,"^",11),RACS=$P(RAJ,"^",24),RAPRIT=$P(RAJ,"^",2)
25 I $D(^RA(72,+$P(RAJ,"^",3),0)) S RASN=$P(^(0),"^") Q:$P(^(0),"^",3)'>0
26 I $P(RAJ,"^",6)]"" S RAF5=$P(RAJ,"^",6)
27 S RAIMGTYI=$P($G(^RADPT(DA(2),"DT",DA(1),0)),U,2),RAIMGTYJ=$P(^RA(79.2,RAIMGTYI,0),U)
28 ; set RAOR, RASN, RASTI to lowest level's, to allow event when
29 ; none of the levels meet all the requirements for that level
30LOOP S RAOR=$S($O(^RA(72,"AA",RAIMGTYJ,0))>0:$O(^(0)),1:1)
31 S RASTI=+$O(^RA(72,"AA",RAIMGTYJ,RAOR,0)),RASN=$P($G(^RA(72,+RASTI,0)),U)
32 ;
33 N RA
34 F K=0:0 S K=$O(^RA(72,"AA",RAIMGTYJ,K)) Q:K'>0 D
35 . S X="",E=+$O(^RA(72,"AA",RAIMGTYJ,K,0)) Q:E'>0
36 . I $D(^RA(72,E,0)) D
37 .. S RA(0)=$G(^RA(72,E,0)),N=$P(RA(0),"^"),RAS=$G(^RA(72,E,.1))
38 .. I '$L(RAS) S RAS="N"
39 .. D HELP1^RASTREQ I $D(X),K>RAOR S RAOR=K,RASTI=E,RASN=N
40 .. Q
41 . Q
42 S RAAFTER=RAOR
43 I $D(RASTI),RASTI=$P(RAJ,"^",3) S RAOR=-1
44 K RAZ,RAK,RAE,RAIMGTYI,RAIMGTYJ,E,RAS,RAJ,RAJ1,N,K,FL
45 Q
46CANCEL ; cancel an exam
47 S RAOR=0,RASTI=RAXX,RASN=$P($G(^RA(72,RAXX,0)),"^")
48 S RAAFTER=RAOR
49 Q:$D(RAOPT("DELETEXAM")) ; 1st chk skip, 2nd chk done already<-- delxam
50 ; check again: 'allow cancelling' and if report exists
51 ; in case Fileman enter/edit was used directly on the EXAM STATUS field
52 ; if either check fails, set RAAFTER=RABEFORE so status can't change
53 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
54 ; ok to cancel descendent exam w images if stub rpt and user has RA MGR key
55 ; 06/11/2007 *85 Added descendent check to next line
56 I $P(RAJ,U,17)'="",$$STUB^RAEDCN1($P(RAJ,U,17)),($$PSET^RAEDCN1(RADFN,RADTI,RACNI)),$D(^XUSEC("RA MGR",+$G(DUZ))) Q
57 ; can't cancel exam if report isn't stub
58 I $P(RAJ,U,17)'="" W !,"A report has been filed for this case. Therefore cancellation is not allowed !" S RAAFTER=RABEFORE
59 Q
Note: See TracBrowser for help on using the repository browser.