source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLQ.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1RAHLQ ;HISC/CAH,GJC AISC/SAW-Process Query Message (QRY) Type ;10/2/97 13:32
2 ;;5.0;Radiology/Nuclear Medicine;**7**;Mar 16, 1998
3 ; Check the validity of the following data globals:
4 ; Example: '^TMP("RARPT-QRY",$J,RASUB,' (RASUB is an ien in file 772)
5 ; **************** validates if data present **************************
6 ; ^TMP("RARPT-QRY",$J,RASUB,"RAEXAM")=case number, if case no. entered
7 ; ^TMP("RARPT-QRY",$J,RASUB,"RANUMREC")=max # of records to retrieve
8 ; ^TMP("RARPT-QRY",$J,RASUB,"RASSN")=SSN of the patient, if ssn entered
9 ; ^TMP("RARPT-QRY",$J,RASUB,"RAVERF")=ien of user doing the query
10 ; note: ^TMP("RARPT-QRY" should only have 3 of 4
11 ; of these nodes; RAEXAM and RASSN are mutually exclusive
12 ; *********************************************************************
13EN1 S I="" F S I=$O(^TMP("RARPT-QRY",$J,RASUB,I)) Q:I="" S @I=$G(^(I))
14 ; this should set the variables: RAEXAM/RASSN, RANUMREC, RAVERF
15 I '$G(RAVERF) S RAERR="Invalid Access Code" Q
16QRD ;Analyze data from the 'QRY' Message from Non-DHCP System
17 I '$D(RASSN),'$D(RAEXAM) S RAERR="Missing both the Patient & Exam ID" Q
18 I $D(RASSN) I '$S(RASSN?9N:1,RASSN?9N1A:1,RASSN?1A4N:1,1:0) S RAERR="Invalid Patient ID" Q
19 I $D(RAEXAM) I '$S(RAEXAM?6N1"-".N:1,RAEXAM?.N:1,1:0) S RAERR="Invalid Exam ID" Q
20 D:$D(RASSN) SSN D:$D(RAEXAM) EXAM
21 K RARPT
22 Q
23 ;Look Up Query Subject by SSN or BS5 X-refs
24SSN 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)
25 S RADFN=$O(^DPT(RAI,RASSN,0)) I 'RADFN S RAERR="Invalid Patient Identifier" Q
26 I $O(^DPT(RAI,RASSN,RADFN)) S RAERR="Ambiguous Patient Identifier" Q
27 I '$D(^RADPT(RADFN)) S RAERR="No Exams on File for This Patient" Q
28 K VADM,VAERR S DFN=RADFN D DEM^VADPT
29 I VADM(1)']"" S RAERR="Invalid Patient Identifier" Q
30 S (RARECNT,RADTI)=0
31 F S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:RADTI'>0!(RARECNT>RANUMREC) D
32 . S RACNI=0
33 . F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0!(RARECNT>RANUMREC) D
34 .. I $D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S RACN0=^(0) D
35 ... D EDTCHK Q:RARPT
36 ... S RARPT=+$P(RACN0,"^",17) Q:'RARPT S RARPT=$G(^RARPT(RARPT,0)),RARPT=$S("PD"[$P(RARPT,"^",5):0,1:1)
37 .. I 'RARPT S RARECNT=RARECNT+1 Q:RARECNT>RANUMREC D EN1^RAHLQ1
38 .. Q
39 . Q
40 I 'RARECNT S RAERR="No Exams on File for This Patient"
41 Q
42EXAM ;Look Up Query Subject by Exam/Case Number
43 S RAI=$S(RAEXAM["-":"ADC",1:"AE")
44 S RADFN=$O(^RADPT(RAI,RAEXAM,0)) I 'RADFN S RAERR="Invalid Exam Number or Exam Already Complete" Q
45 I $O(^RADPT(RAI,RAEXAM,RADFN)) S RAERR="Ambiguous Exam Number" Q
46 S RADTI=$O(^RADPT(RAI,RAEXAM,RADFN,0)) I 'RADTI S RAERR="Invalid Exam Number" Q
47 S RACNI=$O(^RADPT(RAI,RAEXAM,RADFN,RADTI,0)) I 'RACNI S RAERR="Invalid Exam Number" Q
48 S RACN0=$S($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)):^(0),1:"") I 'RACN0 S RAERR="Invalid Case Number" Q
49 D EDTCHK I RARPT=1 S RAERR="STATUS is CANCELLED. User is not permitted to edit report." Q
50 I RARPT=2 S RAERR="Case is cancelled AND belongs to a printset -- please use DHCP to edit this case." Q
51 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
52 K VA,VADM,VAERR S DFN=RADFN D DEM^VADPT I VADM(1)']"" S RAERR="Invalid Patient Identifier" Q
53 S RARECNT=1 ; exactly one case is being queried
54 D EN1^RAHLQ1
55 Q
56CHKPRV ;Check for active interpreting staff/resident
57 ; Examine the following two (2) conditions
58 ; 1) Does this person have a resident or staff classification?
59 ; 2) Is this person an active Rad/Nuc Med user?
60 ; If 'No' to any of the above questions, set the variable RAERR to
61 ; the appropriate error message.
62 I '$D(^VA(200,"ARC","R",RAVERF)),('$D(^VA(200,"ARC","S",RAVERF))) D Q
63 . ; neither a resident or staff
64 . S RAERR="Provider not classified as resident or staff."
65 . Q
66 I $P($G(^VA(200,RAVERF,"RA")),"^",3),($P(^("RA"),"^",3)'>$$DT^XLFDT()) D
67 . ; Rad/Nuc Med user has been inactivated.
68 . K RAESIG S RAERR="Inactive Rad/Nuc Med Classification for Interpreting Physician."
69 . Q
70 I '$D(^XUSEC("RA VERIFY",RAVERF)) S RAERR="Provider does not hold the appropriate Rad/Nuc Med security key."
71 Q
72EDTCHK ; is user permitted to edit report of a cancelled case ?
73 ; Sets RARPT to indicate if report is allowed
74 ; RARPT=1 if case cancelled, no report allowed
75 ; RARPT=2 if cancelled printset, no report allowed
76 ; RARPT=0 if case not cancelled, or user has key, or div params
77 ; allow rpt on cancelled cases, report entry allowed
78 S RARPT=0
79 S RASTATUS=+$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",3)
80 I $P($G(^RA(72,RASTATUS,0)),"^",3)>0 K RASTATUS Q
81 K RASTATUS
82 I +$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",25)>1 S RARPT=2 Q ;don't allow edit if printset
83 I $D(^XUSEC("RA MGR",+$G(RAVERF))) Q ;user has proper key
84 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))
85 I $P(RAMDV,"^",22)=1 Q ;allow rpts on cancelled cases
86 S RARPT=1 ;
87 Q
Note: See TracBrowser for help on using the repository browser.