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