- RAHLQ ;HISC/CAH,GJC AISC/SAW-Process Query Message (QRY) Type ;10/2/97 13:32
- ;;5.0;Radiology/Nuclear Medicine;**7**;Mar 16, 1998
- ; Check the validity of the following data globals:
- ; Example: '^TMP("RARPT-QRY",$J,RASUB,' (RASUB is an ien in file 772)
- ; **************** validates if data present **************************
- ; ^TMP("RARPT-QRY",$J,RASUB,"RAEXAM")=case number, if case no. entered
- ; ^TMP("RARPT-QRY",$J,RASUB,"RANUMREC")=max # of records to retrieve
- ; ^TMP("RARPT-QRY",$J,RASUB,"RASSN")=SSN of the patient, if ssn entered
- ; ^TMP("RARPT-QRY",$J,RASUB,"RAVERF")=ien of user doing the query
- ; note: ^TMP("RARPT-QRY" should only have 3 of 4
- ; of these nodes; RAEXAM and RASSN are mutually exclusive
- ; *********************************************************************
- EN1 S I="" F S I=$O(^TMP("RARPT-QRY",$J,RASUB,I)) Q:I="" S @I=$G(^(I))
- ; this should set the variables: RAEXAM/RASSN, RANUMREC, RAVERF
- I '$G(RAVERF) S RAERR="Invalid Access Code" Q
- QRD ;Analyze data from the 'QRY' Message from Non-DHCP System
- I '$D(RASSN),'$D(RAEXAM) S RAERR="Missing both the Patient & Exam ID" Q
- I $D(RASSN) I '$S(RASSN?9N:1,RASSN?9N1A:1,RASSN?1A4N:1,1:0) S RAERR="Invalid Patient ID" Q
- I $D(RAEXAM) I '$S(RAEXAM?6N1"-".N:1,RAEXAM?.N:1,1:0) S RAERR="Invalid Exam ID" Q
- D:$D(RASSN) SSN D:$D(RAEXAM) EXAM
- K RARPT
- Q
- ;Look Up Query Subject by SSN or BS5 X-refs
- SSN S:$E(RASSN)?1L RASSN=$C($A($E(RASSN))-32)_$E(RASSN,2,5) S RAI=$S(RASSN?1U4N:"BS5",1:"SSN") S:$L(RASSN)=10&($E(RASSN,10)?1L) RASSN=$E(RASSN,1,9)_$C($A($E(RASSN,10))-32)
- S RADFN=$O(^DPT(RAI,RASSN,0)) I 'RADFN S RAERR="Invalid Patient Identifier" Q
- I $O(^DPT(RAI,RASSN,RADFN)) S RAERR="Ambiguous Patient Identifier" Q
- I '$D(^RADPT(RADFN)) S RAERR="No Exams on File for This Patient" Q
- K VADM,VAERR S DFN=RADFN D DEM^VADPT
- I VADM(1)']"" S RAERR="Invalid Patient Identifier" Q
- S (RARECNT,RADTI)=0
- F S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:RADTI'>0!(RARECNT>RANUMREC) D
- . S RACNI=0
- . F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0!(RARECNT>RANUMREC) D
- .. I $D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S RACN0=^(0) D
- ... D EDTCHK Q:RARPT
- ... S RARPT=+$P(RACN0,"^",17) Q:'RARPT S RARPT=$G(^RARPT(RARPT,0)),RARPT=$S("PD"[$P(RARPT,"^",5):0,1:1)
- .. I 'RARPT S RARECNT=RARECNT+1 Q:RARECNT>RANUMREC D EN1^RAHLQ1
- .. Q
- . Q
- I 'RARECNT S RAERR="No Exams on File for This Patient"
- Q
- EXAM ;Look Up Query Subject by Exam/Case Number
- S RAI=$S(RAEXAM["-":"ADC",1:"AE")
- S RADFN=$O(^RADPT(RAI,RAEXAM,0)) I 'RADFN S RAERR="Invalid Exam Number or Exam Already Complete" Q
- I $O(^RADPT(RAI,RAEXAM,RADFN)) S RAERR="Ambiguous Exam Number" Q
- S RADTI=$O(^RADPT(RAI,RAEXAM,RADFN,0)) I 'RADTI S RAERR="Invalid Exam Number" Q
- S RACNI=$O(^RADPT(RAI,RAEXAM,RADFN,RADTI,0)) I 'RACNI S RAERR="Invalid Exam Number" Q
- S RACN0=$S($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)):^(0),1:"") I 'RACN0 S RAERR="Invalid Case Number" Q
- D EDTCHK I RARPT=1 S RAERR="STATUS is CANCELLED. User is not permitted to edit report." Q
- I RARPT=2 S RAERR="Case is cancelled AND belongs to a printset -- please use DHCP to edit this case." Q
- I $P(RACN0,"^",17) S RARPT=$G(^RARPT($P(RACN0,"^",17),0)),RARPT=$S("PD"[$P(RARPT,"^",5):0,1:1) I RARPT S RAERR="Report Already On File" Q
- K VA,VADM,VAERR S DFN=RADFN D DEM^VADPT I VADM(1)']"" S RAERR="Invalid Patient Identifier" Q
- S RARECNT=1 ; exactly one case is being queried
- D EN1^RAHLQ1
- Q
- CHKPRV ;Check for active interpreting staff/resident
- ; Examine the following two (2) conditions
- ; 1) Does this person have a resident or staff classification?
- ; 2) Is this person an active Rad/Nuc Med user?
- ; If 'No' to any of the above questions, set the variable RAERR to
- ; the appropriate error message.
- I '$D(^VA(200,"ARC","R",RAVERF)),('$D(^VA(200,"ARC","S",RAVERF))) D Q
- . ; neither a resident or staff
- . S RAERR="Provider not classified as resident or staff."
- . Q
- I $P($G(^VA(200,RAVERF,"RA")),"^",3),($P(^("RA"),"^",3)'>$$DT^XLFDT()) D
- . ; Rad/Nuc Med user has been inactivated.
- . K RAESIG S RAERR="Inactive Rad/Nuc Med Classification for Interpreting Physician."
- . Q
- I '$D(^XUSEC("RA VERIFY",RAVERF)) S RAERR="Provider does not hold the appropriate Rad/Nuc Med security key."
- Q
- EDTCHK ; is user permitted to edit report of a cancelled case ?
- ; Sets RARPT to indicate if report is allowed
- ; RARPT=1 if case cancelled, no report allowed
- ; RARPT=2 if cancelled printset, no report allowed
- ; RARPT=0 if case not cancelled, or user has key, or div params
- ; allow rpt on cancelled cases, report entry allowed
- S RARPT=0
- S RASTATUS=+$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",3)
- I $P($G(^RA(72,RASTATUS,0)),"^",3)>0 K RASTATUS Q
- K RASTATUS
- I +$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",25)>1 S RARPT=2 Q ;don't allow edit if printset
- I $D(^XUSEC("RA MGR",+$G(RAVERF))) Q ;user has proper key
- I $D(^RADPT(RADFN,"DT",RADTI,0)) S RAMDIV=^(0),RAMLC=+$P(RAMDIV,"^",4),RAMDIV=+$P(RAMDIV,"^",3),RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:""),RAMDV=$S(RAMDV="":RAMDV,1:$TR(RAMDV,"YyNn",1100))
- I $P(RAMDV,"^",22)=1 Q ;allow rpts on cancelled cases
- S RARPT=1 ;
- Q
- RAHLQ ;HISC/CAH,GJC AISC/SAW-Process Query Message (QRY) Type ;10/2/97 13:32
- +1 ;;5.0;Radiology/Nuclear Medicine;**7**;Mar 16, 1998
- +2 ; Check the validity of the following data globals:
- +3 ; Example: '^TMP("RARPT-QRY",$J,RASUB,' (RASUB is an ien in file 772)
- +4 ; **************** validates if data present **************************
- +5 ; ^TMP("RARPT-QRY",$J,RASUB,"RAEXAM")=case number, if case no. entered
- +6 ; ^TMP("RARPT-QRY",$J,RASUB,"RANUMREC")=max # of records to retrieve
- +7 ; ^TMP("RARPT-QRY",$J,RASUB,"RASSN")=SSN of the patient, if ssn entered
- +8 ; ^TMP("RARPT-QRY",$J,RASUB,"RAVERF")=ien of user doing the query
- +9 ; note: ^TMP("RARPT-QRY" should only have 3 of 4
- +10 ; of these nodes; RAEXAM and RASSN are mutually exclusive
- +11 ; *********************************************************************
- EN1 SET I=""
- FOR
- SET I=$ORDER(^TMP("RARPT-QRY",$JOB,RASUB,I))
- IF I=""
- QUIT
- SET @I=$GET(^(I))
- +1 ; this should set the variables: RAEXAM/RASSN, RANUMREC, RAVERF
- +2 IF '$GET(RAVERF)
- SET RAERR="Invalid Access Code"
- QUIT
- QRD ;Analyze data from the 'QRY' Message from Non-DHCP System
- +1 IF '$DATA(RASSN)
- IF '$DATA(RAEXAM)
- SET RAERR="Missing both the Patient & Exam ID"
- QUIT
- +2 IF $DATA(RASSN)
- IF '$SELECT(RASSN?9N:1,RASSN?9N1A:1,RASSN?1A4N:1,1:0)
- SET RAERR="Invalid Patient ID"
- QUIT
- +3 IF $DATA(RAEXAM)
- IF '$SELECT(RAEXAM?6N1"-".N:1,RAEXAM?.N:1,1:0)
- SET RAERR="Invalid Exam ID"
- QUIT
- +4 IF $DATA(RASSN)
- DO SSN
- IF $DATA(RAEXAM)
- DO EXAM
- +5 KILL RARPT
- +6 QUIT
- +7 ;Look Up Query Subject by SSN or BS5 X-refs
- SSN IF $EXTRACT(RASSN)?1L
- SET RASSN=$CHAR($ASCII($EXTRACT(RASSN))-32)_$EXTRACT(RASSN,2,5)
- SET RAI=$SELECT(RASSN?1U4N:"BS5",1:"SSN")
- IF $LENGTH(RASSN)=10&($EXTRACT(RASSN,10)?1L)
- SET RASSN=$EXTRACT(RASSN,1,9)_$CHAR($ASCII($EXTRACT(RASSN,10))-32)
- +1 SET RADFN=$ORDER(^DPT(RAI,RASSN,0))
- IF 'RADFN
- SET RAERR="Invalid Patient Identifier"
- QUIT
- +2 IF $ORDER(^DPT(RAI,RASSN,RADFN))
- SET RAERR="Ambiguous Patient Identifier"
- QUIT
- +3 IF '$DATA(^RADPT(RADFN))
- SET RAERR="No Exams on File for This Patient"
- QUIT
- +4 KILL VADM,VAERR
- SET DFN=RADFN
- DO DEM^VADPT
- +5 IF VADM(1)']""
- SET RAERR="Invalid Patient Identifier"
- QUIT
- +6 SET (RARECNT,RADTI)=0
- +7 FOR
- SET RADTI=$ORDER(^RADPT(RADFN,"DT",RADTI))
- IF RADTI'>0!(RARECNT>RANUMREC)
- QUIT
- Begin DoDot:1
- +8 SET RACNI=0
- +9 FOR
- SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
- IF RACNI'>0!(RARECNT>RANUMREC)
- QUIT
- Begin DoDot:2
- +10 IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- SET RACN0=^(0)
- Begin DoDot:3
- +11 DO EDTCHK
- IF RARPT
- QUIT
- +12 SET RARPT=+$PIECE(RACN0,"^",17)
- IF 'RARPT
- QUIT
- SET RARPT=$GET(^RARPT(RARPT,0))
- SET RARPT=$SELECT("PD"[$PIECE(RARPT,"^",5):0,1:1)
- End DoDot:3
- +13 IF 'RARPT
- SET RARECNT=RARECNT+1
- IF RARECNT>RANUMREC
- QUIT
- DO EN1^RAHLQ1
- +14 QUIT
- End DoDot:2
- +15 QUIT
- End DoDot:1
- +16 IF 'RARECNT
- SET RAERR="No Exams on File for This Patient"
- +17 QUIT
- EXAM ;Look Up Query Subject by Exam/Case Number
- +1 SET RAI=$SELECT(RAEXAM["-":"ADC",1:"AE")
- +2 SET RADFN=$ORDER(^RADPT(RAI,RAEXAM,0))
- IF 'RADFN
- SET RAERR="Invalid Exam Number or Exam Already Complete"
- QUIT
- +3 IF $ORDER(^RADPT(RAI,RAEXAM,RADFN))
- SET RAERR="Ambiguous Exam Number"
- QUIT
- +4 SET RADTI=$ORDER(^RADPT(RAI,RAEXAM,RADFN,0))
- IF 'RADTI
- SET RAERR="Invalid Exam Number"
- QUIT
- +5 SET RACNI=$ORDER(^RADPT(RAI,RAEXAM,RADFN,RADTI,0))
- IF 'RACNI
- SET RAERR="Invalid Exam Number"
- QUIT
- +6 SET RACN0=$SELECT($DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)):^(0),1:"")
- IF 'RACN0
- SET RAERR="Invalid Case Number"
- QUIT
- +7 DO EDTCHK
- IF RARPT=1
- SET RAERR="STATUS is CANCELLED. User is not permitted to edit report."
- QUIT
- +8 IF RARPT=2
- SET RAERR="Case is cancelled AND belongs to a printset -- please use DHCP to edit this case."
- QUIT
- +9 IF $PIECE(RACN0,"^",17)
- SET RARPT=$GET(^RARPT($PIECE(RACN0,"^",17),0))
- SET RARPT=$SELECT("PD"[$PIECE(RARPT,"^",5):0,1:1)
- IF RARPT
- SET RAERR="Report Already On File"
- QUIT
- +10 KILL VA,VADM,VAERR
- SET DFN=RADFN
- DO DEM^VADPT
- IF VADM(1)']""
- SET RAERR="Invalid Patient Identifier"
- QUIT
- +11 ; exactly one case is being queried
- SET RARECNT=1
- +12 DO EN1^RAHLQ1
- +13 QUIT
- CHKPRV ;Check for active interpreting staff/resident
- +1 ; Examine the following two (2) conditions
- +2 ; 1) Does this person have a resident or staff classification?
- +3 ; 2) Is this person an active Rad/Nuc Med user?
- +4 ; If 'No' to any of the above questions, set the variable RAERR to
- +5 ; the appropriate error message.
- +6 IF '$DATA(^VA(200,"ARC","R",RAVERF))
- IF ('$DATA(^VA(200,"ARC","S",RAVERF)))
- Begin DoDot:1
- +7 ; neither a resident or staff
- +8 SET RAERR="Provider not classified as resident or staff."
- +9 QUIT
- End DoDot:1
- QUIT
- +10 IF $PIECE($GET(^VA(200,RAVERF,"RA")),"^",3)
- IF ($PIECE(^("RA"),"^",3)'>$$DT^XLFDT())
- Begin DoDot:1
- +11 ; Rad/Nuc Med user has been inactivated.
- +12 KILL RAESIG
- SET RAERR="Inactive Rad/Nuc Med Classification for Interpreting Physician."
- +13 QUIT
- End DoDot:1
- +14 IF '$DATA(^XUSEC("RA VERIFY",RAVERF))
- SET RAERR="Provider does not hold the appropriate Rad/Nuc Med security key."
- +15 QUIT
- EDTCHK ; is user permitted to edit report of a cancelled case ?
- +1 ; Sets RARPT to indicate if report is allowed
- +2 ; RARPT=1 if case cancelled, no report allowed
- +3 ; RARPT=2 if cancelled printset, no report allowed
- +4 ; RARPT=0 if case not cancelled, or user has key, or div params
- +5 ; allow rpt on cancelled cases, report entry allowed
- +6 SET RARPT=0
- +7 SET RASTATUS=+$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",3)
- +8 IF $PIECE($GET(^RA(72,RASTATUS,0)),"^",3)>0
- KILL RASTATUS
- QUIT
- +9 KILL RASTATUS
- +10 ;don't allow edit if printset
- IF +$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",25)>1
- SET RARPT=2
- QUIT
- +11 ;user has proper key
- IF $DATA(^XUSEC("RA MGR",+$GET(RAVERF)))
- QUIT
- +12 IF $DATA(^RADPT(RADFN,"DT",RADTI,0))
- SET RAMDIV=^(0)
- SET RAMLC=+$PIECE(RAMDIV,"^",4)
- SET RAMDIV=+$PIECE(RAMDIV,"^",3)
- SET RAMDV=$SELECT($DATA(^RA(79,RAMDIV,.1)):^(.1),1:"")
- SET RAMDV=$SELECT(RAMDV="":RAMDV,1:$TRANSLATE(RAMDV,"YyNn",1100))
- +13 ;allow rpts on cancelled cases
- IF $PIECE(RAMDV,"^",22)=1
- QUIT
- +14 ;
- SET RARPT=1
- +15 QUIT
