| [613] | 1 | SROACC2 ;BIR/MAM - CPT ACCURACY ALL CODES AND 1 SPECIALTY ;05/14/99 11:33 AM
|
|---|
| 2 | ;;3.0; Surgery ;**37,50,88,127,142**;24 Jun 93
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^ECC(723 supported by DBIA #205
|
|---|
| 5 | ;
|
|---|
| 6 | S SRSPEC=SRSS,SRSS=$S(SRFLG=1:$P(^SRO(137.45,SRSS,0),"^"),1:$P(^ECC(723,SRSS,0),"^"))
|
|---|
| 7 | S SRSDT=SDATE1 F S SRSDT=$O(^SRF("AC",SRSDT)) Q:SRSDT>EDATE1!('SRSDT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$P($G(^SRF(SRTN,30)),"^")="",$$DIV^SROUTL0(SRTN) D UTIL
|
|---|
| 8 | S SRHDR=0 D HDR^SROACC0 S CPT=0 F S CPT=$O(^TMP("SR",$J,SRSS,CPT)) Q:'CPT!(SRSOUT) D MORE
|
|---|
| 9 | I '$D(^TMP("SR",$J)) D LINE W $$NODATA^SROUTL0()
|
|---|
| 10 | Q
|
|---|
| 11 | MORE ; print CPT description and get cases
|
|---|
| 12 | I $Y+12>IOSL D HDR^SROACC0 I SRSOUT Q
|
|---|
| 13 | S TYPE=0,X=$$CPT^ICPTCOD(CPT,EDATE),CPT1=$P(X,"^",2)_" "_$P(X,"^",3)
|
|---|
| 14 | F S TYPE=$O(^TMP("SR",$J,SRSS,CPT,TYPE)) Q:TYPE="" D DESC S SRSDT=0 F S SRSDT=$O(^TMP("SR",$J,SRSS,CPT,TYPE,SRSDT)) Q:'SRSDT!(SRSOUT) D SRTN
|
|---|
| 15 | Q
|
|---|
| 16 | SRTN S SRTN=0 F S SRTN=$O(^TMP("SR",$J,SRSS,CPT,TYPE,SRSDT,SRTN)) Q:'SRTN!(SRSOUT) D PRINT
|
|---|
| 17 | Q
|
|---|
| 18 | LOOP ; break procedure greater than 50 characters
|
|---|
| 19 | S SROP(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROP(M))+$L(MM)'<50 S SROP(M)=SROP(M)_MM_" ",SROPER=MMM
|
|---|
| 20 | Q
|
|---|
| 21 | DESC ; print description
|
|---|
| 22 | Q:SRSOUT I '$O(^TMP("SR",$J,SRSS,CPT,TYPE,0)) Q
|
|---|
| 23 | D LINE W !!,?(132-$L(CPT1)\2),CPT1
|
|---|
| 24 | I TYPE=1 W !,?50,"PRINCIPAL PROCEDURES"
|
|---|
| 25 | I TYPE=2 W !,?54,"OTHER PROCEDURES"
|
|---|
| 26 | K SRDESC S X=$$CPTD^ICPTCOD(CPT,"SRDESC",,EDATE) F I=1:1:X S Y=$S(I=1:"DESCRIPTION: "_SRDESC(I),1:SRDESC(I)) W !,?(132-$L(Y)\2),Y
|
|---|
| 27 | W !! F LINE=1:1:132 W "-"
|
|---|
| 28 | Q
|
|---|
| 29 | PRINT ; print each case
|
|---|
| 30 | I $Y+5>IOSL D HDR^SROACC0 Q:SRSOUT D DESC
|
|---|
| 31 | S SRNON=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
|
|---|
| 32 | S DFN=$P(^SRF(SRTN,0),"^"),Y=SRSDT D D^DIQ S SRDT=Y
|
|---|
| 33 | S Y=$P(SRDT,"@",2),SRDT=$E(SRSDT,4,5)_"/"_$E(SRSDT,6,7)_"/"_$E(SRSDT,2,3)_" "_Y
|
|---|
| 34 | D DEM^VADPT S SRNAME=VADM(1),SSN=VA("PID"),SR(.1)=$S($D(^SRF(SRTN,.1)):^(.1),1:""),SRSUR=$S(SRNON:$P(^SRF(SRTN,"NON"),"^",6),1:$P(SR(.1),"^",4)),SRATT=$S(SRNON:$P(^SRF(SRTN,"NON"),"^",7),1:$P(SR(.1),"^",13))
|
|---|
| 35 | I SRSUR S SRSUR=$P(^VA(200,SRSUR,0),"^") I $L(SRSUR)>20 S SRSUR=$P(SRSUR,",")_", "_$E($P(SRSUR,",",2))
|
|---|
| 36 | I SRATT S SRATT=$P(^VA(200,SRATT,0),"^") I $L(SRATT)>20 S SRATT=$P(SRATT,",")_", "_$E($P(SRATT,",",2))
|
|---|
| 37 | D OPER^SROACC0
|
|---|
| 38 | K SROP,SROPT,MM,MMM S:$L(SROPER)<51 SROP(1)=SROPER I $L(SROPER)>50 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
|
|---|
| 39 | W !,SRDT,?20,SRNAME,?60,SROP(1),?111,SRSUR,!,?3,SRTN,?20,VA("PID") W:$D(SROP(2)) ?60,SROP(2) W ?111,SRATT,! W:SRFLG=3&(SRNON) "NON-O.R." I $D(SROP(3)) W ?60,SROP(3) I $D(SROP(4)) W !,?60,SROP(4) I $D(SROP(5)) W !,?60,SROP(5)
|
|---|
| 40 | I $D(SRCPTT) S:$L(SRCPTT)<51 SROPT(1)=SRCPTT I $L(SRCPTT)>50 S SRCPTT=SRCPTT_" " F M=1:1 D LOOP^SROACC0 Q:MMM=""
|
|---|
| 41 | I $D(SRCPTT) F LOOP=1:1 Q:'$D(SROPT(LOOP)) W !,?60,SROPT(LOOP)
|
|---|
| 42 | W ! Q
|
|---|
| 43 | UTIL ; set ^TMP("SR")
|
|---|
| 44 | S SRNON=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
|
|---|
| 45 | I SRFLG=1!(SRFLG=3&('SRNON)) Q:$P($G(^SRF(SRTN,.2)),"^",12)=""
|
|---|
| 46 | I SRFLG=2 Q:'SRNON
|
|---|
| 47 | S CPT=$P($G(^SRO(136,SRTN,0)),"^",2)
|
|---|
| 48 | I 'SRNON S X=$P(^SRF(SRTN,0),"^",4) I X'=SRSPEC Q
|
|---|
| 49 | I SRNON S X=$P(^SRF(SRTN,"NON"),"^",8) I X'=SRSPEC Q
|
|---|
| 50 | I CPT S ^TMP("SR",$J,SRSS,CPT,1,SRSDT,SRTN)=""
|
|---|
| 51 | S OP=0 F S OP=$O(^SRO(136,SRTN,3,OP)) Q:'OP I $P($G(^SRO(136,SRTN,3,OP,0)),"^") S CPT=$P(^(0),"^"),^TMP("SR",$J,SRSS,CPT,2,SRSDT,SRTN)=""
|
|---|
| 52 | Q
|
|---|
| 53 | LINE W ! F LINE=1:1:132 W "="
|
|---|
| 54 | Q
|
|---|
