| [613] | 1 | SROQIDP ;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
|
|---|
| 9 | SEL 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))
|
|---|
| 11 | IO 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
|
|---|
| 14 | EN D ^SROQIDP0
|
|---|
| 15 | END 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
|
|---|
| 19 | AC 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
|
|---|
| 21 | CASE ; 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
|
|---|
| 28 | QTR ; entry from quarterly report
|
|---|
| 29 | N SROP,SROPER S SRIDP=0 D IDP I SRIDP D ADD
|
|---|
| 30 | Q
|
|---|
| 31 | IDP ; 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
|
|---|
| 35 | CHECK ; 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
|
|---|
| 38 | ADD ; 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
|
|---|
| 43 | SHOW ; 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
|
|---|
| 46 | PROC ; 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
|
|---|
