- 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 Mar 13, 2025@21:44:33 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)
