RAMAGU06 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM STATUS UTILS) ; 2/6/09 11:21am
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
; Exam Status Descriptor
; ----------------------
;
; ^01: IEN of the status record in the EXAMINATION STATUS
; file (#72).
;
; ^02: Status name (value of the NAME field (.01)
; of the file #72.
;
; ^03: Status code. Currently, the value of the ORDER field (3)
; of the file #72 is used. As the result, only 0 (cancelled),
; 1 (waiting for exam), and 9 (completed) codes are the same
; at all sites and all imaging types. All others are site
; and/or imaging type specific.
;
; ^04: VistARAD category (field 9 of the file #72).
;
; ^05: Generic exam status characteristics (can be combined):
; E 'Examined' HL7 message is generated
; R Report is required
;
; These flags have the same meaning at all sites for all
; imaging types.
;
Q
;
;***** RETURNS A DESCRIPTOR OF THE EXAM STATUS
;
; STATUS IEN of the status record in the EXAMINATION STATUS
; file (#72) or the status order number in the 3rd.
; ^-piece.
;
; First, the function checks the 1st ^-piece. If it
; is greater than 0, then it is used as IEN of the
; status.
;
; Otherwise, the third piece is checked for a status
; order number (value of the ORDER field (3) of the
; EXAMINATION STATUS file (#72)). The RAIMGTYI
; parameter must reference a valid imaging type in
; this case.
;
; Only 0 (cancelled), 1 (waiting for exam), and 9
; (completed) order numbers are the same at all sites
; and all imaging types. All others are site and/or
; imaging type specific.
;
; [RAIMGTYI] Imaging type IEN (file #79.2). This parameter is
; required if a status is referenced by the order
; number (see above).
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; >0 Exam status descriptor (see the comment in
; the beginning of this routine)
;
EXMSTINF(STATUS,RAIMGTYI) ;
N IENS,RABUF,RAMSG,RC,TMP
S RC=0
;
;=== Search for status record
I STATUS'>0 D Q:RC<0 RC
. N IEN72,RAIMGTY,RANODE
. I $P(STATUS,U,3)'?1.N S RC=$$IPVE^RAERR("STATUS") Q
. I $G(RAIMGTYI)'>0 S RC=$$IPVE^RAERR("RAIMGTYI") Q
. ;--- Get the imaging type name
. S IENS=+RAIMGTYI_","
. S RAIMGTY=$$GET1^DIQ(79.2,IENS,.01,,,"RAMSG")
. I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,70.02,IENS) Q
. I RAIMGTY="" S RC=$$ERROR^RAERR(-19,,70.02,IENS,2) Q
. ;--- Search for status record by status order number
. S RANODE=$NA(^RA(72,"AA",RAIMGTY,+$P(STATUS,U,3)))
. S IEN72=+$O(@RANODE@(""))
. I IEN72'>0 S RC=$$IPVE^RAERR("STATUS") Q
. ;--- Check if there is another status with the same order number
. I $O(@RANODE@(IEN72))>0 D Q
. . S RC=$$ERROR^RAERR(-14,,"status order number",STATUS)
. S STATUS=IEN72
;
;=== Load status properties
S IENS=+STATUS_","
D GETS^DIQ(72,IENS,".01;.111;3;8;9","I","RABUF","RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,72,IENS)
;
;=== Build basic descriptor
S $P(STATUS,U,2)=$G(RABUF(72,IENS,.01,"I")) ; STATUS
S $P(STATUS,U,3)=$G(RABUF(72,IENS,3,"I")) ; ORDER
S $P(STATUS,U,4)=$G(RABUF(72,IENS,9,"I")) ; VISTARAD CATEGORY
;
;=== Add generic characteristics
S TMP=""
;--- REPORT ENTERED REQUIRED?
S:$G(RABUF(72,IENS,.111,"I"))="Y" TMP=TMP_"R"
;--- GENERATE EXAMINED HL7 MESSAGE
S:$G(RABUF(72,IENS,8,"I"))="Y" TMP=TMP_"E"
S $P(STATUS,U,5)=TMP
;
;===
Q STATUS
;
;***** RETURNS REQUIREMENTS FOR THE EXAM STATUS
;
; EXMSTIEN IEN of the current status (IEN in the file #72)
;
; [RAPROCIEN] Radiology procedure IEN (file #71). This parameter
; is required to determine exact nuclear medicine
; requirements (result pieces from 17 to 25).
;
; By default (+$G(RAPROCIEN)=0), this function cannot
; examine the SUPPRESS RADIOPHARM PROMPT field (2) of
; the RAD/NUC MED PROCEDURES file (#71) and might
; indicate that some nuclear medicine data is required
; even if it is not.
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; ... Status requirements descriptor
; ^01: TECHNOLOGIST REQUIRED? {0|1}
; ^02: RESIDENT OR STAFF REQUIRED? {0|1}
; ^03: DETAILED PROCEDURE REQUIRED? {0|1}
; ^04: FILM ENTRY REQUIRED? {0|1}
; ^05: DIAGNOSTIC CODE REQUIRED? {0|1}
; ^06: CAMERA/EQUIP/RM REQUIRED? {0|1}
; ^07: reserved
; ^08: reserved
; ^09: reserved
; ^10: reserved
; ^11: REPORT ENTERED REQUIRED? {0|1}
; ^12: VERIFIED REPORT REQUIRED? {0|1}
; ^13: PROCEDURE MODIFIERS REQUIRED? {0|1}
; ^14: CPT MODIFIERS REQUIRED? {0|1}
; ^15: reserved
; ^16: IMPRESSION REQUIRED? {0|1}
; ^17: RADIOPHARMS/DOSAGES REQUIRED? {0|1}
; ^18: reserved
; ^19: ACTIVITY DRAWN REQUIRED? {0|1}
; ^20: DRAWN DT/TIME/PERSON REQUIRED? {0|1}
; ^21: ADM DT/TIME/PERSON REQUIRED? {0|1}
; ^22: reserved
; ^23: ROUTE/SITE REQUIRED? {0|1}
; ^24: LOT NO. REQUIRED? {0|1}
; ^25: VOLUME/FORM REQUIRED? {0|1}
;
EXMSTREQ(EXMSTIEN,RAPROCIEN) ;
Q:$D(^RA(72,+EXMSTIEN))<10 $$IPVE^RAERR("EXMSTIEN")
Q:$G(RAPROCIEN)<0 $$IPVE^RAERR("RAPROCIEN")
N BUF,I,IENS,RABUF,RAIMGTYI,RAMSG,RC,RESULT,TMP
S RESULT="",RC=0
;
;=== General requirements
S BUF=$G(^RA(72,+EXMSTIEN,.1))
F I=1:1:6,11:1:14,16 S $P(RESULT,U,I)=($P(BUF,U,I)="Y")
;
;=== Nuclear Medicine requirements
S BUF=$G(^RA(72,+EXMSTIEN,.5))
;--- If the exam status does not indicate that radiopharmaceuticals
; are required, then there is no need for any further checks.
;--- See the EN1^RASTREQN procedure for more details.
I $P(BUF,U)="Y" D Q:RC<0 RC
. ;--- Get the imaging type IEN from the exam status
. S IENS=+EXMSTIEN_","
. S RAIMGTYI=+$$GET1^DIQ(72,IENS,7,"I",,"RAMSG")
. I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,72,IENS) Q
. ;--- If the RADIOPHARMACEUTICALS USED? of the imaging type
. ;--- is not set to Yes, then requirements are voided.
. S IENS=RAIMGTYI_","
. S TMP=$$GET1^DIQ(79.2,IENS,5,"I",,"RAMSG")
. I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,79.2,IENS) Q
. I TMP'="Y" S BUF="" Q
. ;--- If a procedure is passed and its SUPPRESS RADIOPHARM PROMPT
. ; field (2) in the RAD/NUC MED PROCEDURES file (#71) stores 1,
. ;--- then the radiopharmaceutical requirements are voided.
. I $G(RAPROCIEN)>0 D Q:RC<0
. . S IENS=+RAPROCIEN_","
. . D GETS^DIQ(71,IENS,"2;12","I","RABUF","RAMSG")
. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,71,IENS) Q
. . I +$G(RABUF(71,IENS,12,"I"))'=RAIMGTYI D Q
. . . S RC=$$ERROR^RAERR(-55)
. . S:$G(RABUF(71,IENS,2,"I")) BUF=""
E S BUF=""
F I=1,3,4,5,7,8,9 S $P(RESULT,U,16+I)=($P(BUF,U,I)="Y")
;
;===
Q RESULT
;
;***** RETURNS THE STATUS THAT SHOULD BE USED AS "EXAMINED"
;
; EXMSTIEN IEN of the current status (IEN in the file #72)
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; "" Requested exam status cannot be found. The current
; status is already at or past "EXAMINED".
; >0 Exam status descriptor (see the routine comment above)
;
; This function searches for a status that follows the one defined
; by the EXMSTIEN parameter and has "E" (Examined) in the VISTARAD
; CATEGORY field (9).
;
GETEXMND(EXMSTIEN) ;
Q $$NXTEXMST(+EXMSTIEN,"E")
;
;***** RETURNS THE NEXT EXAM STATUS
;
; EXMSTIEN IEN of the status record in the EXAMINATION STATUS
; file (#72).
;
; [VISTARADCAT] Internal value of the required VistA RAD category.
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; "" Requested exam status cannot be found after the status
; referenced by the EXMSTIEN.
; >0 Exam status descriptor (see the routine comment above)
;
NXTEXMST(EXMSTIEN,VISTARADCAT) ;
N IEN72,IENS,ORDER,ORDI,RABUF,RAIMGTY,RAMSG,RC,TMP,X,XREF
Q:$G(EXMSTIEN)'>0 $$IPVE^RAERR("EXMSTIEN")
S RC=0
;=== Get the order number and type of imaging
S IENS=+EXMSTIEN_","
D GETS^DIQ(72,IENS,"3;7",,"RABUF","RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,72,IENS)
S ORDER=+$G(RABUF(72,IENS,3))
S RAIMGTY=$G(RABUF(72,IENS,7))
K RABUF
;=== Search for the next status
S XREF=$NA(^RA(72,"AA",RAIMGTY))
I $G(VISTARADCAT)'="" D
. S ORDI=""
. F S ORDI=$O(@XREF@(ORDI)) Q:ORDI="" D Q:RC
. . S IEN72=""
. . F S IEN72=$O(@XREF@(ORDI,IEN72)) Q:IEN72="" D Q:RC
. . . S TMP=$$GET1^DIQ(72,IEN72_",",9,"I",,"RAMSG")
. . . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,72,IEN72_",") Q
. . . S:TMP=VISTARADCAT RC=$$EXMSTINF(IEN72)
. ;--- If nothing has been found, then "E:Examined" category has
. ;--- not been assigned to a record of this imaging type yet.
. I 'RC S RC=$$ERROR^RAERR(-59,,VISTARADCAT,RAIMGTY) Q
. ;--- Check if the new status follows the source one
. S:$P(RC,U,3)'>ORDER RC=""
E D
. S ORDI=$O(@XREF@(ORDER)) Q:ORDI=""
. S IEN72=$O(@XREF@(ORDI,"")) Q:IEN72=""
. S RC=$$EXMSTINF(IEN72)
;===
Q RC
RAMAGU06 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM STATUS UTILS) ; 2/6/09 11:21am
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 ; Exam Status Descriptor
+4 ; ----------------------
+5 ;
+6 ; ^01: IEN of the status record in the EXAMINATION STATUS
+7 ; file (#72).
+8 ;
+9 ; ^02: Status name (value of the NAME field (.01)
+10 ; of the file #72.
+11 ;
+12 ; ^03: Status code. Currently, the value of the ORDER field (3)
+13 ; of the file #72 is used. As the result, only 0 (cancelled),
+14 ; 1 (waiting for exam), and 9 (completed) codes are the same
+15 ; at all sites and all imaging types. All others are site
+16 ; and/or imaging type specific.
+17 ;
+18 ; ^04: VistARAD category (field 9 of the file #72).
+19 ;
+20 ; ^05: Generic exam status characteristics (can be combined):
+21 ; E 'Examined' HL7 message is generated
+22 ; R Report is required
+23 ;
+24 ; These flags have the same meaning at all sites for all
+25 ; imaging types.
+26 ;
+27 QUIT
+28 ;
+29 ;***** RETURNS A DESCRIPTOR OF THE EXAM STATUS
+30 ;
+31 ; STATUS IEN of the status record in the EXAMINATION STATUS
+32 ; file (#72) or the status order number in the 3rd.
+33 ; ^-piece.
+34 ;
+35 ; First, the function checks the 1st ^-piece. If it
+36 ; is greater than 0, then it is used as IEN of the
+37 ; status.
+38 ;
+39 ; Otherwise, the third piece is checked for a status
+40 ; order number (value of the ORDER field (3) of the
+41 ; EXAMINATION STATUS file (#72)). The RAIMGTYI
+42 ; parameter must reference a valid imaging type in
+43 ; this case.
+44 ;
+45 ; Only 0 (cancelled), 1 (waiting for exam), and 9
+46 ; (completed) order numbers are the same at all sites
+47 ; and all imaging types. All others are site and/or
+48 ; imaging type specific.
+49 ;
+50 ; [RAIMGTYI] Imaging type IEN (file #79.2). This parameter is
+51 ; required if a status is referenced by the order
+52 ; number (see above).
+53 ;
+54 ; Return Values:
+55 ; <0 Error descriptor (see $$ERROR^RAERR)
+56 ; >0 Exam status descriptor (see the comment in
+57 ; the beginning of this routine)
+58 ;
EXMSTINF(STATUS,RAIMGTYI) ;
+1 NEW IENS,RABUF,RAMSG,RC,TMP
+2 SET RC=0
+3 ;
+4 ;=== Search for status record
+5 IF STATUS'>0
Begin DoDot:1
+6 NEW IEN72,RAIMGTY,RANODE
+7 IF $PIECE(STATUS,U,3)'?1.N
SET RC=$$IPVE^RAERR("STATUS")
QUIT
+8 IF $GET(RAIMGTYI)'>0
SET RC=$$IPVE^RAERR("RAIMGTYI")
QUIT
+9 ;--- Get the imaging type name
+10 SET IENS=+RAIMGTYI_","
+11 SET RAIMGTY=$$GET1^DIQ(79.2,IENS,.01,,,"RAMSG")
+12 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,70.02,IENS)
QUIT
+13 IF RAIMGTY=""
SET RC=$$ERROR^RAERR(-19,,70.02,IENS,2)
QUIT
+14 ;--- Search for status record by status order number
+15 SET RANODE=$NAME(^RA(72,"AA",RAIMGTY,+$PIECE(STATUS,U,3)))
+16 SET IEN72=+$ORDER(@RANODE@(""))
+17 IF IEN72'>0
SET RC=$$IPVE^RAERR("STATUS")
QUIT
+18 ;--- Check if there is another status with the same order number
+19 IF $ORDER(@RANODE@(IEN72))>0
Begin DoDot:2
+20 SET RC=$$ERROR^RAERR(-14,,"status order number",STATUS)
End DoDot:2
QUIT
+21 SET STATUS=IEN72
End DoDot:1
IF RC<0
QUIT RC
+22 ;
+23 ;=== Load status properties
+24 SET IENS=+STATUS_","
+25 DO GETS^DIQ(72,IENS,".01;.111;3;8;9","I","RABUF","RAMSG")
+26 IF $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9,72,IENS)
+27 ;
+28 ;=== Build basic descriptor
+29 ; STATUS
SET $PIECE(STATUS,U,2)=$GET(RABUF(72,IENS,.01,"I"))
+30 ; ORDER
SET $PIECE(STATUS,U,3)=$GET(RABUF(72,IENS,3,"I"))
+31 ; VISTARAD CATEGORY
SET $PIECE(STATUS,U,4)=$GET(RABUF(72,IENS,9,"I"))
+32 ;
+33 ;=== Add generic characteristics
+34 SET TMP=""
+35 ;--- REPORT ENTERED REQUIRED?
+36 IF $GET(RABUF(72,IENS,.111,"I"))="Y"
SET TMP=TMP_"R"
+37 ;--- GENERATE EXAMINED HL7 MESSAGE
+38 IF $GET(RABUF(72,IENS,8,"I"))="Y"
SET TMP=TMP_"E"
+39 SET $PIECE(STATUS,U,5)=TMP
+40 ;
+41 ;===
+42 QUIT STATUS
+43 ;
+44 ;***** RETURNS REQUIREMENTS FOR THE EXAM STATUS
+45 ;
+46 ; EXMSTIEN IEN of the current status (IEN in the file #72)
+47 ;
+48 ; [RAPROCIEN] Radiology procedure IEN (file #71). This parameter
+49 ; is required to determine exact nuclear medicine
+50 ; requirements (result pieces from 17 to 25).
+51 ;
+52 ; By default (+$G(RAPROCIEN)=0), this function cannot
+53 ; examine the SUPPRESS RADIOPHARM PROMPT field (2) of
+54 ; the RAD/NUC MED PROCEDURES file (#71) and might
+55 ; indicate that some nuclear medicine data is required
+56 ; even if it is not.
+57 ;
+58 ; Return Values:
+59 ; <0 Error descriptor (see $$ERROR^RAERR)
+60 ; ... Status requirements descriptor
+61 ; ^01: TECHNOLOGIST REQUIRED? {0|1}
+62 ; ^02: RESIDENT OR STAFF REQUIRED? {0|1}
+63 ; ^03: DETAILED PROCEDURE REQUIRED? {0|1}
+64 ; ^04: FILM ENTRY REQUIRED? {0|1}
+65 ; ^05: DIAGNOSTIC CODE REQUIRED? {0|1}
+66 ; ^06: CAMERA/EQUIP/RM REQUIRED? {0|1}
+67 ; ^07: reserved
+68 ; ^08: reserved
+69 ; ^09: reserved
+70 ; ^10: reserved
+71 ; ^11: REPORT ENTERED REQUIRED? {0|1}
+72 ; ^12: VERIFIED REPORT REQUIRED? {0|1}
+73 ; ^13: PROCEDURE MODIFIERS REQUIRED? {0|1}
+74 ; ^14: CPT MODIFIERS REQUIRED? {0|1}
+75 ; ^15: reserved
+76 ; ^16: IMPRESSION REQUIRED? {0|1}
+77 ; ^17: RADIOPHARMS/DOSAGES REQUIRED? {0|1}
+78 ; ^18: reserved
+79 ; ^19: ACTIVITY DRAWN REQUIRED? {0|1}
+80 ; ^20: DRAWN DT/TIME/PERSON REQUIRED? {0|1}
+81 ; ^21: ADM DT/TIME/PERSON REQUIRED? {0|1}
+82 ; ^22: reserved
+83 ; ^23: ROUTE/SITE REQUIRED? {0|1}
+84 ; ^24: LOT NO. REQUIRED? {0|1}
+85 ; ^25: VOLUME/FORM REQUIRED? {0|1}
+86 ;
EXMSTREQ(EXMSTIEN,RAPROCIEN) ;
+1 IF $DATA(^RA(72,+EXMSTIEN))<10
QUIT $$IPVE^RAERR("EXMSTIEN")
+2 IF $GET(RAPROCIEN)<0
QUIT $$IPVE^RAERR("RAPROCIEN")
+3 NEW BUF,I,IENS,RABUF,RAIMGTYI,RAMSG,RC,RESULT,TMP
+4 SET RESULT=""
SET RC=0
+5 ;
+6 ;=== General requirements
+7 SET BUF=$GET(^RA(72,+EXMSTIEN,.1))
+8 FOR I=1:1:6,11:1:14,16
SET $PIECE(RESULT,U,I)=($PIECE(BUF,U,I)="Y")
+9 ;
+10 ;=== Nuclear Medicine requirements
+11 SET BUF=$GET(^RA(72,+EXMSTIEN,.5))
+12 ;--- If the exam status does not indicate that radiopharmaceuticals
+13 ; are required, then there is no need for any further checks.
+14 ;--- See the EN1^RASTREQN procedure for more details.
+15 IF $PIECE(BUF,U)="Y"
Begin DoDot:1
+16 ;--- Get the imaging type IEN from the exam status
+17 SET IENS=+EXMSTIEN_","
+18 SET RAIMGTYI=+$$GET1^DIQ(72,IENS,7,"I",,"RAMSG")
+19 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,72,IENS)
QUIT
+20 ;--- If the RADIOPHARMACEUTICALS USED? of the imaging type
+21 ;--- is not set to Yes, then requirements are voided.
+22 SET IENS=RAIMGTYI_","
+23 SET TMP=$$GET1^DIQ(79.2,IENS,5,"I",,"RAMSG")
+24 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,79.2,IENS)
QUIT
+25 IF TMP'="Y"
SET BUF=""
QUIT
+26 ;--- If a procedure is passed and its SUPPRESS RADIOPHARM PROMPT
+27 ; field (2) in the RAD/NUC MED PROCEDURES file (#71) stores 1,
+28 ;--- then the radiopharmaceutical requirements are voided.
+29 IF $GET(RAPROCIEN)>0
Begin DoDot:2
+30 SET IENS=+RAPROCIEN_","
+31 DO GETS^DIQ(71,IENS,"2;12","I","RABUF","RAMSG")
+32 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,71,IENS)
QUIT
+33 IF +$GET(RABUF(71,IENS,12,"I"))'=RAIMGTYI
Begin DoDot:3
+34 SET RC=$$ERROR^RAERR(-55)
End DoDot:3
QUIT
+35 IF $GET(RABUF(71,IENS,2,"I"))
SET BUF=""
End DoDot:2
IF RC<0
QUIT
End DoDot:1
IF RC<0
QUIT RC
+36 IF '$TEST
SET BUF=""
+37 FOR I=1,3,4,5,7,8,9
SET $PIECE(RESULT,U,16+I)=($PIECE(BUF,U,I)="Y")
+38 ;
+39 ;===
+40 QUIT RESULT
+41 ;
+42 ;***** RETURNS THE STATUS THAT SHOULD BE USED AS "EXAMINED"
+43 ;
+44 ; EXMSTIEN IEN of the current status (IEN in the file #72)
+45 ;
+46 ; Return Values:
+47 ; <0 Error descriptor (see $$ERROR^RAERR)
+48 ; "" Requested exam status cannot be found. The current
+49 ; status is already at or past "EXAMINED".
+50 ; >0 Exam status descriptor (see the routine comment above)
+51 ;
+52 ; This function searches for a status that follows the one defined
+53 ; by the EXMSTIEN parameter and has "E" (Examined) in the VISTARAD
+54 ; CATEGORY field (9).
+55 ;
GETEXMND(EXMSTIEN) ;
+1 QUIT $$NXTEXMST(+EXMSTIEN,"E")
+2 ;
+3 ;***** RETURNS THE NEXT EXAM STATUS
+4 ;
+5 ; EXMSTIEN IEN of the status record in the EXAMINATION STATUS
+6 ; file (#72).
+7 ;
+8 ; [VISTARADCAT] Internal value of the required VistA RAD category.
+9 ;
+10 ; Return Values:
+11 ; <0 Error descriptor (see $$ERROR^RAERR)
+12 ; "" Requested exam status cannot be found after the status
+13 ; referenced by the EXMSTIEN.
+14 ; >0 Exam status descriptor (see the routine comment above)
+15 ;
NXTEXMST(EXMSTIEN,VISTARADCAT) ;
+1 NEW IEN72,IENS,ORDER,ORDI,RABUF,RAIMGTY,RAMSG,RC,TMP,X,XREF
+2 IF $GET(EXMSTIEN)'>0
QUIT $$IPVE^RAERR("EXMSTIEN")
+3 SET RC=0
+4 ;=== Get the order number and type of imaging
+5 SET IENS=+EXMSTIEN_","
+6 DO GETS^DIQ(72,IENS,"3;7",,"RABUF","RAMSG")
+7 IF $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9,72,IENS)
+8 SET ORDER=+$GET(RABUF(72,IENS,3))
+9 SET RAIMGTY=$GET(RABUF(72,IENS,7))
+10 KILL RABUF
+11 ;=== Search for the next status
+12 SET XREF=$NAME(^RA(72,"AA",RAIMGTY))
+13 IF $GET(VISTARADCAT)'=""
Begin DoDot:1
+14 SET ORDI=""
+15 FOR
SET ORDI=$ORDER(@XREF@(ORDI))
IF ORDI=""
QUIT
Begin DoDot:2
+16 SET IEN72=""
+17 FOR
SET IEN72=$ORDER(@XREF@(ORDI,IEN72))
IF IEN72=""
QUIT
Begin DoDot:3
+18 SET TMP=$$GET1^DIQ(72,IEN72_",",9,"I",,"RAMSG")
+19 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,72,IEN72_",")
QUIT
+20 IF TMP=VISTARADCAT
SET RC=$$EXMSTINF(IEN72)
End DoDot:3
IF RC
QUIT
End DoDot:2
IF RC
QUIT
+21 ;--- If nothing has been found, then "E:Examined" category has
+22 ;--- not been assigned to a record of this imaging type yet.
+23 IF 'RC
SET RC=$$ERROR^RAERR(-59,,VISTARADCAT,RAIMGTY)
QUIT
+24 ;--- Check if the new status follows the source one
+25 IF $PIECE(RC,U,3)'>ORDER
SET RC=""
End DoDot:1
+26 IF '$TEST
Begin DoDot:1
+27 SET ORDI=$ORDER(@XREF@(ORDER))
IF ORDI=""
QUIT
+28 SET IEN72=$ORDER(@XREF@(ORDI,""))
IF IEN72=""
QUIT
+29 SET RC=$$EXMSTINF(IEN72)
End DoDot:1
+30 ;===
+31 QUIT RC
