| 1 | SROCPT ;BIR/MAM,ADM - PRINT DESCRIPTION OF CPT CODE ON LOOKUP ; [ 05/14/99 11:28 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**3,31,88,127**;24 Jun 93
|
|---|
| 3 | 1 N SRCODE,SRDA,SRDATE,SRDES,SRI,SRX
|
|---|
| 4 | S SRDATE=DT
|
|---|
| 5 | S SRDA=$S($G(SRTN):SRTN,$D(DA(1)):DA(1),$D(DA):DA,1:"")
|
|---|
| 6 | I $G(SRDA) S SRDATE=$P($G(^SRF(SRDA,0)),"^",9)
|
|---|
| 7 | S SRDATE=$S($G(ICPTVDT):ICPTVDT,1:SRDATE)
|
|---|
| 8 | S SRCODE=Y,SRX=$$CPTD^ICPTCOD(SRCODE,"SRDES",,SRDATE)
|
|---|
| 9 | F SRI=1:1:SRX D:$TR(SRDES(SRI)," ")'="" EN^DDIOL(SRDES(SRI),"","!,?1")
|
|---|
| 10 | Q
|
|---|
| 11 | DISPLAY ; output principal CPT
|
|---|
| 12 | I $D(Y),Y="" Q
|
|---|
| 13 | N SRCODE,SRCPT,SRDA,SRDES,SRI,SRK,SRP,SRW,SRX,SRY,SRZ
|
|---|
| 14 | S Y=$P($$CPT^ICPTCOD(Y),"^",2),SRDA=$S($D(SRTN):SRTN,1:"") Q:SRDA=""
|
|---|
| 15 | I $D(QPQPQ) D SSPRIN Q
|
|---|
| 16 | D DES I '$O(^SRF(SRDA,"OPMOD",0)) Q
|
|---|
| 17 | S SRCPT="Principal CPT Code: "_SRW D EN^DDIOL(SRCPT,"","!,?6")
|
|---|
| 18 | S SRX="Modifiers: -"
|
|---|
| 19 | S SRI=0 F S SRI=$O(^SRF(SRDA,"OPMOD",SRI)) Q:'SRI D
|
|---|
| 20 | .S SRZ=$P(^SRF(SRDA,"OPMOD",SRI,0),"^"),SRY=$$MOD^ICPTMOD(SRZ,"I",$P($G(^SRF(SRDA,0)),"^",9)),SRX=SRX_$P(SRY,"^",2)_" "_$E($P(SRY,"^",3),1,57) D EN^DDIOL(SRX,"","!,?7") S SRX=" -"
|
|---|
| 21 | Q
|
|---|
| 22 | OTHDISP ; output other procedure CPT
|
|---|
| 23 | I $D(Y),Y="" Q
|
|---|
| 24 | N SRCODE,SRCPT,SRDA,SRDES,SRI,SRK,SRP,SRW,SRX,SRY,SRZ
|
|---|
| 25 | S SRDA(1)=$S($D(SRTN):SRTN,1:""),SRDA=$S($D(DA):DA,1:"") Q:SRDA(1)=""!(SRDA="")
|
|---|
| 26 | I $D(QPQPQ) D SSOTH Q
|
|---|
| 27 | D DES I '$O(^SRF(SRDA(1),13,SRDA,"MOD",0)) Q
|
|---|
| 28 | S SRCPT="Other CPT Code: "_SRW D EN^DDIOL(SRCPT,"","!,?6")
|
|---|
| 29 | S SRX="Modifiers: -"
|
|---|
| 30 | S SRI=0 F S SRI=$O(^SRF(SRDA(1),13,SRDA,"MOD",SRI)) Q:'SRI D
|
|---|
| 31 | .S SRZ=$P(^SRF(SRDA(1),13,SRDA,"MOD",SRI,0),"^"),SRY=$$MOD^ICPTMOD(SRZ,"I",$P($G(^SRF(SRDA(1),0)),"^",9)),SRX=SRX_$P(SRY,"^",2)_" "_$E($P(SRY,"^",3),1,57) D EN^DDIOL(SRX,"","!,?7") S SRX=" -"
|
|---|
| 32 | Q
|
|---|
| 33 | DES ; get short name and description
|
|---|
| 34 | N X,Z,SRDAA,SRDD S (SRCODE,SRK)=Y,SRDAA=$S($D(SRTN):SRTN,$D(SRDA(1)):SRDA(1),$D(SRDA):SRDA,1:"")
|
|---|
| 35 | S SRDD=DT I $G(SRDAA) S SRDD=$E($P(^SRF(SRDAA,0),"^",9),1,7)
|
|---|
| 36 | S SRY=$$CPT^ICPTCOD(SRCODE,SRDD),SRW=$P(SRY,"^",2)_" "_$P(SRY,"^",3)
|
|---|
| 37 | S SRY=$$CPTD^ICPTCOD(SRCODE,"SRDES",,SRDD),SRK=SRK_" " F SRI=1:1:SRY D Q:$L(SRK_" "_X)>245 S SRK=SRK_" "_X
|
|---|
| 38 | .S X=SRDES(SRI) F S Z=$F(X," ") Q:'Z S X=$E(X,1,Z-2)_$E(X,Z,255)
|
|---|
| 39 | S Y=SRK
|
|---|
| 40 | Q
|
|---|
| 41 | ACTIV(SRTN,SRCODE) ; screen for active CPT codes
|
|---|
| 42 | K ICPTVDT
|
|---|
| 43 | N SROK,SRSDATE S SROK=1,SRSDATE=DT
|
|---|
| 44 | I $G(SRTN) S SRSDATE=$E($P(^SRF(SRTN,0),"^",9),1,7)
|
|---|
| 45 | S SROK=$P($$CPT^ICPTCOD(SRCODE,SRSDATE),"^",7),ICPTVDT=SRSDATE
|
|---|
| 46 | Q SROK
|
|---|
| 47 | IN ; check CPT input
|
|---|
| 48 | N SRX,SRCPT K SRCMOD S SRX=X,SRCPT=$P(SRX,"-"),SRCMOD=$P(SRX,"-",2) I SRCMOD="" K SRCMOD
|
|---|
| 49 | S X=SRCPT
|
|---|
| 50 | Q
|
|---|
| 51 | SSPRIN ; append CPT modifiers to principal CPT code
|
|---|
| 52 | N SRCMOD,SRCOMMA,SRCPT,SRI,SRM,X I $O(^SRF(SRTN,"OPMOD",0)) D
|
|---|
| 53 | .S (SRCOMMA,SRI)=0,SRCMOD="",SRCPT=Y_"-" F S SRI=$O(^SRF(SRTN,"OPMOD",SRI)) Q:'SRI D
|
|---|
| 54 | ..S SRM=$P(^SRF(SRTN,"OPMOD",SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2)
|
|---|
| 55 | ..S SRCPT=SRCPT_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
|
|---|
| 56 | .S Y=SRCPT
|
|---|
| 57 | Q
|
|---|
| 58 | SSOTH ; append CPT modifiers to other CPT code
|
|---|
| 59 | N SRCMOD,SRCOMMA,SRCPT,SRI,SRM,X I $O(^SRF(SRTN,13,SRDA,"MOD",0)) D
|
|---|
| 60 | .S (SRCOMMA,SRI)=0,SRCMOD="",SRCPT=Y_"-" F S SRI=$O(^SRF(SRTN,13,SRDA,"MOD",SRI)) Q:'SRI D
|
|---|
| 61 | ..S SRM=$P(^SRF(SRTN,13,SRDA,"MOD",SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2)
|
|---|
| 62 | ..S SRCPT=SRCPT_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
|
|---|
| 63 | .S Y=SRCPT
|
|---|
| 64 | Q
|
|---|
