RASETU ;HISC/DAD-Determine Order Status for an Exam Set ;11 Apr 2018 12:07 PM
;;5.0;Radiology/Nuclear Medicine;**15,124**;Mar 16, 1998;Build 4
;
;Routine reads through all cases generated from a single order
;to gather information about the case statuses needed to determine
;what status the order should be updated to
;Input: RADFN=Patient ien <-> RAOIFN=order IEN
;Output: RASTATUS array with status info about exam set passed back
; format: min status_"^"_max status_"^"_$S(All_Statuses=0:1,1:0)
EN1(RAOIFN,RADFN) ;
Q:'($D(^RADPT("AO",RAOIFN,RADFN))\10) "^^"
; save current RACNI so we'd know which exam to skip
; in the loop below if Exam Deletion is being processed, because
; 1. the exam node hasn't been killed off yet,
; 2. the exam node may have a non-cancelled exam status,
; which would throw off the loop calculation below
;
; if called from the RA CANCEL option skip the exam
; we intend to cancel b/c at this time it does not
; have a exam status value of cancelled. The exam
; will be updated to a cancelled exam status just
; before the option has completed (patch 124)
;
;
N RACNISAV S RACNISAV=$G(RACNI)
;
N RACNI,RADTI,RAORDER,RAPROC,RASTATUS
S RAORDER=$G(^RAO(75.1,RAOIFN,0))
I RAORDER="" Q "^^"
S RAPROC=+$P(RAORDER,U,2) ; Procedure IEN
S RASTATUS("ORD")=$P(RAORDER,U,5) ; Initial status
S RASTATUS("MAX")=-1 ; Largest status found
S RASTATUS("MIN")=10 ; Smallest non-zero status found
S RASTATUS("NUL")=1 ; $S(All_Statuses=0:1,1:0)
;
S RADTI=0
F S RADTI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI)) Q:RADTI'>0 D
. S RACNI=0
. F S RACNI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI)) Q:RACNI'>0 D
.. I $D(RADELFLG),RACNISAV=RACNI Q ;skip if Exam Deletion
.. ;the variable RACAN124 is set in the ENTRY ACTION field of the [RA
.. ;CANCEL] record in the OPTION file (killed in EXIT ACTION field)
.. I $D(RACAN124),RACNISAV=RACNI Q ;p124
.. S RASTATUS=+$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3)
.. S RASTATUS(0)=$P($G(^RA(72,RASTATUS,0)),U,3) Q:RASTATUS(0)=""
.. I RASTATUS(0)>RASTATUS("MAX") S RASTATUS("MAX")=RASTATUS(0)
.. I (RASTATUS(0)),(RASTATUS(0)<RASTATUS("MIN")) D
... S RASTATUS("MIN")=RASTATUS(0)
... Q
.. I RASTATUS(0)>0 S RASTATUS("NUL")=0
.. Q
. Q
Q RASTATUS("MIN")_"^"_RASTATUS("MAX")_"^"_RASTATUS("NUL")
;
PARNT(RAOIFN,RADFN) ; Based on the patient and the order number, determine
; if the exams are part of an exam set.
; Input: 'RAOIFN' -> Order # 'RADFN' -> Patient ien
; Output: $S(Exam Set:1,1:0)
;
Q:'($D(^RADPT("AO",RAOIFN,RADFN))\10) 0
N RADTI,RARXM
S RADTI=+$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:'RADTI 0
S RARXM(0)=$G(^RADPT(RADFN,"DT",RADTI,0))
Q +$P(RARXM(0),"^",5)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRASETU 2850 printed Nov 22, 2024@17:49:45 Page 2
RASETU ;HISC/DAD-Determine Order Status for an Exam Set ;11 Apr 2018 12:07 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**15,124**;Mar 16, 1998;Build 4
+2 ;
+3 ;Routine reads through all cases generated from a single order
+4 ;to gather information about the case statuses needed to determine
+5 ;what status the order should be updated to
+6 ;Input: RADFN=Patient ien <-> RAOIFN=order IEN
+7 ;Output: RASTATUS array with status info about exam set passed back
+8 ; format: min status_"^"_max status_"^"_$S(All_Statuses=0:1,1:0)
EN1(RAOIFN,RADFN) ;
+1 if '($DATA(^RADPT("AO",RAOIFN,RADFN))\10)
QUIT "^^"
+2 ; save current RACNI so we'd know which exam to skip
+3 ; in the loop below if Exam Deletion is being processed, because
+4 ; 1. the exam node hasn't been killed off yet,
+5 ; 2. the exam node may have a non-cancelled exam status,
+6 ; which would throw off the loop calculation below
+7 ;
+8 ; if called from the RA CANCEL option skip the exam
+9 ; we intend to cancel b/c at this time it does not
+10 ; have a exam status value of cancelled. The exam
+11 ; will be updated to a cancelled exam status just
+12 ; before the option has completed (patch 124)
+13 ;
+14 ;
+15 NEW RACNISAV
SET RACNISAV=$GET(RACNI)
+16 ;
+17 NEW RACNI,RADTI,RAORDER,RAPROC,RASTATUS
+18 SET RAORDER=$GET(^RAO(75.1,RAOIFN,0))
+19 IF RAORDER=""
QUIT "^^"
+20 ; Procedure IEN
SET RAPROC=+$PIECE(RAORDER,U,2)
+21 ; Initial status
SET RASTATUS("ORD")=$PIECE(RAORDER,U,5)
+22 ; Largest status found
SET RASTATUS("MAX")=-1
+23 ; Smallest non-zero status found
SET RASTATUS("MIN")=10
+24 ; $S(All_Statuses=0:1,1:0)
SET RASTATUS("NUL")=1
+25 ;
+26 SET RADTI=0
+27 FOR
SET RADTI=$ORDER(^RADPT("AO",RAOIFN,RADFN,RADTI))
if RADTI'>0
QUIT
Begin DoDot:1
+28 SET RACNI=0
+29 FOR
SET RACNI=$ORDER(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI))
if RACNI'>0
QUIT
Begin DoDot:2
+30 ;skip if Exam Deletion
IF $DATA(RADELFLG)
IF RACNISAV=RACNI
QUIT
+31 ;the variable RACAN124 is set in the ENTRY ACTION field of the [RA
+32 ;CANCEL] record in the OPTION file (killed in EXIT ACTION field)
+33 ;p124
IF $DATA(RACAN124)
IF RACNISAV=RACNI
QUIT
+34 SET RASTATUS=+$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3)
+35 SET RASTATUS(0)=$PIECE($GET(^RA(72,RASTATUS,0)),U,3)
if RASTATUS(0)=""
QUIT
+36 IF RASTATUS(0)>RASTATUS("MAX")
SET RASTATUS("MAX")=RASTATUS(0)
+37 IF (RASTATUS(0))
IF (RASTATUS(0)<RASTATUS("MIN"))
Begin DoDot:3
+38 SET RASTATUS("MIN")=RASTATUS(0)
+39 QUIT
End DoDot:3
+40 IF RASTATUS(0)>0
SET RASTATUS("NUL")=0
+41 QUIT
End DoDot:2
+42 QUIT
End DoDot:1
+43 QUIT RASTATUS("MIN")_"^"_RASTATUS("MAX")_"^"_RASTATUS("NUL")
+44 ;
PARNT(RAOIFN,RADFN) ; Based on the patient and the order number, determine
+1 ; if the exams are part of an exam set.
+2 ; Input: 'RAOIFN' -> Order # 'RADFN' -> Patient ien
+3 ; Output: $S(Exam Set:1,1:0)
+4 ;
+5 if '($DATA(^RADPT("AO",RAOIFN,RADFN))\10)
QUIT 0
+6 NEW RADTI,RARXM
+7 SET RADTI=+$ORDER(^RADPT("AO",RAOIFN,RADFN,0))
if 'RADTI
QUIT 0
+8 SET RARXM(0)=$GET(^RADPT(RADFN,"DT",RADTI,0))
+9 QUIT +$PIECE(RARXM(0),"^",5)
