source: FOIAVistA/trunk/r/SURGERY-SR/SROQIDP.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1SROQIDP ;BIR/ADM - LIST OF INVASIVE DIAGNOSTIC PROCEDURES ;12/16/98 12:11 PM
2 ;;3.0; Surgery ;**62,77,50,88,142**;24 Jun 93
3 ;** NOTICE: This routine is part of an implementation of a nationally
4 ;** controlled procedure. Local modifications to this routine
5 ;** are prohibited.
6 ;
7 S SRSOUT=0 W @IOF,!,?20,"List of Invasive Diagnostic Procedures",!!,"This report displays the completed surgical cases that meet the selection",!,"criteria and that have a principal CPT code on the list below defined by"
8 W !,"Surgical Service at VHA Headquarters as invasive diagnostic procedures.",!!,?3,"Procedure Group",?30,"CPT Code(s)",!,?3,"---------------",?30,"-----------" D SHOW,PRESS^SROQIDP0 G:SRSOUT END
9SEL S (SRIO,SRSPEC)="" W @IOF S SRRPT="List of Invasive Diagnostic Procedures",SRB="O" D INOUT^SROUTL G:SRSOUT END D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END D SPEC^SROUTL G:SRSOUT END
10 N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,"^"),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,"^",2))
11IO W !!,"This report is designed to use a 132 column format.",!
12 K %ZIS,IOP,IO("Q"),POP S %ZIS("A")="Print the List of Invasive Diagnostic Procedures to which Printer ? ",%ZIS("B")="",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 G END
13 I $D(IO("Q")) K IO("Q") S ZTDESC="List of Invasive Diagnostic Procedures",(ZTSAVE("EDATE"),ZTSAVE("SRIO"),ZTSAVE("SDATE"),ZTSAVE("SRINSTP"),ZTSAVE("SRSPEC*"))="",ZTRTN="EN^SROQIDP" D ^%ZTLOAD S SRSOUT=1 G END
14EN D ^SROQIDP0
15END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
16 I 'SRSOUT,$E(IOST)'="P" D PRESS^SROQIDP0
17 D ^%ZISC K ^TMP("SR",$J),SRFRTO,SRIDP,SRIDPT,SRIO,SRIOSTAT,SRIOT,SRRPT,SRTN D ^SRSKILL W @IOF
18 Q
19AC F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D CASE Q:SRSOUT
20 Q
21CASE ; determine if case is invasive procedure
22 Q:'$P($G(^SRF(SRTN,.2)),"^",12)!($P($G(^SRF(SRTN,"NON")),"^")="Y")!$P($G(^SRF(SRTN,30)),"^")
23 S SR(0)=^SRF(SRTN,0),SRSS=$P(SR(0),"^",4) I SRSPEC Q:SRSS'=SRSPEC
24 S SRIOSTAT=$P(SR(0),"^",12) I SRIOSTAT'="I"&(SRIOSTAT'="O") S VAIP("D")=SRSD D IN5^VADPT S SRIOSTAT=$S(VAIP(13):"I",1:"O") K VAIP
25 I SRIO'="A" Q:SRIOSTAT'=SRIO
26 D IDP I SRIDP S ^TMP("SR",$J,SRSD,SRTN)=$P(SR(0),"^")_"^"_SRSS_"^"_SRIOSTAT,SRIDPT=SRIDPT+1,SRIOT(SRIOSTAT)=SRIOT(SRIOSTAT)+1
27 Q
28QTR ; entry from quarterly report
29 N SROP,SROPER S SRIDP=0 D IDP I SRIDP D ADD
30 Q
31IDP ; get CPT codes for procedures performed
32 N SRCODES,SRCPT,SRMATCH S SRIDP=0 S SROP=$P($G(^SRO(136,SRTN,0)),"^",2) I SROP S SROP=$P($$CPT^ICPTCOD(SROP),"^",2) D CHECK I SRMATCH S SRIDP=1
33 I SRIDP S SROPER=0 F S SROPER=$O(^SRO(136,SRTN,3,SROPER)) Q:'SROPER S SROP=$P($G(^SRO(136,SRTN,3,SROPER,0)),"^") I SROP D CHECK I 'SRMATCH S SRIDP=0 Q
34 Q
35CHECK ; compare procedure performed with HQ list
36 S SRMATCH=0 F J=1:1:6 Q:SRMATCH S SRCODES=$P($T(PROC+J),";;",3) F K=1:1 S SRCPT=$P(SRCODES,",",K) Q:'SRCPT I SRCPT=SROP S SRMATCH=1 Q
37 Q
38ADD ; increment counters in ^TMP
39 S $P(^TMP("SRIDP",$J),"^")=$P(^TMP("SRIDP",$J),"^")+1
40 I $P(SR(0),"^",12)="I" S $P(^TMP("SRIDP",$J),"^",2)=$P(^TMP("SRIDP",$J),"^",2)+1 Q
41 S $P(^TMP("SRIDP",$J),"^",3)=$P(^TMP("SRIDP",$J),"^",3)+1
42 Q
43SHOW ; display list of invasive diagnostic procedures
44 F I=1:1:6 S X=$T(PROC+I),SRPROC=$P(X,";;",2),SRCODES=$P(X,";;",3) W !,?3,SRPROC,?30,$E(SRCODES,1,48) I $L(SRCODES)>48 W !,?30,$E(SRCODES,49,96)
45 Q
46PROC ; HQ list of invasive diagnostic procedures
47 ;;Urologic;;52000,52005,52007,52010,52204;;
48 ;;ENT;;31231;;
49 ;;Pulmonary (Respiratory);;31615,31622,31625,31628,31629,31656;;
50 ;;Upper Gastrointestinal;;43200,43202,43234,43235,43239,43259,43263;;
51 ;;Small Bowel and Stomach;;44360,44361,44376,44377,44380,44382,44385,44386,44388,44389;;
52 ;;Colon and Rectum;;45330,45331,45355,45378,45380,46600,46606
Note: See TracBrowser for help on using the repository browser.