Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROAUTL0

SROAUTL0.m

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