- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGU06 9827 printed Jan 18, 2025@03:38:03 Page 2
- 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