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 Dec 13, 2024@02:36:48 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)
