RASETU.m

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 ---RASETU   2850     printed  Apr 09, 2024@21:35:02                                                                                                                                                                                                      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)