| 1 | RASTREQ1 ;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 | ;
|
|---|
| 21 | STUFF ; 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
|
|---|
| 30 | LOOP 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
|
|---|
| 46 | CANCEL ; 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
|
|---|
