- RAMAG03A ;HCIOFO/SG,GJC - ORDERS/EXAMS API (REGISTR. PARAMS) ; Feb 23, 2023@14:05:28
- ;;5.0;Radiology/Nuclear Medicine;**90,197**;Mar 16, 1998;Build 2
- ;
- ; This routine uses the following IAs:
- ;
- ; #1337 Read access to the file #42.4 (controlled)
- ; #10039 Read access to the file #42 (supported)
- ; #10040 Read access to the file #44 (supported)
- ; #10093 Read access to the file #49 (supported)
- ;
- Q
- ;
- ;+++++ VALIDATES EXAM PARAMETERS AND INITIALIZES RELATED VARIABLES
- ;
- ; .RALOCK Reference to a local variable where identifiers
- ; of the locked order are added to.
- ;
- ; Input variables:
- ; RADTE, RAMISC, RAOIFN
- ;
- ; Output variables:
- ; RADFN, RAEXMVAL, RAIMGTYI, RAMDIV, RAMISC, RAMLC, RAPARENT,
- ; RAPRLST
- ;
- ; Return values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; 0 Success
- ;
- ; NOTE: This is an internal entry point. Do not call it from
- ; routines other than the ^RAMAG03.
- ;
- ; This function also locks the order record in the
- ; RAD/NUC MED ORDERS file (#75.1).
- ;
- VALIDATE(RALOCK) ;
- N ERRCNT,I,IENS,IENS751,RACAT,RABUF,RADTI,RAMSG,RAORDSTS,RC,TMP
- S ERRCNT=0 K RAEXMVAL
- ;=== Check required variables
- S RC=$$CHKREQ^RAUTL22("RADTE,RAOIFN") Q:RC<0 RC
- ;
- ;=== Order IEN
- I RAOIFN>0,$D(^RAO(75.1,RAOIFN))
- E Q $$IPVE^RAERR("RAOIFN")
- ;
- ;=== Lock the order
- K TMP S TMP(75.1,RAOIFN_",")=""
- S RC=$$LOCKFM^RALOCK(.TMP)
- Q:RC $$LOCKERR^RAERR(RC,"order")
- M RALOCK=TMP
- ;
- ;=== Order status
- S RAORDSTS=$$ORDSTAT^RAMAGU02(RAOIFN) Q:RAORDSTS<0 RAORDSTS
- ;--- Only orders with HOLD (3), PENDING (5), and SCHEDULED (8)
- ;--- statuses can be registered
- S I=+RAORDSTS
- Q:(I'=3)&(I'=5)&(I'=8) $$ERROR^RAERR(-35,,$P(RAORDSTS,U,2),RAOIFN)
- ;
- ;=== Exam date/time
- S TMP=+$E(RADTE,1,12) ; Strip the seconds
- ;-- ski begin p197 --
- S I=$$ISEXDTVAL^RAUTL22(TMP)
- IF I<1 D ;no QUIT extrinsic
- .D IPVE^RAERR("RADTE")
- .S ERRCNT=ERRCNT+1,RADTE="",RADTI=0
- .Q
- ;-- ski end p197 --
- S I=$$ISEXCTDT^RAUTL22(TMP) ;checks for exact date (month & day)
- I I>0,$P(TMP,".",2),$$FMTE^XLFDT(TMP)'=TMP D
- . S RADTE=TMP,RADTI=$$INVDTE^RAMAGU04(RADTE) ; Inverted date/time
- E D
- . D:I'<0 IPVE^RAERR("RADTE")
- . S ERRCNT=ERRCNT+1,RADTE="",RADTI=0
- ;
- ;=== Load the order data
- S IENS751=RAOIFN_","
- D GETS^DIQ(75.1,IENS751,".01;3;4;14;20;21;22","I","RABUF","RAMSG")
- Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,75.1,IENS751)
- ;
- ;=== Patient IEN
- S RADFN=+$G(RABUF(75.1,IENS751,.01,"I"))
- Q:RADFN'>0 $$ERROR^RAERR(-19,,75.1,IENS751,.01)
- ;
- ;=== Imaging type IEN
- S RAIMGTYI=+$G(RABUF(75.1,IENS751,3,"I"))
- I RAIMGTYI'>0 D ERROR^RAERR(-19,,75.1,IENS751,3) S ERRCNT=ERRCNT+1
- ;
- ;=== Imaging location IEN and Radiology division IEN
- S RAMLC=+$G(RABUF(75.1,IENS751,20,"I"))
- I RAMLC>0 D
- . S RAMDIV=$$GET1^DIQ(79.1,RAMLC_",",25,"I",,"RAMSG")
- . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
- . . D DBS^RAERR("RAMSG",-9,79.1,RAMLC_",")
- . I RAMDIV'>0 D S ERRCNT=ERRCNT+1 Q
- . . D ERROR^RAERR(-19,,79.1,RAMLC_",",25)
- E D ERROR^RAERR(-19,,75.1,IENS751,20) S ERRCNT=ERRCNT+1
- ;
- ;=== REQUESTING PHYSICIAN, DATE DESIRED, and REQUESTING LOCATION
- F I=14,21,22 S RAEXMVAL(I)=$G(RABUF(75.1,IENS751,I,"I"))
- ;
- ;=== Category of exam
- S RACAT=$G(RAMISC("EXAMCAT"))
- I RACAT="" D
- . S RACAT=$G(RABUF(75.1,IENS751,4,"I"))
- . I RACAT="" D ERROR^RAERR(-19,,75.1,IENS751,4) S ERRCNT=ERRCNT+1
- . ;--- Assign default value to the parameter
- . S RAMISC("EXAMCAT")=RACAT
- ;
- ;=== Radiology procedure(s) and modifiers
- S:$$VALPROC(IENS751)<0 ERRCNT=ERRCNT+1
- ;
- ;=== Parameters specific to the exam category
- S RC=0
- I RACAT="I" D ; Inpatient
- . S RC=$$VALINPAT(IENS751)
- . K RAMISC("PRINCLIN")
- ;
- ;=== Check for CATEGORY OF PATIENT discrepancy
- I RACAT="I",$G(RAMISC("WARD"))="" D
- . S (RAMISC("EXAMCAT"),RACAT)="O"
- ;
- I RACAT'="I" D ; Other categories
- . S RC=$$VALOUTPT(IENS751)
- . F I="BEDSECT","SERVICE","WARD" K RAMISC(I)
- S:RC<0 ERRCNT=ERRCNT+1
- ;
- ;=== Always get clinical history from the order
- D
- . K RAMISC("CLINHIST")
- . D GETS^DIQ(75.1,IENS751,"400",,"RABUF","RAMSG")
- . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
- . . D DBS^RAERR("RAMSG",-9,75.1,IENS751)
- . S I=""
- . F S I=$O(RABUF(75.1,IENS751,400,I)) Q:I="" D
- . . S RAMISC("CLINHIST",I)=RABUF(75.1,IENS751,400,I)
- . K RABUF(75.1,IENS751,400)
- ;
- ;=== Check the flags
- I $G(RAPARENT) D:$G(RAMISC("FLAGS"))["A"
- . ;--- A parent procedure cannot be added to the existing exam(s)
- . D ERROR^RAERR(-53) S ERRCNT=ERRCNT+1
- ;
- ;===
- Q $S(ERRCNT>0:$$ERROR^RAERR(-11),1:0)
- ;
- ;+++++ VALIDATES PARAMETERS SPECIFIC TO INPATIENT CATEGORY
- ;
- ; IENS751 IENS of the order in the RAD/NUC MED ORDERS file
- ;
- ; Input variables:
- ; RADFN, RADTE, RAMISC
- ;
- ; Output variables:
- ; RAMISC
- ;
- ; Return values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; 0 Parameters are valid
- ;
- ; NOTE: This is an internal entry point. Do not call it from
- ; outside of the RAMAG03* routines.
- ;
- VALINPAT(IENS751) ;
- N BEDSECT,ERRCNT,I,IEN,RC,SERVICE,TMP,WARD
- S ERRCNT=0
- ;
- ;=== Check if at least one default value is needed
- S TMP=0
- F I="BEDSECT","SERVICE","WARD" I '($D(RAMISC(I))#10) S TMP=1 Q
- I TMP S RC=0 D Q:RC<0 +RC
- . ;--- Get inpatient data
- . S RC=$$RAINP^RAMAGU07(RADFN,.SERVICE,.BEDSECT,.WARD,RADTE) Q:RC<0
- . ;--- Assign default values to the parameters
- . S:'($D(RAMISC("BEDSECT"))#10)&(BEDSECT>0) RAMISC("BEDSECT")=+BEDSECT
- . S:'($D(RAMISC("SERVICE"))#10)&(SERVICE>0) RAMISC("SERVICE")=+SERVICE
- . S:'($D(RAMISC("WARD"))#10)&(WARD>0) RAMISC("WARD")=+WARD
- ;
- ;=== Validate parameters
- S IEN=$G(RAMISC("BEDSECT"))
- D:IEN>0
- . S TMP=$$ROOT^DILFD(42.4,,1)
- . I '$D(@TMP@(IEN,0)) D S ERRCNT=ERRCNT+1
- . . D IPVE^RAERR($NA(RAMISC("BEDSECT")))
- ;---
- S IEN=$G(RAMISC("SERVICE"))
- D:IEN>0
- . S TMP=$$ROOT^DILFD(49,,1)
- . I '$D(@TMP@(IEN,0)) D S ERRCNT=ERRCNT+1
- . . D IPVE^RAERR($NA(RAMISC("SERVICE")))
- ;---
- S IEN=$G(RAMISC("WARD"))
- D:IEN>0
- . S TMP=$$ROOT^DILFD(42,,1)
- . I '$D(@TMP@(IEN,0)) D S ERRCNT=ERRCNT+1
- . . D IPVE^RAERR($NA(RAMISC("WARD")))
- ;
- ;===
- Q $S(ERRCNT>0:-11,1:0)
- ;
- ;+++++ VALIDATES PARAMETERS SPECIFIC TO NON-INPATIENT CATEGORIES
- ;
- ; IENS751 IENS of the order in the RAD/NUC MED ORDERS file
- ;
- ; Input variables:
- ; RAMISC
- ;
- ; Output variables:
- ; RAMISC
- ;
- ; Return values:
- ; <0 Error code
- ; 0 Parameters are valid
- ;
- ; NOTE: This is an internal entry point. Do not call it from
- ; outside of the RAMAG03* routines.
- ;
- VALOUTPT(IENS751) ;
- N CLINIC,ERRCNT,I,IENS,RAMSG,RC,TMP
- S ERRCNT=0
- ;
- ;=== Principal Clinic
- S RC=0,CLINIC=$G(RAMISC("PRINCLIN"))
- ;--- Use the Requesting Location from the order as default value
- D:CLINIC'>0
- . S CLINIC=$$GET1^DIQ(75.1,IENS751,22,"I",,"RAMSG")
- . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,75.1,IENS751) Q
- . S:CLINIC'>0 RC=$$ERROR^RAERR(-19,,75.1,IENS751,22)
- ;--- Check the location type
- I RC'<0 D
- . S IENS=CLINIC_",",TMP=$$GET1^DIQ(44,IENS,2,"I",,"RAMSG")
- . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,44,IENS) Q
- . I TMP="" S RC=$$ERROR^RAERR(-19,,44,IENS,2) Q
- . S:TMP'="C" RC=-3
- I RC<0 D S ERRCNT=ERRCNT+1
- . D IPVE^RAERR($NA(RAMISC("PRINCLIN")))
- E S RAMISC("PRINCLIN")=CLINIC
- ;
- ;===
- Q $S(ERRCNT>0:-11,1:0)
- ;
- ;+++++ VALIDATES RADIOLOGY PROCEDURE AND MODIFIERS
- ;
- ; IENS751 IENS of the order in the RAD/NUC MED ORDERS file
- ;
- ; Input variables:
- ; RADTE, RAIMGTYI, RAMISC
- ;
- ; Output variables:
- ; RAMISC, RAPARENT, RAPRLST
- ;
- ; Return values:
- ; <0 Error code
- ; 0 Procedure and modifiers are valid
- ;
- ; NOTE: This is an internal entry point. Do not call it from
- ; outside of this routine.
- ;
- VALPROC(IENS751) ;
- N CNT,DESCPLST,I,RABUF,RAMSG,RAPD,RAPROC,RAPTL,SNGLRPT,RC,TMP
- S (RAPARENT,RC)=0
- ;
- ;=== Compile the list of detailed/series procedures
- I $D(RAMISC("RAPROC"))>1 D
- . S (CNT,I,RAPD)=0
- . F S I=$O(RAMISC("RAPROC",I)) Q:I'>0 D Q:RC<0
- . . S RAPROC=RAMISC("RAPROC",I)
- . . ;--- "Parent" procedure should be the only procedure in the list
- . . I RAPARENT S RC=$$ERROR^RAERR(-30) Q
- . . ;--- Process a "parent" procedure
- . . S RC=$$DESCPLST^RAMAGU03(+RAPROC,.DESCPLST,.SNGLRPT) Q:RC<0
- . . I RC>0 S RAPARENT=1 D Q
- . . . ;--- "Parent" procedure should be the only proc. in the list
- . . . I CNT>0 S RC=$$ERROR^RAERR(-30) Q
- . . . ;--- Modifiers cannot be used with "parent" procedures
- . . . S TMP=0
- . . . F I=2:1:$L(RAPROC,U) I $P(RAPROC,U,I)'="" S TMP=1 Q
- . . . I TMP S RC=$$ERROR^RAERR(-32) Q
- . . . ;--- Add detailed/series procedures to the list
- . . . S TMP=""
- . . . F S TMP=$O(DESCPLST(TMP)) Q:TMP="" D
- . . . . S CNT=CNT+1,RAPRLST(CNT)=+DESCPLST(TMP)
- . . ;--- Process a detailed/series procedure
- . . S CNT=CNT+1,RAPRLST(CNT)=RAPROC
- E D
- . S CNT=0
- . ;--- Get the procedure and modifiers from the order
- . D GETS^DIQ(75.1,IENS751,"2;125*","I","RABUF","RAMSG")
- . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,75.1,IENS751) Q
- . ;--- Procedure IEN
- . S RAPROC=+$G(RABUF(75.1,IENS751,2,"I"))
- . I RAPROC'>0 S RC=$$ERROR^RAERR(-19,,75.1,IENS751,2) Q
- . ;--- Process a parent procedure
- . S RC=$$DESCPLST^RAMAGU03(+RAPROC,.DESCPLST,.SNGLRPT) Q:RC<0
- . I RC>0 S RAPARENT=1,TMP="" D Q
- . . F S TMP=$O(DESCPLST(TMP)) Q:TMP="" D
- . . . S CNT=CNT+1,RAPRLST(CNT)=+DESCPLST(TMP)
- . ;--- Procedure modifier IENs
- . S I=""
- . F S I=$O(RABUF(75.1125,I)) Q:I="" D
- . . S TMP=+$G(RABUF(75.1125,I,.01,"I"))
- . . I TMP'>0 S RC=$$ERROR^RAERR(-19,,75.1125,I,.01) Q
- . . S RAPROC=RAPROC_U_TMP
- . ;--- Add the procedure to the list
- . S RAPRLST(1)=RAPROC
- ;
- ;=== Validate procedures
- I RC'<0,RADTE>0,RAIMGTYI>0 D
- . S I=0
- . F S I=$O(RAPRLST(I)) Q:I'>0 D
- . . S TMP=$$CHKPROC^RAMAGU03(RAPRLST(I),RAIMGTYI,RADTE,"DS")
- . . S:TMP<0 RC=TMP
- ;
- ;=== Enforce report type for descendants of a parent procedure
- I RAPARENT K RAMISC("SINGLERPT") S:SNGLRPT RAMISC("SINGLERPT")=1
- ;
- ;===
- Q $S(RC<0:-11,1:0)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAG03A 10202 printed Feb 19, 2025@00:03:04 Page 2
- 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
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ;
- +5 ; #1337 Read access to the file #42.4 (controlled)
- +6 ; #10039 Read access to the file #42 (supported)
- +7 ; #10040 Read access to the file #44 (supported)
- +8 ; #10093 Read access to the file #49 (supported)
- +9 ;
- +10 QUIT
- +11 ;
- +12 ;+++++ VALIDATES EXAM PARAMETERS AND INITIALIZES RELATED VARIABLES
- +13 ;
- +14 ; .RALOCK Reference to a local variable where identifiers
- +15 ; of the locked order are added to.
- +16 ;
- +17 ; Input variables:
- +18 ; RADTE, RAMISC, RAOIFN
- +19 ;
- +20 ; Output variables:
- +21 ; RADFN, RAEXMVAL, RAIMGTYI, RAMDIV, RAMISC, RAMLC, RAPARENT,
- +22 ; RAPRLST
- +23 ;
- +24 ; Return values:
- +25 ; <0 Error descriptor (see $$ERROR^RAERR)
- +26 ; 0 Success
- +27 ;
- +28 ; NOTE: This is an internal entry point. Do not call it from
- +29 ; routines other than the ^RAMAG03.
- +30 ;
- +31 ; This function also locks the order record in the
- +32 ; RAD/NUC MED ORDERS file (#75.1).
- +33 ;
- VALIDATE(RALOCK) ;
- +1 NEW ERRCNT,I,IENS,IENS751,RACAT,RABUF,RADTI,RAMSG,RAORDSTS,RC,TMP
- +2 SET ERRCNT=0
- KILL RAEXMVAL
- +3 ;=== Check required variables
- +4 SET RC=$$CHKREQ^RAUTL22("RADTE,RAOIFN")
- if RC<0
- QUIT RC
- +5 ;
- +6 ;=== Order IEN
- +7 IF RAOIFN>0
- IF $DATA(^RAO(75.1,RAOIFN))
- +8 IF '$TEST
- QUIT $$IPVE^RAERR("RAOIFN")
- +9 ;
- +10 ;=== Lock the order
- +11 KILL TMP
- SET TMP(75.1,RAOIFN_",")=""
- +12 SET RC=$$LOCKFM^RALOCK(.TMP)
- +13 if RC
- QUIT $$LOCKERR^RAERR(RC,"order")
- +14 MERGE RALOCK=TMP
- +15 ;
- +16 ;=== Order status
- +17 SET RAORDSTS=$$ORDSTAT^RAMAGU02(RAOIFN)
- if RAORDSTS<0
- QUIT RAORDSTS
- +18 ;--- Only orders with HOLD (3), PENDING (5), and SCHEDULED (8)
- +19 ;--- statuses can be registered
- +20 SET I=+RAORDSTS
- +21 if (I'=3)&(I'=5)&(I'=8)
- QUIT $$ERROR^RAERR(-35,,$PIECE(RAORDSTS,U,2),RAOIFN)
- +22 ;
- +23 ;=== Exam date/time
- +24 ; Strip the seconds
- SET TMP=+$EXTRACT(RADTE,1,12)
- +25 ;-- ski begin p197 --
- +26 SET I=$$ISEXDTVAL^RAUTL22(TMP)
- +27 ;no QUIT extrinsic
- IF I<1
- Begin DoDot:1
- +28 DO IPVE^RAERR("RADTE")
- +29 SET ERRCNT=ERRCNT+1
- SET RADTE=""
- SET RADTI=0
- +30 QUIT
- End DoDot:1
- +31 ;-- ski end p197 --
- +32 ;checks for exact date (month & day)
- SET I=$$ISEXCTDT^RAUTL22(TMP)
- +33 IF I>0
- IF $PIECE(TMP,".",2)
- IF $$FMTE^XLFDT(TMP)'=TMP
- Begin DoDot:1
- +34 ; Inverted date/time
- SET RADTE=TMP
- SET RADTI=$$INVDTE^RAMAGU04(RADTE)
- End DoDot:1
- +35 IF '$TEST
- Begin DoDot:1
- +36 if I'<0
- DO IPVE^RAERR("RADTE")
- +37 SET ERRCNT=ERRCNT+1
- SET RADTE=""
- SET RADTI=0
- End DoDot:1
- +38 ;
- +39 ;=== Load the order data
- +40 SET IENS751=RAOIFN_","
- +41 DO GETS^DIQ(75.1,IENS751,".01;3;4;14;20;21;22","I","RABUF","RAMSG")
- +42 if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,75.1,IENS751)
- +43 ;
- +44 ;=== Patient IEN
- +45 SET RADFN=+$GET(RABUF(75.1,IENS751,.01,"I"))
- +46 if RADFN'>0
- QUIT $$ERROR^RAERR(-19,,75.1,IENS751,.01)
- +47 ;
- +48 ;=== Imaging type IEN
- +49 SET RAIMGTYI=+$GET(RABUF(75.1,IENS751,3,"I"))
- +50 IF RAIMGTYI'>0
- DO ERROR^RAERR(-19,,75.1,IENS751,3)
- SET ERRCNT=ERRCNT+1
- +51 ;
- +52 ;=== Imaging location IEN and Radiology division IEN
- +53 SET RAMLC=+$GET(RABUF(75.1,IENS751,20,"I"))
- +54 IF RAMLC>0
- Begin DoDot:1
- +55 SET RAMDIV=$$GET1^DIQ(79.1,RAMLC_",",25,"I",,"RAMSG")
- +56 IF $GET(DIERR)
- Begin DoDot:2
- +57 DO DBS^RAERR("RAMSG",-9,79.1,RAMLC_",")
- End DoDot:2
- SET ERRCNT=ERRCNT+1
- QUIT
- +58 IF RAMDIV'>0
- Begin DoDot:2
- +59 DO ERROR^RAERR(-19,,79.1,RAMLC_",",25)
- End DoDot:2
- SET ERRCNT=ERRCNT+1
- QUIT
- End DoDot:1
- +60 IF '$TEST
- DO ERROR^RAERR(-19,,75.1,IENS751,20)
- SET ERRCNT=ERRCNT+1
- +61 ;
- +62 ;=== REQUESTING PHYSICIAN, DATE DESIRED, and REQUESTING LOCATION
- +63 FOR I=14,21,22
- SET RAEXMVAL(I)=$GET(RABUF(75.1,IENS751,I,"I"))
- +64 ;
- +65 ;=== Category of exam
- +66 SET RACAT=$GET(RAMISC("EXAMCAT"))
- +67 IF RACAT=""
- Begin DoDot:1
- +68 SET RACAT=$GET(RABUF(75.1,IENS751,4,"I"))
- +69 IF RACAT=""
- DO ERROR^RAERR(-19,,75.1,IENS751,4)
- SET ERRCNT=ERRCNT+1
- +70 ;--- Assign default value to the parameter
- +71 SET RAMISC("EXAMCAT")=RACAT
- End DoDot:1
- +72 ;
- +73 ;=== Radiology procedure(s) and modifiers
- +74 if $$VALPROC(IENS751)<0
- SET ERRCNT=ERRCNT+1
- +75 ;
- +76 ;=== Parameters specific to the exam category
- +77 SET RC=0
- +78 ; Inpatient
- IF RACAT="I"
- Begin DoDot:1
- +79 SET RC=$$VALINPAT(IENS751)
- +80 KILL RAMISC("PRINCLIN")
- End DoDot:1
- +81 ;
- +82 ;=== Check for CATEGORY OF PATIENT discrepancy
- +83 IF RACAT="I"
- IF $GET(RAMISC("WARD"))=""
- Begin DoDot:1
- +84 SET (RAMISC("EXAMCAT"),RACAT)="O"
- End DoDot:1
- +85 ;
- +86 ; Other categories
- IF RACAT'="I"
- Begin DoDot:1
- +87 SET RC=$$VALOUTPT(IENS751)
- +88 FOR I="BEDSECT","SERVICE","WARD"
- KILL RAMISC(I)
- End DoDot:1
- +89 if RC<0
- SET ERRCNT=ERRCNT+1
- +90 ;
- +91 ;=== Always get clinical history from the order
- +92 Begin DoDot:1
- +93 KILL RAMISC("CLINHIST")
- +94 DO GETS^DIQ(75.1,IENS751,"400",,"RABUF","RAMSG")
- +95 IF $GET(DIERR)
- Begin DoDot:2
- +96 DO DBS^RAERR("RAMSG",-9,75.1,IENS751)
- End DoDot:2
- SET ERRCNT=ERRCNT+1
- QUIT
- +97 SET I=""
- +98 FOR
- SET I=$ORDER(RABUF(75.1,IENS751,400,I))
- if I=""
- QUIT
- Begin DoDot:2
- +99 SET RAMISC("CLINHIST",I)=RABUF(75.1,IENS751,400,I)
- End DoDot:2
- +100 KILL RABUF(75.1,IENS751,400)
- End DoDot:1
- +101 ;
- +102 ;=== Check the flags
- +103 IF $GET(RAPARENT)
- if $GET(RAMISC("FLAGS"))["A"
- Begin DoDot:1
- +104 ;--- A parent procedure cannot be added to the existing exam(s)
- +105 DO ERROR^RAERR(-53)
- SET ERRCNT=ERRCNT+1
- End DoDot:1
- +106 ;
- +107 ;===
- +108 QUIT $SELECT(ERRCNT>0:$$ERROR^RAERR(-11),1:0)
- +109 ;
- +110 ;+++++ VALIDATES PARAMETERS SPECIFIC TO INPATIENT CATEGORY
- +111 ;
- +112 ; IENS751 IENS of the order in the RAD/NUC MED ORDERS file
- +113 ;
- +114 ; Input variables:
- +115 ; RADFN, RADTE, RAMISC
- +116 ;
- +117 ; Output variables:
- +118 ; RAMISC
- +119 ;
- +120 ; Return values:
- +121 ; <0 Error descriptor (see $$ERROR^RAERR)
- +122 ; 0 Parameters are valid
- +123 ;
- +124 ; NOTE: This is an internal entry point. Do not call it from
- +125 ; outside of the RAMAG03* routines.
- +126 ;
- VALINPAT(IENS751) ;
- +1 NEW BEDSECT,ERRCNT,I,IEN,RC,SERVICE,TMP,WARD
- +2 SET ERRCNT=0
- +3 ;
- +4 ;=== Check if at least one default value is needed
- +5 SET TMP=0
- +6 FOR I="BEDSECT","SERVICE","WARD"
- IF '($DATA(RAMISC(I))#10)
- SET TMP=1
- QUIT
- +7 IF TMP
- SET RC=0
- Begin DoDot:1
- +8 ;--- Get inpatient data
- +9 SET RC=$$RAINP^RAMAGU07(RADFN,.SERVICE,.BEDSECT,.WARD,RADTE)
- if RC<0
- QUIT
- +10 ;--- Assign default values to the parameters
- +11 if '($DATA(RAMISC("BEDSECT"))#10)&(BEDSECT>0)
- SET RAMISC("BEDSECT")=+BEDSECT
- +12 if '($DATA(RAMISC("SERVICE"))#10)&(SERVICE>0)
- SET RAMISC("SERVICE")=+SERVICE
- +13 if '($DATA(RAMISC("WARD"))#10)&(WARD>0)
- SET RAMISC("WARD")=+WARD
- End DoDot:1
- if RC<0
- QUIT +RC
- +14 ;
- +15 ;=== Validate parameters
- +16 SET IEN=$GET(RAMISC("BEDSECT"))
- +17 if IEN>0
- Begin DoDot:1
- +18 SET TMP=$$ROOT^DILFD(42.4,,1)
- +19 IF '$DATA(@TMP@(IEN,0))
- Begin DoDot:2
- +20 DO IPVE^RAERR($NAME(RAMISC("BEDSECT")))
- End DoDot:2
- SET ERRCNT=ERRCNT+1
- End DoDot:1
- +21 ;---
- +22 SET IEN=$GET(RAMISC("SERVICE"))
- +23 if IEN>0
- Begin DoDot:1
- +24 SET TMP=$$ROOT^DILFD(49,,1)
- +25 IF '$DATA(@TMP@(IEN,0))
- Begin DoDot:2
- +26 DO IPVE^RAERR($NAME(RAMISC("SERVICE")))
- End DoDot:2
- SET ERRCNT=ERRCNT+1
- End DoDot:1
- +27 ;---
- +28 SET IEN=$GET(RAMISC("WARD"))
- +29 if IEN>0
- Begin DoDot:1
- +30 SET TMP=$$ROOT^DILFD(42,,1)
- +31 IF '$DATA(@TMP@(IEN,0))
- Begin DoDot:2
- +32 DO IPVE^RAERR($NAME(RAMISC("WARD")))
- End DoDot:2
- SET ERRCNT=ERRCNT+1
- End DoDot:1
- +33 ;
- +34 ;===
- +35 QUIT $SELECT(ERRCNT>0:-11,1:0)
- +36 ;
- +37 ;+++++ VALIDATES PARAMETERS SPECIFIC TO NON-INPATIENT CATEGORIES
- +38 ;
- +39 ; IENS751 IENS of the order in the RAD/NUC MED ORDERS file
- +40 ;
- +41 ; Input variables:
- +42 ; RAMISC
- +43 ;
- +44 ; Output variables:
- +45 ; RAMISC
- +46 ;
- +47 ; Return values:
- +48 ; <0 Error code
- +49 ; 0 Parameters are valid
- +50 ;
- +51 ; NOTE: This is an internal entry point. Do not call it from
- +52 ; outside of the RAMAG03* routines.
- +53 ;
- VALOUTPT(IENS751) ;
- +1 NEW CLINIC,ERRCNT,I,IENS,RAMSG,RC,TMP
- +2 SET ERRCNT=0
- +3 ;
- +4 ;=== Principal Clinic
- +5 SET RC=0
- SET CLINIC=$GET(RAMISC("PRINCLIN"))
- +6 ;--- Use the Requesting Location from the order as default value
- +7 if CLINIC'>0
- Begin DoDot:1
- +8 SET CLINIC=$$GET1^DIQ(75.1,IENS751,22,"I",,"RAMSG")
- +9 IF $GET(DIERR)
- SET RC=$$DBS^RAERR("RAMSG",-9,75.1,IENS751)
- QUIT
- +10 if CLINIC'>0
- SET RC=$$ERROR^RAERR(-19,,75.1,IENS751,22)
- End DoDot:1
- +11 ;--- Check the location type
- +12 IF RC'<0
- Begin DoDot:1
- +13 SET IENS=CLINIC_","
- SET TMP=$$GET1^DIQ(44,IENS,2,"I",,"RAMSG")
- +14 IF $GET(DIERR)
- SET RC=$$DBS^RAERR("RAMSG",-9,44,IENS)
- QUIT
- +15 IF TMP=""
- SET RC=$$ERROR^RAERR(-19,,44,IENS,2)
- QUIT
- +16 if TMP'="C"
- SET RC=-3
- End DoDot:1
- +17 IF RC<0
- Begin DoDot:1
- +18 DO IPVE^RAERR($NAME(RAMISC("PRINCLIN")))
- End DoDot:1
- SET ERRCNT=ERRCNT+1
- +19 IF '$TEST
- SET RAMISC("PRINCLIN")=CLINIC
- +20 ;
- +21 ;===
- +22 QUIT $SELECT(ERRCNT>0:-11,1:0)
- +23 ;
- +24 ;+++++ VALIDATES RADIOLOGY PROCEDURE AND MODIFIERS
- +25 ;
- +26 ; IENS751 IENS of the order in the RAD/NUC MED ORDERS file
- +27 ;
- +28 ; Input variables:
- +29 ; RADTE, RAIMGTYI, RAMISC
- +30 ;
- +31 ; Output variables:
- +32 ; RAMISC, RAPARENT, RAPRLST
- +33 ;
- +34 ; Return values:
- +35 ; <0 Error code
- +36 ; 0 Procedure and modifiers are valid
- +37 ;
- +38 ; NOTE: This is an internal entry point. Do not call it from
- +39 ; outside of this routine.
- +40 ;
- VALPROC(IENS751) ;
- +1 NEW CNT,DESCPLST,I,RABUF,RAMSG,RAPD,RAPROC,RAPTL,SNGLRPT,RC,TMP
- +2 SET (RAPARENT,RC)=0
- +3 ;
- +4 ;=== Compile the list of detailed/series procedures
- +5 IF $DATA(RAMISC("RAPROC"))>1
- Begin DoDot:1
- +6 SET (CNT,I,RAPD)=0
- +7 FOR
- SET I=$ORDER(RAMISC("RAPROC",I))
- if I'>0
- QUIT
- Begin DoDot:2
- +8 SET RAPROC=RAMISC("RAPROC",I)
- +9 ;--- "Parent" procedure should be the only procedure in the list
- +10 IF RAPARENT
- SET RC=$$ERROR^RAERR(-30)
- QUIT
- +11 ;--- Process a "parent" procedure
- +12 SET RC=$$DESCPLST^RAMAGU03(+RAPROC,.DESCPLST,.SNGLRPT)
- if RC<0
- QUIT
- +13 IF RC>0
- SET RAPARENT=1
- Begin DoDot:3
- +14 ;--- "Parent" procedure should be the only proc. in the list
- +15 IF CNT>0
- SET RC=$$ERROR^RAERR(-30)
- QUIT
- +16 ;--- Modifiers cannot be used with "parent" procedures
- +17 SET TMP=0
- +18 FOR I=2:1:$LENGTH(RAPROC,U)
- IF $PIECE(RAPROC,U,I)'=""
- SET TMP=1
- QUIT
- +19 IF TMP
- SET RC=$$ERROR^RAERR(-32)
- QUIT
- +20 ;--- Add detailed/series procedures to the list
- +21 SET TMP=""
- +22 FOR
- SET TMP=$ORDER(DESCPLST(TMP))
- if TMP=""
- QUIT
- Begin DoDot:4
- +23 SET CNT=CNT+1
- SET RAPRLST(CNT)=+DESCPLST(TMP)
- End DoDot:4
- End DoDot:3
- QUIT
- +24 ;--- Process a detailed/series procedure
- +25 SET CNT=CNT+1
- SET RAPRLST(CNT)=RAPROC
- End DoDot:2
- if RC<0
- QUIT
- End DoDot:1
- +26 IF '$TEST
- Begin DoDot:1
- +27 SET CNT=0
- +28 ;--- Get the procedure and modifiers from the order
- +29 DO GETS^DIQ(75.1,IENS751,"2;125*","I","RABUF","RAMSG")
- +30 IF $GET(DIERR)
- SET RC=$$DBS^RAERR("RAMSG",-9,75.1,IENS751)
- QUIT
- +31 ;--- Procedure IEN
- +32 SET RAPROC=+$GET(RABUF(75.1,IENS751,2,"I"))
- +33 IF RAPROC'>0
- SET RC=$$ERROR^RAERR(-19,,75.1,IENS751,2)
- QUIT
- +34 ;--- Process a parent procedure
- +35 SET RC=$$DESCPLST^RAMAGU03(+RAPROC,.DESCPLST,.SNGLRPT)
- if RC<0
- QUIT
- +36 IF RC>0
- SET RAPARENT=1
- SET TMP=""
- Begin DoDot:2
- +37 FOR
- SET TMP=$ORDER(DESCPLST(TMP))
- if TMP=""
- QUIT
- Begin DoDot:3
- +38 SET CNT=CNT+1
- SET RAPRLST(CNT)=+DESCPLST(TMP)
- End DoDot:3
- End DoDot:2
- QUIT
- +39 ;--- Procedure modifier IENs
- +40 SET I=""
- +41 FOR
- SET I=$ORDER(RABUF(75.1125,I))
- if I=""
- QUIT
- Begin DoDot:2
- +42 SET TMP=+$GET(RABUF(75.1125,I,.01,"I"))
- +43 IF TMP'>0
- SET RC=$$ERROR^RAERR(-19,,75.1125,I,.01)
- QUIT
- +44 SET RAPROC=RAPROC_U_TMP
- End DoDot:2
- +45 ;--- Add the procedure to the list
- +46 SET RAPRLST(1)=RAPROC
- End DoDot:1
- +47 ;
- +48 ;=== Validate procedures
- +49 IF RC'<0
- IF RADTE>0
- IF RAIMGTYI>0
- Begin DoDot:1
- +50 SET I=0
- +51 FOR
- SET I=$ORDER(RAPRLST(I))
- if I'>0
- QUIT
- Begin DoDot:2
- +52 SET TMP=$$CHKPROC^RAMAGU03(RAPRLST(I),RAIMGTYI,RADTE,"DS")
- +53 if TMP<0
- SET RC=TMP
- End DoDot:2
- End DoDot:1
- +54 ;
- +55 ;=== Enforce report type for descendants of a parent procedure
- +56 IF RAPARENT
- KILL RAMISC("SINGLERPT")
- if SNGLRPT
- SET RAMISC("SINGLERPT")=1
- +57 ;
- +58 ;===
- +59 QUIT $SELECT(RC<0:-11,1:0)