75 lines
3.8 KiB
Mathematica
75 lines
3.8 KiB
Mathematica
SROAUTL0 ;BIR/ADM,SLM - RISK ASSESSMENT UTILITY ;01/23/07
|
|
;;3.0; Surgery ;**38,47,57,60,61,63,81,125,153,160**;24 Jun 93;Build 7
|
|
PREOP K DR S SRQ=1,DR="325;238;240;204;203;396;332;333;338;339;215;217"
|
|
Q
|
|
PREMD K DR S SRQ=1,DR=".011;247;413;417;418;419;420;421;452;453;454"
|
|
Q
|
|
OPER K DR S SRQ=0,DR=".03;.04;26;27;214;.42;.035;1.09;1.13;.37;.22;.23;340;66"
|
|
Q
|
|
LR K DR S SRQ=0,DR="225;292;228;295;224;291;234;301;230;297;227;294"
|
|
Q
|
|
OUT1 ; man preop edit scr
|
|
Q
|
|
LAB ; man lab edit scrn
|
|
Q
|
|
CPTS ; put CPT codes in array for display
|
|
N SRDA,K,X,XX,Y K SRPROC S K=1,Y=$P($G(^SRO(136,SRTN,0)),"^",2),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"")
|
|
I $L(Y) D SSPRIN^SROCPT0
|
|
S SRPROC(K)=$S($L(Y):Y,1:"NO PRIN CODE")
|
|
S SRDA=0 F S SRDA=$O(^SRO(136,SRTN,3,SRDA)) Q:'SRDA D
|
|
.S Y=$P($G(^SRO(136,SRTN,3,SRDA,0)),"^"),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"")
|
|
.I $L(Y) D SSOTH^SROCPT0
|
|
.I $L(Y)+$L(SRPROC(K))'>SRL S SRPROC(K)=SRPROC(K)_", "_Y Q
|
|
.S K=K+1,SRPROC(K)=Y
|
|
I SRPROC(1)=""!(SRPROC(1)="NO PRIN CODE") S SRPROC(1)="NOT ENTERED"
|
|
Q
|
|
DISP ; display CPT code info
|
|
N SRFIRST,SRMO,SRMOD,SRCSTAT S SRPAGE="",SRCSTAT=">> Coding "_$S($P($G(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
|
|
D HDR^SROAUTL S SRFIRST=0,SRW="NOT ENTERED"
|
|
S Y=$P($G(^SRO(136,SRTN,0)),"^",2) I Y S Y=$P($$CPT^ICPTCOD(Y),"^",2) D DES^SROCPT0
|
|
W "Principal CPT Code: "_SRW I $G(SRDES(1))'="" F I=1:1 Q:$L(SRDES(I))'>1 W !,?5,SRDES(I)
|
|
I $O(^SRO(136,SRTN,1,0)) W !,?3,"Modifier: " D
|
|
.S SRMOD=0 F S SRMOD=$O(^SRO(136,SRTN,1,SRMOD)) Q:'SRMOD D
|
|
..S SRMO=$P(^SRO(136,SRTN,1,SRMOD,0),"^")
|
|
..W:SRFIRST !,?13 W $P($$MOD^ICPTMOD(SRMO,"I"),"^",2),"-",$P($$MOD^ICPTMOD(SRMO,"I"),"^",3)
|
|
..S SRFIRST=1
|
|
K SRDES W !
|
|
OTH S SROTH=0 F S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH D K SRDES W !
|
|
.S Y=$P($G(^SRO(136,SRTN,3,SROTH,0)),"^"),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"") D DES^SROCPT0
|
|
.W !,"Other CPT Code: "_SRW I $G(SRDES(1))'="" F I=1:1 Q:$L(SRDES(I))'>1 W !,?5,SRDES(I)
|
|
.I $O(^SRO(136,SRTN,3,SROTH,1,0)) S SRFIRST=0 W !,?3,"Modifier: " D
|
|
..S SRMOD=0 F S SRMOD=$O(^SRO(136,SRTN,3,SROTH,1,SRMOD)) Q:'SRMOD D
|
|
...S SRMO=$P(^SRO(136,SRTN,3,SROTH,1,SRMOD,0),"^")
|
|
...W:SRFIRST !,?13 W $P($$MOD^ICPTMOD(SRMO,"I"),"^",2),"-",$P($$MOD^ICPTMOD(SRMO,"I"),"^",3)
|
|
...S SRFIRST=1
|
|
PRESS K DIR S DIR(0)="FOA",DIR("A")="Press ENTER to continue." D ^DIR K DIR
|
|
Q
|
|
OCC ; occur data
|
|
D EN^SROCCAT K ^TMP("SROCC",$J),SRO,SROC,SROOC
|
|
F SRK=1:1:38 S SROC(SRK)=" "
|
|
S (SRFLG,SRIO,SRPO)=0 F S SRIO=$O(^SRF(SRTN,10,SRIO)) Q:'SRIO D
|
|
.S SROCC=$P(^SRF(SRTN,10,SRIO,0),U,2) Q:'SROCC
|
|
.S ^TMP("SROCC",$J,SROCC,$E($P(^SRF(SRTN,0),U,9),1,7),10)=SRIO
|
|
F S SRPO=$O(^SRF(SRTN,16,SRPO)) Q:'SRPO D
|
|
.S SRDATE=$E($P(^SRF(SRTN,16,SRPO,0),U,7),1,7)
|
|
.S X1=$E(SRSDATE,1,7),X2=30 D C^%DTC
|
|
.I SRDATE>X Q
|
|
.I '$G(SRDATE) S SRDATE=" "
|
|
.S SROCC=$P(^SRF(SRTN,16,SRPO,0),U,2) Q:'SROCC
|
|
.S ^TMP("SROCC",$J,SROCC,SRDATE,16)=SRPO
|
|
I '$D(^TMP("SROCC",$J)) D OCCEND Q
|
|
;remove multiples
|
|
S SROCC=0 F S SROCC=$O(^TMP("SROCC",$J,SROCC)) Q:'SROCC S SROCCDT=$O(^TMP("SROCC",$J,SROCC,0)),SRTYPE=$O(^TMP("SROCC",$J,SROCC,SROCCDT,0)) D
|
|
.I SROCC=21!(SROCC>28&(SROCC<33))!(SROCC=36) D
|
|
..S SRDA=^TMP("SROCC",$J,SROCC,SROCCDT,SRTYPE),SRICD=$P(^SRF(SRTN,SRTYPE,SRDA,0),U,3)
|
|
..I SRICD S SROOC(SROCC)=$P(^ICD9(SRICD,0),U)_"^"_$P(^SRF(SRTN,SRTYPE,SRDA,0),U)
|
|
..E S SROOC(SROCC)="NO ICD9 CODE ENTERED"
|
|
.S ^TMP("SROCC",$J,"SR",SROCC,SROCCDT)=""
|
|
S SRK=1,SRO="",SROCC=0 F S SROCC=$O(^TMP("SROCC",$J,"SR",SROCC)) Q:'SROCC S SROCCDT="" F S SROCCDT=$O(^TMP("SROCC",$J,"SR",SROCC,SROCCDT)) Q:SROCCDT="" D
|
|
.I SROCC=3 S SRPO=^TMP("SROCC",$J,SROCC,SROCCDT,16) I SRPO S X=$P(^SRF(SRTN,16,SRPO,0),"^",4) S:X SRSEP=X
|
|
.S SROC(SROCC)=SROCCDT
|
|
F I=1:1:22,29:1:32,35,36,38 S SRO=SRO_$J(SROC(I),7)
|
|
S X=$G(SRSEP),SRO=SRO_X I X S SRSEP=$S(X=2:"SEPSIS",X=3:"SEPTIC SHOCK",1:"SIRS")
|
|
OCCEND K ^TMP("SROCC",$J),SRPOCC,SRPOCCD,SRSDATE,SRTYPE,SRDATE,SRDA,SRFLG,SRICD,SRJ,SRK,SROCC,SROCCDT,SRPO,X1,X2
|
|
Q
|