SROQ0A ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;06/16/04 9:38 AM
;;3.0; Surgery ;**37,38,62,70,88,103,129,142**;24 Jun 93
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
; Reference to ^DGPM("APTT1" supported by DBIA #565
;
S SRFLAG=1 D NDEX
SUP ; look at resident supervision
S SRATT=$P($G(^SRF(SRTN,.1)),"^",10) I SRATT="" D RS
S:'$D(SRATT(SRATT)) (SRATT(SRATT),SRATT("J",SRATT),SRATT("N",SRATT))=0
S SRATT(SRATT)=SRATT(SRATT)+1,SRMATCH=0,SRMM=$S(SRMM="J":"J",1:"N"),SRATT(SRMM,SRATT)=SRATT(SRMM,SRATT)+1
IDP ; invasive diagnostic?
D IDP^SROQIDP I SRIDP S SRINV(SRIOSTAT)=SRINV(SRIOSTAT)+1
I SRIOSTAT="O",SRPOC D ADM
Q
NDEX ; look at procedures performed
S SROP="",X=$P($G(^SRO(136,SRTN,0)),"^",2) S:X SROP=$P($$CPT^ICPTCOD(X),"^",2)_";"
S Y=0 F S Y=$O(^SRO(136,SRTN,3,Y)) Q:'Y I Y S X=$P($G(^SRO(136,SRTN,3,Y,0)),"^") I X S SROP=SROP_$P($$CPT^ICPTCOD(X),"^",2)_";" I $L(SROP)>239 Q
CHECK Q:SROP="" F J=1:1:12 S SRMATCH=0,SRCODES=$P($T(PROC+J),";;",3) F K=1:1 Q:SRMATCH S SRCPT=$P(SRCODES,",",K) Q:'SRCPT I SROP[SRCPT S SRMATCH=1 D:SRFLAG ADD D:'SRFLAG IXDTH Q
Q
RS ; surgical residents used?
N SRK,SRDIV,SRSITE S SRK=0,SRDIV=$P($G(^SRF(SRTN,8)),"^") I SRDIV S SRSITE=$O(^SRO(133,"B",SRDIV,0)),Y=$P(^SRO(133,SRSITE,0),"^",19) I Y=0 D Q
.I $P(^SRF(SRTN,0),"^",9)<3040401 S SRATT=1 Q
.S SRATT=9 Q
S SRATT=99
Q
ADM ; check for admission within 14 days of surgery
S (SRSDATE,X1)=$P($G(^SRF(SRTN,.2)),"^",12),X2=14 D C^%DTC S SR14=X
S SRSDATE=$O(^DGPM("APTT1",DFN,SRSDATE)) I SRSDATE,SRSDATE'>SR14 S SRADMT=SRADMT+1
Q
ADD ; increment counters in ^TMP
F I=1,2 S SRP(I)=$P(^TMP("SRPROC",$J,J),"^",I)
S SRP(1)=SRP(1)+1 S:SRPOC!($O(^SRF(SRTN,10,0))) SRP(2)=SRP(2)+1
S ^TMP("SRPROC",$J,J)=SRP(1)_"^"_SRP(2) K SRP
Q
IXDTH S ^TMP("SRDEATH",$J,DFN)=SRTN_"^"_J I SRREL="R" S ^TMP("SRP",$J,DFN,(9999999-$P(^SRF(SRTN,0),"^",9)))=J
Q
IXOUT ; get procedure name for output
S SROP=$P($T(PROC+J),";;",2)
Q
SHOW ; display list of procedures with CPT codes
F I=1:1:12 S X=$T(PROC+I),SRPROC=$P(X,";;",2),SRCODES=$P(X,";;",3) D
.I SRPROC["," W:I=7 !,?4,$P(SRPROC,",") S SRPROC=$P(SRPROC,",",2)
.W !,?4,SRPROC,?30,$E(SRCODES,1,48) I $L(SRCODES)>48 W !,?30,$E(SRCODES,49,96)
Q
TMP ; store index procedure names in ^TMP
F J=1:1:12 S ^TMP("SRIP",$J,J)=$P($T(PROC+J),";;",2)
Q
DRPT ; from report of deaths within 30 days
S SROP="",X=$P($G(^SRO(136,SRTN,0)),"^",2) S:X SROP=$P($$CPT^ICPTCOD(X),"^",2)_";"
S Y=0 F S Y=$O(^SRO(136,SRTN,3,Y)) Q:'Y I Y S X=$P($G(^SRO(136,SRTN,3,Y,0)),"^") I X S SROP=SROP_$P($$CPT^ICPTCOD(X),"^",2)_";" I $L(SROP)>239 Q
CK1 Q:SROP="" F J=1:1:12 S SRMATCH=0,SRCODES=$P($T(PROC+J),";;",3) F K=1:1 Q:SRMATCH S SRCPT=$P(SRCODES,",",K) Q:'SRCPT I SROP[SRCPT D Q
.S SRMATCH=1,^TMP("SRDEATH",$J,DFN)=J,^TMP("SRNAT",$J,DFN,J)=SRTN
.S:SRREL="R" ^TMP("SRREL",$J,DFN,(9999999-SRSD),SRTN)=J
Q
PROC ; index procedures
P1 ;;Inguinal Hernia;;49505,49507,49520,49521,49525;;
P2 ;;Cholecystectomy;;47600,47605,47610,47562,47563,47564;;
P3 ;;Coronary Artery Bypass;;33510,33511,33512,33513,33514,33516,33517,33518,33519,33521,33522,33523,33533,33534,33535,33536;;
P4 ;;Colon Resection (L & R);;44140,44141,44143,44144,44145,44146,44147,44160;;
P5 ;;Fem-Pop Bypass;;35656,35556;;
P6 ;;Pulmonary Lobectomy;;32480,32500,32440;;
P7 ;;Hip Replacement, - Elective;;27125,27130,27132,27134,27137,27138;;
P8 ;;Hip Replacement, - Acute Fracture;;27236;;
P9 ;;TURP;;52601;;
P10 ;;Laryngectomy;;31360,31365,31367,31368;;
P11 ;;Craniotomy;;61304,61305,61312,61314,61510,61512,61518,61519,61700,61680;;
P12 ;;Intraoccular Lens;;66983,66984;;
SROQ0A ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;06/16/04 9:38 AM
+1 ;;3.0; Surgery ;**37,38,62,70,88,103,129,142**;24 Jun 93
+2 ;** NOTICE: This routine is part of an implementation of a nationally
+3 ;** controlled procedure. Local modifications to this routine
+4 ;** are prohibited.
+5 ;
+6 ; Reference to ^DGPM("APTT1" supported by DBIA #565
+7 ;
+8 SET SRFLAG=1
DO NDEX
SUP ; look at resident supervision
+1 SET SRATT=$PIECE($GET(^SRF(SRTN,.1)),"^",10)
IF SRATT=""
DO RS
+2 IF '$DATA(SRATT(SRATT))
SET (SRATT(SRATT),SRATT("J",SRATT),SRATT("N",SRATT))=0
+3 SET SRATT(SRATT)=SRATT(SRATT)+1
SET SRMATCH=0
SET SRMM=$SELECT(SRMM="J":"J",1:"N")
SET SRATT(SRMM,SRATT)=SRATT(SRMM,SRATT)+1
IDP ; invasive diagnostic?
+1 DO IDP^SROQIDP
IF SRIDP
SET SRINV(SRIOSTAT)=SRINV(SRIOSTAT)+1
+2 IF SRIOSTAT="O"
IF SRPOC
DO ADM
+3 QUIT
NDEX ; look at procedures performed
+1 SET SROP=""
SET X=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
IF X
SET SROP=$PIECE($$CPT^ICPTCOD(X),"^",2)_";"
+2 SET Y=0
FOR
SET Y=$ORDER(^SRO(136,SRTN,3,Y))
IF 'Y
QUIT
IF Y
SET X=$PIECE($GET(^SRO(136,SRTN,3,Y,0)),"^")
IF X
SET SROP=SROP_$PIECE($$CPT^ICPTCOD(X),"^",2)_";"
IF $LENGTH(SROP)>239
QUIT
CHECK IF SROP=""
QUIT
FOR J=1:1:12
SET SRMATCH=0
SET SRCODES=$PIECE($TEXT(PROC+J),";;",3)
FOR K=1:1
IF SRMATCH
QUIT
SET SRCPT=$PIECE(SRCODES,",",K)
IF 'SRCPT
QUIT
IF SROP[SRCPT
SET SRMATCH=1
IF SRFLAG
DO ADD
IF 'SRFLAG
DO IXDTH
QUIT
+1 QUIT
RS ; surgical residents used?
+1 NEW SRK,SRDIV,SRSITE
SET SRK=0
SET SRDIV=$PIECE($GET(^SRF(SRTN,8)),"^")
IF SRDIV
SET SRSITE=$ORDER(^SRO(133,"B",SRDIV,0))
SET Y=$PIECE(^SRO(133,SRSITE,0),"^",19)
IF Y=0
Begin DoDot:1
+2 IF $PIECE(^SRF(SRTN,0),"^",9)<3040401
SET SRATT=1
QUIT
+3 SET SRATT=9
QUIT
End DoDot:1
QUIT
+4 SET SRATT=99
+5 QUIT
ADM ; check for admission within 14 days of surgery
+1 SET (SRSDATE,X1)=$PIECE($GET(^SRF(SRTN,.2)),"^",12)
SET X2=14
DO C^%DTC
SET SR14=X
+2 SET SRSDATE=$ORDER(^DGPM("APTT1",DFN,SRSDATE))
IF SRSDATE
IF SRSDATE'>SR14
SET SRADMT=SRADMT+1
+3 QUIT
ADD ; increment counters in ^TMP
+1 FOR I=1,2
SET SRP(I)=$PIECE(^TMP("SRPROC",$JOB,J),"^",I)
+2 SET SRP(1)=SRP(1)+1
IF SRPOC!($ORDER(^SRF(SRTN,10,0)))
SET SRP(2)=SRP(2)+1
+3 SET ^TMP("SRPROC",$JOB,J)=SRP(1)_"^"_SRP(2)
KILL SRP
+4 QUIT
IXDTH SET ^TMP("SRDEATH",$JOB,DFN)=SRTN_"^"_J
IF SRREL="R"
SET ^TMP("SRP",$JOB,DFN,(9999999-$PIECE(^SRF(SRTN,0),"^",9)))=J
+1 QUIT
IXOUT ; get procedure name for output
+1 SET SROP=$PIECE($TEXT(PROC+J),";;",2)
+2 QUIT
SHOW ; display list of procedures with CPT codes
+1 FOR I=1:1:12
SET X=$TEXT(PROC+I)
SET SRPROC=$PIECE(X,";;",2)
SET SRCODES=$PIECE(X,";;",3)
Begin DoDot:1
+2 IF SRPROC[","
IF I=7
WRITE !,?4,$PIECE(SRPROC,",")
SET SRPROC=$PIECE(SRPROC,",",2)
+3 WRITE !,?4,SRPROC,?30,$EXTRACT(SRCODES,1,48)
IF $LENGTH(SRCODES)>48
WRITE !,?30,$EXTRACT(SRCODES,49,96)
End DoDot:1
+4 QUIT
TMP ; store index procedure names in ^TMP
+1 FOR J=1:1:12
SET ^TMP("SRIP",$JOB,J)=$PIECE($TEXT(PROC+J),";;",2)
+2 QUIT
DRPT ; from report of deaths within 30 days
+1 SET SROP=""
SET X=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
IF X
SET SROP=$PIECE($$CPT^ICPTCOD(X),"^",2)_";"
+2 SET Y=0
FOR
SET Y=$ORDER(^SRO(136,SRTN,3,Y))
IF 'Y
QUIT
IF Y
SET X=$PIECE($GET(^SRO(136,SRTN,3,Y,0)),"^")
IF X
SET SROP=SROP_$PIECE($$CPT^ICPTCOD(X),"^",2)_";"
IF $LENGTH(SROP)>239
QUIT
CK1 IF SROP=""
QUIT
FOR J=1:1:12
SET SRMATCH=0
SET SRCODES=$PIECE($TEXT(PROC+J),";;",3)
FOR K=1:1
IF SRMATCH
QUIT
SET SRCPT=$PIECE(SRCODES,",",K)
IF 'SRCPT
QUIT
IF SROP[SRCPT
Begin DoDot:1
+1 SET SRMATCH=1
SET ^TMP("SRDEATH",$JOB,DFN)=J
SET ^TMP("SRNAT",$JOB,DFN,J)=SRTN
+2 IF SRREL="R"
SET ^TMP("SRREL",$JOB,DFN,(9999999-SRSD),SRTN)=J
End DoDot:1
QUIT
+3 QUIT
PROC ; index procedures
P1 ;;Inguinal Hernia;;49505,49507,49520,49521,49525;;
P2 ;;Cholecystectomy;;47600,47605,47610,47562,47563,47564;;
P3 ;;Coronary Artery Bypass;;33510,33511,33512,33513,33514,33516,33517,33518,33519,33521,33522,33523,33533,33534,33535,33536;;
P4 ;;Colon Resection (L & R);;44140,44141,44143,44144,44145,44146,44147,44160;;
P5 ;;Fem-Pop Bypass;;35656,35556;;
P6 ;;Pulmonary Lobectomy;;32480,32500,32440;;
P7 ;;Hip Replacement, - Elective;;27125,27130,27132,27134,27137,27138;;
P8 ;;Hip Replacement, - Acute Fracture;;27236;;
P9 ;;TURP;;52601;;
P10 ;;Laryngectomy;;31360,31365,31367,31368;;
P11 ;;Craniotomy;;61304,61305,61312,61314,61510,61512,61518,61519,61700,61680;;
P12 ;;Intraoccular Lens;;66983,66984;;
