RASETU.m

RASETU ;HISC/DAD-Determine Order Status for an Exam Set ;6/17/97  11:17

 ;;5.0;Radiology/Nuclear Medicine;**15**;Mar 16, 1998

 ;

 ;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

 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

 .. 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)

RASETU    ;HISC/DAD-Determine Order Status for an Exam Set ;6/17/97  11:17

 +1       ;;5.0;Radiology/Nuclear Medicine;**15**;Mar 16, 1998

 +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        NEW RACNISAV

           SET RACNISAV=$GET(RACNI)

 +8       ;

 +9        NEW RACNI,RADTI,RAORDER,RAPROC,RASTATUS

 +10       SET RAORDER=$GET(^RAO(75.1,RAOIFN,0))

 +11       IF RAORDER=""

               QUIT "^^"

 +12      ;             Procedure IEN

           SET RAPROC=+$PIECE(RAORDER,U,2)

 +13      ;     Initial status

           SET RASTATUS("ORD")=$PIECE(RAORDER,U,5)

 +14      ;                  Largest status found

           SET RASTATUS("MAX")=-1

 +15      ;                  Smallest non-zero status found

           SET RASTATUS("MIN")=10

 +16      ;                   $S(All_Statuses=0:1,1:0)

           SET RASTATUS("NUL")=1

 +17      ;

 +18       SET RADTI=0

 +19       FOR 

               SET RADTI=$ORDER(^RADPT("AO",RAOIFN,RADFN,RADTI))

               IF RADTI'>0

                   QUIT 

               Begin DoDot:1

 +20               SET RACNI=0

 +21               FOR 

                       SET RACNI=$ORDER(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI))

                       IF RACNI'>0

                           QUIT 

                       Begin DoDot:2

 +22      ;skip if Exam Deletion

                           IF $DATA(RADELFLG)

                               IF RACNISAV=RACNI

                                   QUIT 

 +23                       SET RASTATUS=+$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3)

 +24                       SET RASTATUS(0)=$PIECE($GET(^RA(72,RASTATUS,0)),U,3)

                           IF RASTATUS(0)=""

                               QUIT 

 +25                       IF RASTATUS(0)>RASTATUS("MAX")

                               SET RASTATUS("MAX")=RASTATUS(0)

 +26                       IF (RASTATUS(0))

                               IF (RASTATUS(0)<RASTATUS("MIN"))

                                   Begin DoDot:3

 +27                                   SET RASTATUS("MIN")=RASTATUS(0)

 +28                                   QUIT 

                                   End DoDot:3

 +29                       IF RASTATUS(0)>0

                               SET RASTATUS("NUL")=0

 +30                       QUIT 

                       End DoDot:2

 +31               QUIT 

               End DoDot:1

 +32       QUIT RASTATUS("MIN")_"^"_RASTATUS("MAX")_"^"_RASTATUS("NUL")

 +33      ;

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)