Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAMAG03A

RAMAG03A.m

Go to the documentation of this file.
  1. RAMAG03A ;HCIOFO/SG,GJC - ORDERS/EXAMS API (REGISTR. PARAMS) ; Feb 23, 2023@14:05:28
  1. ;;5.0;Radiology/Nuclear Medicine;**90,197**;Mar 16, 1998;Build 2
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #1337 Read access to the file #42.4 (controlled)
  1. ; #10039 Read access to the file #42 (supported)
  1. ; #10040 Read access to the file #44 (supported)
  1. ; #10093 Read access to the file #49 (supported)
  1. ;
  1. Q
  1. ;
  1. ;+++++ VALIDATES EXAM PARAMETERS AND INITIALIZES RELATED VARIABLES
  1. ;
  1. ; .RALOCK Reference to a local variable where identifiers
  1. ; of the locked order are added to.
  1. ;
  1. ; Input variables:
  1. ; RADTE, RAMISC, RAOIFN
  1. ;
  1. ; Output variables:
  1. ; RADFN, RAEXMVAL, RAIMGTYI, RAMDIV, RAMISC, RAMLC, RAPARENT,
  1. ; RAPRLST
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. ; NOTE: This is an internal entry point. Do not call it from
  1. ; routines other than the ^RAMAG03.
  1. ;
  1. ; This function also locks the order record in the
  1. ; RAD/NUC MED ORDERS file (#75.1).
  1. ;
  1. VALIDATE(RALOCK) ;
  1. N ERRCNT,I,IENS,IENS751,RACAT,RABUF,RADTI,RAMSG,RAORDSTS,RC,TMP
  1. S ERRCNT=0 K RAEXMVAL
  1. ;=== Check required variables
  1. S RC=$$CHKREQ^RAUTL22("RADTE,RAOIFN") Q:RC<0 RC
  1. ;
  1. ;=== Order IEN
  1. I RAOIFN>0,$D(^RAO(75.1,RAOIFN))
  1. E Q $$IPVE^RAERR("RAOIFN")
  1. ;
  1. ;=== Lock the order
  1. K TMP S TMP(75.1,RAOIFN_",")=""
  1. S RC=$$LOCKFM^RALOCK(.TMP)
  1. Q:RC $$LOCKERR^RAERR(RC,"order")
  1. M RALOCK=TMP
  1. ;
  1. ;=== Order status
  1. S RAORDSTS=$$ORDSTAT^RAMAGU02(RAOIFN) Q:RAORDSTS<0 RAORDSTS
  1. ;--- Only orders with HOLD (3), PENDING (5), and SCHEDULED (8)
  1. ;--- statuses can be registered
  1. S I=+RAORDSTS
  1. Q:(I'=3)&(I'=5)&(I'=8) $$ERROR^RAERR(-35,,$P(RAORDSTS,U,2),RAOIFN)
  1. ;
  1. ;=== Exam date/time
  1. S TMP=+$E(RADTE,1,12) ; Strip the seconds
  1. ;-- ski begin p197 --
  1. S I=$$ISEXDTVAL^RAUTL22(TMP)
  1. IF I<1 D ;no QUIT extrinsic
  1. .D IPVE^RAERR("RADTE")
  1. .S ERRCNT=ERRCNT+1,RADTE="",RADTI=0
  1. .Q
  1. ;-- ski end p197 --
  1. S I=$$ISEXCTDT^RAUTL22(TMP) ;checks for exact date (month & day)
  1. I I>0,$P(TMP,".",2),$$FMTE^XLFDT(TMP)'=TMP D
  1. . S RADTE=TMP,RADTI=$$INVDTE^RAMAGU04(RADTE) ; Inverted date/time
  1. E D
  1. . D:I'<0 IPVE^RAERR("RADTE")
  1. . S ERRCNT=ERRCNT+1,RADTE="",RADTI=0
  1. ;
  1. ;=== Load the order data
  1. S IENS751=RAOIFN_","
  1. D GETS^DIQ(75.1,IENS751,".01;3;4;14;20;21;22","I","RABUF","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,75.1,IENS751)
  1. ;
  1. ;=== Patient IEN
  1. S RADFN=+$G(RABUF(75.1,IENS751,.01,"I"))
  1. Q:RADFN'>0 $$ERROR^RAERR(-19,,75.1,IENS751,.01)
  1. ;
  1. ;=== Imaging type IEN
  1. S RAIMGTYI=+$G(RABUF(75.1,IENS751,3,"I"))
  1. I RAIMGTYI'>0 D ERROR^RAERR(-19,,75.1,IENS751,3) S ERRCNT=ERRCNT+1
  1. ;
  1. ;=== Imaging location IEN and Radiology division IEN
  1. S RAMLC=+$G(RABUF(75.1,IENS751,20,"I"))
  1. I RAMLC>0 D
  1. . S RAMDIV=$$GET1^DIQ(79.1,RAMLC_",",25,"I",,"RAMSG")
  1. . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
  1. . . D DBS^RAERR("RAMSG",-9,79.1,RAMLC_",")
  1. . I RAMDIV'>0 D S ERRCNT=ERRCNT+1 Q
  1. . . D ERROR^RAERR(-19,,79.1,RAMLC_",",25)
  1. E D ERROR^RAERR(-19,,75.1,IENS751,20) S ERRCNT=ERRCNT+1
  1. ;
  1. ;=== REQUESTING PHYSICIAN, DATE DESIRED, and REQUESTING LOCATION
  1. F I=14,21,22 S RAEXMVAL(I)=$G(RABUF(75.1,IENS751,I,"I"))
  1. ;
  1. ;=== Category of exam
  1. S RACAT=$G(RAMISC("EXAMCAT"))
  1. I RACAT="" D
  1. . S RACAT=$G(RABUF(75.1,IENS751,4,"I"))
  1. . I RACAT="" D ERROR^RAERR(-19,,75.1,IENS751,4) S ERRCNT=ERRCNT+1
  1. . ;--- Assign default value to the parameter
  1. . S RAMISC("EXAMCAT")=RACAT
  1. ;
  1. ;=== Radiology procedure(s) and modifiers
  1. S:$$VALPROC(IENS751)<0 ERRCNT=ERRCNT+1
  1. ;
  1. ;=== Parameters specific to the exam category
  1. S RC=0
  1. I RACAT="I" D ; Inpatient
  1. . S RC=$$VALINPAT(IENS751)
  1. . K RAMISC("PRINCLIN")
  1. ;
  1. ;=== Check for CATEGORY OF PATIENT discrepancy
  1. I RACAT="I",$G(RAMISC("WARD"))="" D
  1. . S (RAMISC("EXAMCAT"),RACAT)="O"
  1. ;
  1. I RACAT'="I" D ; Other categories
  1. . S RC=$$VALOUTPT(IENS751)
  1. . F I="BEDSECT","SERVICE","WARD" K RAMISC(I)
  1. S:RC<0 ERRCNT=ERRCNT+1
  1. ;
  1. ;=== Always get clinical history from the order
  1. D
  1. . K RAMISC("CLINHIST")
  1. . D GETS^DIQ(75.1,IENS751,"400",,"RABUF","RAMSG")
  1. . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
  1. . . D DBS^RAERR("RAMSG",-9,75.1,IENS751)
  1. . S I=""
  1. . F S I=$O(RABUF(75.1,IENS751,400,I)) Q:I="" D
  1. . . S RAMISC("CLINHIST",I)=RABUF(75.1,IENS751,400,I)
  1. . K RABUF(75.1,IENS751,400)
  1. ;
  1. ;=== Check the flags
  1. I $G(RAPARENT) D:$G(RAMISC("FLAGS"))["A"
  1. . ;--- A parent procedure cannot be added to the existing exam(s)
  1. . D ERROR^RAERR(-53) S ERRCNT=ERRCNT+1
  1. ;
  1. ;===
  1. Q $S(ERRCNT>0:$$ERROR^RAERR(-11),1:0)
  1. ;
  1. ;+++++ VALIDATES PARAMETERS SPECIFIC TO INPATIENT CATEGORY
  1. ;
  1. ; IENS751 IENS of the order in the RAD/NUC MED ORDERS file
  1. ;
  1. ; Input variables:
  1. ; RADFN, RADTE, RAMISC
  1. ;
  1. ; Output variables:
  1. ; RAMISC
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Parameters are valid
  1. ;
  1. ; NOTE: This is an internal entry point. Do not call it from
  1. ; outside of the RAMAG03* routines.
  1. ;
  1. VALINPAT(IENS751) ;
  1. N BEDSECT,ERRCNT,I,IEN,RC,SERVICE,TMP,WARD
  1. S ERRCNT=0
  1. ;
  1. ;=== Check if at least one default value is needed
  1. S TMP=0
  1. F I="BEDSECT","SERVICE","WARD" I '($D(RAMISC(I))#10) S TMP=1 Q
  1. I TMP S RC=0 D Q:RC<0 +RC
  1. . ;--- Get inpatient data
  1. . S RC=$$RAINP^RAMAGU07(RADFN,.SERVICE,.BEDSECT,.WARD,RADTE) Q:RC<0
  1. . ;--- Assign default values to the parameters
  1. . S:'($D(RAMISC("BEDSECT"))#10)&(BEDSECT>0) RAMISC("BEDSECT")=+BEDSECT
  1. . S:'($D(RAMISC("SERVICE"))#10)&(SERVICE>0) RAMISC("SERVICE")=+SERVICE
  1. . S:'($D(RAMISC("WARD"))#10)&(WARD>0) RAMISC("WARD")=+WARD
  1. ;
  1. ;=== Validate parameters
  1. S IEN=$G(RAMISC("BEDSECT"))
  1. D:IEN>0
  1. . S TMP=$$ROOT^DILFD(42.4,,1)
  1. . I '$D(@TMP@(IEN,0)) D S ERRCNT=ERRCNT+1
  1. . . D IPVE^RAERR($NA(RAMISC("BEDSECT")))
  1. ;---
  1. S IEN=$G(RAMISC("SERVICE"))
  1. D:IEN>0
  1. . S TMP=$$ROOT^DILFD(49,,1)
  1. . I '$D(@TMP@(IEN,0)) D S ERRCNT=ERRCNT+1
  1. . . D IPVE^RAERR($NA(RAMISC("SERVICE")))
  1. ;---
  1. S IEN=$G(RAMISC("WARD"))
  1. D:IEN>0
  1. . S TMP=$$ROOT^DILFD(42,,1)
  1. . I '$D(@TMP@(IEN,0)) D S ERRCNT=ERRCNT+1
  1. . . D IPVE^RAERR($NA(RAMISC("WARD")))
  1. ;
  1. ;===
  1. Q $S(ERRCNT>0:-11,1:0)
  1. ;
  1. ;+++++ VALIDATES PARAMETERS SPECIFIC TO NON-INPATIENT CATEGORIES
  1. ;
  1. ; IENS751 IENS of the order in the RAD/NUC MED ORDERS file
  1. ;
  1. ; Input variables:
  1. ; RAMISC
  1. ;
  1. ; Output variables:
  1. ; RAMISC
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Parameters are valid
  1. ;
  1. ; NOTE: This is an internal entry point. Do not call it from
  1. ; outside of the RAMAG03* routines.
  1. ;
  1. VALOUTPT(IENS751) ;
  1. N CLINIC,ERRCNT,I,IENS,RAMSG,RC,TMP
  1. S ERRCNT=0
  1. ;
  1. ;=== Principal Clinic
  1. S RC=0,CLINIC=$G(RAMISC("PRINCLIN"))
  1. ;--- Use the Requesting Location from the order as default value
  1. D:CLINIC'>0
  1. . S CLINIC=$$GET1^DIQ(75.1,IENS751,22,"I",,"RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,75.1,IENS751) Q
  1. . S:CLINIC'>0 RC=$$ERROR^RAERR(-19,,75.1,IENS751,22)
  1. ;--- Check the location type
  1. I RC'<0 D
  1. . S IENS=CLINIC_",",TMP=$$GET1^DIQ(44,IENS,2,"I",,"RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,44,IENS) Q
  1. . I TMP="" S RC=$$ERROR^RAERR(-19,,44,IENS,2) Q
  1. . S:TMP'="C" RC=-3
  1. I RC<0 D S ERRCNT=ERRCNT+1
  1. . D IPVE^RAERR($NA(RAMISC("PRINCLIN")))
  1. E S RAMISC("PRINCLIN")=CLINIC
  1. ;
  1. ;===
  1. Q $S(ERRCNT>0:-11,1:0)
  1. ;
  1. ;+++++ VALIDATES RADIOLOGY PROCEDURE AND MODIFIERS
  1. ;
  1. ; IENS751 IENS of the order in the RAD/NUC MED ORDERS file
  1. ;
  1. ; Input variables:
  1. ; RADTE, RAIMGTYI, RAMISC
  1. ;
  1. ; Output variables:
  1. ; RAMISC, RAPARENT, RAPRLST
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Procedure and modifiers are valid
  1. ;
  1. ; NOTE: This is an internal entry point. Do not call it from
  1. ; outside of this routine.
  1. ;
  1. VALPROC(IENS751) ;
  1. N CNT,DESCPLST,I,RABUF,RAMSG,RAPD,RAPROC,RAPTL,SNGLRPT,RC,TMP
  1. S (RAPARENT,RC)=0
  1. ;
  1. ;=== Compile the list of detailed/series procedures
  1. I $D(RAMISC("RAPROC"))>1 D
  1. . S (CNT,I,RAPD)=0
  1. . F S I=$O(RAMISC("RAPROC",I)) Q:I'>0 D Q:RC<0
  1. . . S RAPROC=RAMISC("RAPROC",I)
  1. . . ;--- "Parent" procedure should be the only procedure in the list
  1. . . I RAPARENT S RC=$$ERROR^RAERR(-30) Q
  1. . . ;--- Process a "parent" procedure
  1. . . S RC=$$DESCPLST^RAMAGU03(+RAPROC,.DESCPLST,.SNGLRPT) Q:RC<0
  1. . . I RC>0 S RAPARENT=1 D Q
  1. . . . ;--- "Parent" procedure should be the only proc. in the list
  1. . . . I CNT>0 S RC=$$ERROR^RAERR(-30) Q
  1. . . . ;--- Modifiers cannot be used with "parent" procedures
  1. . . . S TMP=0
  1. . . . F I=2:1:$L(RAPROC,U) I $P(RAPROC,U,I)'="" S TMP=1 Q
  1. . . . I TMP S RC=$$ERROR^RAERR(-32) Q
  1. . . . ;--- Add detailed/series procedures to the list
  1. . . . S TMP=""
  1. . . . F S TMP=$O(DESCPLST(TMP)) Q:TMP="" D
  1. . . . . S CNT=CNT+1,RAPRLST(CNT)=+DESCPLST(TMP)
  1. . . ;--- Process a detailed/series procedure
  1. . . S CNT=CNT+1,RAPRLST(CNT)=RAPROC
  1. E D
  1. . S CNT=0
  1. . ;--- Get the procedure and modifiers from the order
  1. . D GETS^DIQ(75.1,IENS751,"2;125*","I","RABUF","RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,75.1,IENS751) Q
  1. . ;--- Procedure IEN
  1. . S RAPROC=+$G(RABUF(75.1,IENS751,2,"I"))
  1. . I RAPROC'>0 S RC=$$ERROR^RAERR(-19,,75.1,IENS751,2) Q
  1. . ;--- Process a parent procedure
  1. . S RC=$$DESCPLST^RAMAGU03(+RAPROC,.DESCPLST,.SNGLRPT) Q:RC<0
  1. . I RC>0 S RAPARENT=1,TMP="" D Q
  1. . . F S TMP=$O(DESCPLST(TMP)) Q:TMP="" D
  1. . . . S CNT=CNT+1,RAPRLST(CNT)=+DESCPLST(TMP)
  1. . ;--- Procedure modifier IENs
  1. . S I=""
  1. . F S I=$O(RABUF(75.1125,I)) Q:I="" D
  1. . . S TMP=+$G(RABUF(75.1125,I,.01,"I"))
  1. . . I TMP'>0 S RC=$$ERROR^RAERR(-19,,75.1125,I,.01) Q
  1. . . S RAPROC=RAPROC_U_TMP
  1. . ;--- Add the procedure to the list
  1. . S RAPRLST(1)=RAPROC
  1. ;
  1. ;=== Validate procedures
  1. I RC'<0,RADTE>0,RAIMGTYI>0 D
  1. . S I=0
  1. . F S I=$O(RAPRLST(I)) Q:I'>0 D
  1. . . S TMP=$$CHKPROC^RAMAGU03(RAPRLST(I),RAIMGTYI,RADTE,"DS")
  1. . . S:TMP<0 RC=TMP
  1. ;
  1. ;=== Enforce report type for descendants of a parent procedure
  1. I RAPARENT K RAMISC("SINGLERPT") S:SNGLRPT RAMISC("SINGLERPT")=1
  1. ;
  1. ;===
  1. Q $S(RC<0:-11,1:0)