source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPERR1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1RAPERR1 ;HIRMFO/GJC,CAH-Prt Img Locs missing/invalid Stop codes ;10/30/96 09:20
2 ;;5.0;Radiology/Nuclear Medicine;**13**;Mar 16, 1998
3BSTP(X) ; Check for bad stop codes (DSS ID) per Imaging Location
4 ; Make sure each imaging location points to an entry in the
5 ; Hospital Location file #44 that is a 'COUNT' clinic, with
6 ; no appointment patterns allowed, Stop Code on file 44 entry
7 ; should match DSS ID on Imaging loc, division for imaging loc
8 ; should match the Institution of the file 44 entry
9 N RAERR,RASTOP,RAY S RAERR="Invalid Stop Code: ",RAY=X_","
10 D GETS^DIQ(40.7,RAY,".01;1;2","","RASTOP")
11 S RAERR=RAERR_" ("_RASTOP(40.7,RAY,1)_") "_RASTOP(40.7,RAY,.01)
12 I $G(RASTOP(40.7,RAY,2))]"" S RAERR=RAERR_" (Inactive)"
13 Q RAERR
14CK700(X) ;Check for a 700-level stop code as a DSS ID
15 N RAERR,RASTOP,RAY S RAERR="",RAY=X_","
16 D GETS^DIQ(40.7,RAY,"1","","RASTOP")
17 I $G(RASTOP(40.7,RAY,1))?1"7"2N D
18 . S RAERR="700-series noncredit Stop Code being used"
19 . Q
20 Q RAERR
21ISTOP ; Check the validity of the stop code on the Imaging Locations file.
22 N RACNT K ^TMP($J,"RAPERR") S (RACNT,RAILOC,RAISTP,RAOUT)=0
23 F S RAILOC=$O(^RA(79.1,RAILOC)) Q:RAILOC'>0 D
24 . K RAMSG S RA791(0)=$G(^RA(79.1,RAILOC,0))
25 . Q:$P(RA791(0),"^",21)=2 ; no credit method for this location
26 . S X=+$P(RA791(0),"^",22),RA44=+$P(RA791(0),U) ;RA44 = ptr to file 44
27 . I '$D(^SC(RA44)) D
28 .. S RAMSG="Broken pointer - Hospital Location file 44 entry missing",RACNT=RACNT+1
29 .. S ^TMP($J,"RAPERR",RAILOC,RACNT)=RAMSG
30 .. Q
31 . S RA44(0)=$G(^SC(RA44,0)) D ;get 0th node of file 44
32 .. I $P(RA44(0),U,3)'="C" D
33 ... S RAMSG="Hospital Location file 44 entry not CLINIC type",RACNT=RACNT+1
34 ... S ^TMP($J,"RAPERR",RAILOC,RACNT)=RAMSG
35 ... Q
36 .. I X,($P(RA44(0),U,7)'=X) D
37 ... S RAMSG="Hospital Location Stop Code doesn't match Imaging Loc's DSS ID",RACNT=RACNT+1
38 ... S ^TMP($J,"RAPERR",RAILOC,RACNT)=RAMSG
39 ... Q
40 .. I $P(RA44(0),U,17)="Y" D
41 ... S RAMSG="Hospital Location is a NON-COUNT clinic",RACNT=RACNT+1
42 ... S ^TMP($J,"RAPERR",RAILOC,RACNT)=RAMSG
43 ... Q
44 .. I $G(^RA(79.1,RAILOC,"DIV"))="" D
45 ... S RAMSG="No Rad/Nuc Med Division assigned to this imaging location",RACNT=RACNT+1
46 ... S ^TMP($J,"RAPERR",RAILOC,RACNT)=RAMSG
47 .. E I +$G(^RA(79.1,RAILOC,"DIV"))'=$P(RA44(0),U,4) D
48 ... S RAMSG="Institution on Hosp Loc entry doesn't match Rad/NM Div of Imaging Loc",RACNT=RACNT+1
49 ... S ^TMP($J,"RAPERR",RAILOC,RACNT)=RAMSG
50 ... Q
51 .. Q
52 . I 'X D Q
53 .. S RAMSG="Missing DSS ID",RACNT=RACNT+1
54 .. S ^TMP($J,"RAPERR",RAILOC,RACNT)=RAMSG
55 .. Q
56 . S RAMSG=$$CK700(X) I RAMSG]"" D
57 .. S RACNT=RACNT+1,^TMP($J,"RAPERR",RAILOC,RACNT)=RAMSG
58 .. Q
59 . I '$D(^RAMIS(71.5,"B",+X))!($P(^DIC(40.7,+X,0),U,3)) D
60 .. S RAMSG=$$BSTP(X),RACNT=RACNT+1,^TMP($J,"RAPERR",RAILOC,RACNT)=RAMSG
61 .. Q
62 . Q
63 I $D(^TMP($J,"RAPERR")) D
64 . S (RAILOC,RAOUT)=0
65 . F S RAILOC=$O(^TMP($J,"RAPERR",RAILOC)) Q:RAILOC'>0 D Q:RAOUT
66 .. I $Y>(IOSL-4) D HDG^RAPERR Q:RAOUT
67 .. W !!,"Imaging Location: ",$$GET1^DIQ(44,+$P(^RA(79.1,RAILOC,0),"^"),.01) S RACNT=0
68 .. F S RACNT=$O(^TMP($J,"RAPERR",RAILOC,RACNT)) Q:RACNT'>0 D Q:RAOUT
69 ... I $Y>(IOSL-4) D HDG^RAPERR W:'RAOUT !
70 ... Q:RAOUT W !?3,$G(^TMP($J,"RAPERR",RAILOC,RACNT))
71 ... Q
72 .. Q
73 . K ^TMP($J,"RAPERR")
74 . Q
75 E D
76 . I $Y>(IOSL-4) D HDG^RAPERR Q:RAOUT
77 . W !!,"All Imaging Location crediting data is valid."
78 . Q
79 Q
Note: See TracBrowser for help on using the repository browser.