source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPERR.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: 5.6 KB
Line 
1RAPERR ;HISC/CAH-Print Rad/NM Procedures with missing/invalid CPT/Stop codes ;8/30/96 11:00
2 ;;5.0;Radiology/Nuclear Medicine;**10**;Mar 16, 1998
3START W !!!,"This option prints a list of Radiology/Nuclear Medicine Procedures"
4 W !,"with missing or invalid CPT's and DSS ID's, and Imaging Locations"
5 W !,"pointing to Hospital Locations with inappropriate set-up parameters."
6 W !,"Broad, parent and inactive procedures are not required to have codes."
7 W !,"To be valid, DSS ID's must be in the Imaging Stop Codes file 71.5;"
8 W !,"CPT's must be nationally active.",!!
9 K DIR S DIR(0)="Y",DIR("A")="Include Inactive procedures",DIR("B")="NO" D ^DIR I $D(DTOUT)!($D(DUOUT)) D KILL Q
10 S RALL=0 I Y=1 S RALL=1
11 K ^TMP($J,"RA I-TYPE") S RAXX=$$IMG^RAUTL12()
12 I 'RAXX D KILL Q
13 S RADT=$S($D(DT)#2:DT,1:$$DT^XLFDT())
14 S ZTRTN="EN1^RAPERR",ZTDESC="Rad/Nuc Med Invalid CPT/Stop Report"
15 D ZTSAVE,ZIS^RAUTL K ZTRTN,ZTDESC I RAPOP D KILL Q
16EN1 ; Start processing
17 U IO K ^TMP($J,"RAP")
18 S:$D(ZTQUEUED) ZTREQ="@"
19 D FIND,PRT,TOTAL,KILL
20 Q
21FIND S (RAPROC,RAPROCN,RAICTR,RABCTR,RANOCTR,RAISTP,RANOSTP,RAPAGE)=0,U="^"
22 S (RANOAMIS,RANODESC)=0
23 F S RAPROCN=$O(^RAMIS(71,"B",RAPROCN)) Q:'$L(RAPROCN) S RAPROC=0 F S RAPROC=$O(^RAMIS(71,"B",RAPROCN,RAPROC)) Q:(RAPROC'?1N.N)!($D(RAOUT)) D
24 . S RA71(0)=$G(^RAMIS(71,RAPROC,0))
25 . S RA71(12)=+$P(RA71(0),"^",12)
26 . S RAITYPE=$P($G(^RA(79.2,RA71(12),0)),"^")
27 . S:RAITYPE="" RAITYPE="UNKNOWN"
28 . Q:'$D(^TMP($J,"RA I-TYPE",RAITYPE,RA71(12)))#2 ; not user selected
29 . S RAINA=$G(^RAMIS(71,RAPROC,"I"))
30 . I 'RALL,(RAINA),(RAINA'>RADT) Q
31 . K RAMSG S RAX=$G(^RAMIS(71,RAPROC,0)) I '$L(RAX) Q
32 . I $P(RAX,U,6)="P",('+$O(^RAMIS(71,RAPROC,4,0))) D
33 .. S RANODESC=RANODESC+1
34 .. S RAMSG(99)="NO descendents entered"
35 .. Q
36 . I $P(RAX,U,6)]"",("DS"[$P(RAX,U,6)),('+$O(^RAMIS(71,RAPROC,2,0))) D
37 .. S RANOAMIS=RANOAMIS+1
38 .. S RAMSG(999)="NO AMIS Code(s) entered"
39 .. Q
40 . S RACPT=$P(RAX,U,9) I 'RACPT,"BP"'[$P(RAX,U,6) S RAMSG(1)="No CPT entered." S RANOCTR=RANOCTR+1
41 . I RACPT S X1=$$NAMCODE^RACPTMSC(RACPT,DT) I $P(X1,"^",2)="" S RAMSG(2)="Broken CPT pointer." S RABCTR=RABCTR+1
42 . I RACPT,'$$ACTCODE^RACPTMSC(RACPT,DT) S RAMSG(3)="Invalid CPT "_$P(X1,U) S RAICTR=RAICTR+1
43 . S RACTR=0 I $O(^RAMIS(71,RAPROC,"STOP",0)),('$$PCE^RAWORK()) D
44 .. S RASTP=0 F S RASTP=$O(^RAMIS(71,RAPROC,"STOP",RASTP)) Q:'RASTP S X=$G(^RAMIS(71,RAPROC,"STOP",RASTP,0)) I X S RACTR=RACTR+1 D CK700 I '$D(^RAMIS(71.5,"B",+X))!($P(^DIC(40.7,+X,0),U,3)) D BADSTOP
45 . I 'RACTR,"BP"'[$P(RAX,U,6),('$$PCE^RAWORK()) S RAMSG(5)="No stop code(s) entered.",RANOSTP=RANOSTP+1
46 . I $D(RAMSG) S RAINACT="" S X1=$G(^RAMIS(71,RAPROC,"I")) I X1 S RAMSG("INACT")="*Procedure inactivated on "_$$FMTE^XLFDT(X1,"D")_$S(X1>RADT:" (future inactivation)",1:"")_"*"
47 . I $D(RAMSG) D RATYPE S ^TMP($J,"RAP",RAPROCN,RAPROC)=RAMSG("TYPE")_U_$G(RAMSG("INACT")) S X=0 F S X=$O(RAMSG(X)) Q:'X S ^TMP($J,"RAP",RAPROCN,RAPROC,X)=RAMSG(X)
48 Q
49BADSTOP S:'$D(RAMSG(4)) RAMSG(4)="Invalid Stop Code(s): "
50 S RAMSG(4)=RAMSG(4)_" "_$P($G(^DIC(40.7,X,0)),U)
51 I $P($G(^DIC(40.7,+X,0)),U,3) S RAMSG(4)=RAMSG(4)_" (Inactive)"
52 S RAISTP=RAISTP+1
53 Q
54CK700 ;Check for a 700-level stop code without any other stop code
55 I $P($G(^DIC(40.7,+X,0)),U,2)?1"7"2N,$P(^RAMIS(71,RAPROC,"STOP",0),U,4)'>1 S RAMSG(7)="700-series noncredit Stop Code used without any credit Stop Code"
56 Q
57PRT D HDG
58 S (RAPROCN,RAPROC)=0 F S RAPROCN=$O(^TMP($J,"RAP",RAPROCN)) Q:RAPROCN=""!($D(RAOUT)) S RAPROC=0 F S RAPROC=$O(^TMP($J,"RAP",RAPROCN,RAPROC)) Q:'RAPROC!($D(RAOUT)) S RAP=^(RAPROC) D
59 . W !!,RAPROCN_" "_$P(RAP,U,2) I $L($P(RAP,U,3)) W !?5,$P(RAP,U,3)
60 . S RAI=0 F S RAI=$O(^TMP($J,"RAP",RAPROCN,RAPROC,RAI)) Q:'RAI!($D(RAOUT)) D
61 .. W !?5,$G(^TMP($J,"RAP",RAPROCN,RAPROC,RAI))
62 .. I $Y>(IOSL-6) D HDG
63 . I $D(RAOUT) Q
64 Q
65HDG I $E(IOST,1,2)="C-",RAPAGE>0 K DIR S DIR(0)="E" W ! D ^DIR I $D(DUOUT)!($D(DTOUT)) S RAOUT=1 Q
66 I (RAPAGE>0)!($E(IOST,1,2)="C-") W @IOF
67 S RAPAGE=RAPAGE+1
68 W ?16,"RADIOLOGY/NUCLEAR MEDICINE INVALID CPT AND STOP CODES"
69 W !,"Run Date: ",$$HTE^XLFDT($H),?70,"Page: ",RAPAGE
70 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1
71 Q
72LINE W !
73 Q
74RATYPE S X2=$P(RAX,U,6),X2=$S(X2="D":"Detailed,",X2="B":"Broad,",X2="S":"Series,",X2="P":"Parent,",1:"Type missing,") S RAMSG("TYPE")=$P(RAX,U,6)_U_"("_X2
75 S X2=+$P(RAX,U,12),X2=$G(^RA(79.2,X2,0)),X2=$P(X2,U,3),RAMSG("TYPE")=RAMSG("TYPE")_" "_$S(X2]"":X2,1:"Imaging type missing")_")"
76 Q
77TOTAL I $D(RAOUT) Q
78 I $Y>(IOSL-17) D HDG Q:$D(RAOUT)
79 N A,B S A="Imaging Type(s): ",B="" W !!,A
80 F S B=$O(^TMP($J,"RA I-TYPE",B)) Q:B']"" D Q:$D(RAOUT)
81 . I $Y>(IOSL-4) D HDG Q:$D(RAOUT) W !!,A
82 . W:$X>(IOM-($L(B))) !?($X+$L(A)) W B,?($X+3)
83 . Q
84 W !!,"TOTAL INVALID CPT CODES: ",RAICTR
85 W !,"TOTAL MISSING CPT CODES: ",RANOCTR
86 W !,"TOTAL BROKEN POINTERS TO CPT CODES: ",RABCTR
87 I '$$PCE^RAWORK() W !,"TOTAL INVALID STOP CODES: ",RAISTP,!,"TOTAL MISSING STOP CODES: ",RANOSTP
88 W !,"TOTAL PARENT PROCEDURES W/O DESCENDENTS: ",RANODESC
89 W !,"TOTAL SERIES AND/OR DETAILED PROCEDURES W/O AMIS CODES: ",RANOAMIS
90 W !!,"Note: Remember to review the entries in the Imaging Stop Codes file #71.5",!,"every year in October to make sure they agree with VA HQ rules. If the entries",!,"in file 71.5 are not accurate, this report will not be accurate.",!
91 I $$PCE^RAWORK() D ISTOP^RAPERR1
92 Q
93KILL ; Kill and quit
94 D ^%ZISC K ^TMP($J,"RAP"),^TMP($J,"RA I-TYPE")
95 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,RA71,RABCTR,RACPT,RACTR,RADT,RAI
96 K RAICTR,RAINA,RAINACT,RAISTP,RAITYPE,RALL,RAMES,RAMSG,RANOAMIS,RANOCTR
97 K RANODESC,RANOSTP,RAOUT,RAP,RAPAGE,RAPOP,RAPROC,RAPROCN,RASTP,RATYPE
98 K RAX,RAXX,X,X1,X2,Y,ZTDESC,ZTRTN,ZTSAVE
99 K DISYS,I,RA44,RA791,RAILOC
100 Q
101ZTSAVE ; Save off variable for the queued process.
102 N I F I="RADT","RALL","^TMP($J,""RA I-TYPE""," S ZTSAVE(I)=""
103 Q
Note: See TracBrowser for help on using the repository browser.