source: FOIAVistA/tag/r/SURGERY-SR/SROAUTL0.m@ 1219

Last change on this file since 1219 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1SROAUTL0 ;BIR/ADM,SLM - RISK ASSESSMENT UTILITY ;01/23/07
2 ;;3.0; Surgery ;**38,47,57,60,61,63,81,125,153,160**;24 Jun 93;Build 7
3PREOP K DR S SRQ=1,DR="325;238;240;204;203;396;332;333;338;339;215;217"
4 Q
5PREMD K DR S SRQ=1,DR=".011;247;413;417;418;419;420;421;452;453;454"
6 Q
7OPER K DR S SRQ=0,DR=".03;.04;26;27;214;.42;.035;1.09;1.13;.37;.22;.23;340;66"
8 Q
9LR K DR S SRQ=0,DR="225;292;228;295;224;291;234;301;230;297;227;294"
10 Q
11OUT1 ; man preop edit scr
12 Q
13LAB ; man lab edit scrn
14 Q
15CPTS ; put CPT codes in array for display
16 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:"")
17 I $L(Y) D SSPRIN^SROCPT0
18 S SRPROC(K)=$S($L(Y):Y,1:"NO PRIN CODE")
19 S SRDA=0 F S SRDA=$O(^SRO(136,SRTN,3,SRDA)) Q:'SRDA D
20 .S Y=$P($G(^SRO(136,SRTN,3,SRDA,0)),"^"),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"")
21 .I $L(Y) D SSOTH^SROCPT0
22 .I $L(Y)+$L(SRPROC(K))'>SRL S SRPROC(K)=SRPROC(K)_", "_Y Q
23 .S K=K+1,SRPROC(K)=Y
24 I SRPROC(1)=""!(SRPROC(1)="NO PRIN CODE") S SRPROC(1)="NOT ENTERED"
25 Q
26DISP ; display CPT code info
27 N SRFIRST,SRMO,SRMOD,SRCSTAT S SRPAGE="",SRCSTAT=">> Coding "_$S($P($G(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
28 D HDR^SROAUTL S SRFIRST=0,SRW="NOT ENTERED"
29 S Y=$P($G(^SRO(136,SRTN,0)),"^",2) I Y S Y=$P($$CPT^ICPTCOD(Y),"^",2) D DES^SROCPT0
30 W "Principal CPT Code: "_SRW I $G(SRDES(1))'="" F I=1:1 Q:$L(SRDES(I))'>1 W !,?5,SRDES(I)
31 I $O(^SRO(136,SRTN,1,0)) W !,?3,"Modifier: " D
32 .S SRMOD=0 F S SRMOD=$O(^SRO(136,SRTN,1,SRMOD)) Q:'SRMOD D
33 ..S SRMO=$P(^SRO(136,SRTN,1,SRMOD,0),"^")
34 ..W:SRFIRST !,?13 W $P($$MOD^ICPTMOD(SRMO,"I"),"^",2),"-",$P($$MOD^ICPTMOD(SRMO,"I"),"^",3)
35 ..S SRFIRST=1
36 K SRDES W !
37OTH S SROTH=0 F S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH D K SRDES W !
38 .S Y=$P($G(^SRO(136,SRTN,3,SROTH,0)),"^"),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"") D DES^SROCPT0
39 .W !,"Other CPT Code: "_SRW I $G(SRDES(1))'="" F I=1:1 Q:$L(SRDES(I))'>1 W !,?5,SRDES(I)
40 .I $O(^SRO(136,SRTN,3,SROTH,1,0)) S SRFIRST=0 W !,?3,"Modifier: " D
41 ..S SRMOD=0 F S SRMOD=$O(^SRO(136,SRTN,3,SROTH,1,SRMOD)) Q:'SRMOD D
42 ...S SRMO=$P(^SRO(136,SRTN,3,SROTH,1,SRMOD,0),"^")
43 ...W:SRFIRST !,?13 W $P($$MOD^ICPTMOD(SRMO,"I"),"^",2),"-",$P($$MOD^ICPTMOD(SRMO,"I"),"^",3)
44 ...S SRFIRST=1
45PRESS K DIR S DIR(0)="FOA",DIR("A")="Press ENTER to continue." D ^DIR K DIR
46 Q
47OCC ; occur data
48 D EN^SROCCAT K ^TMP("SROCC",$J),SRO,SROC,SROOC
49 F SRK=1:1:38 S SROC(SRK)=" "
50 S (SRFLG,SRIO,SRPO)=0 F S SRIO=$O(^SRF(SRTN,10,SRIO)) Q:'SRIO D
51 .S SROCC=$P(^SRF(SRTN,10,SRIO,0),U,2) Q:'SROCC
52 .S ^TMP("SROCC",$J,SROCC,$E($P(^SRF(SRTN,0),U,9),1,7),10)=SRIO
53 F S SRPO=$O(^SRF(SRTN,16,SRPO)) Q:'SRPO D
54 .S SRDATE=$E($P(^SRF(SRTN,16,SRPO,0),U,7),1,7)
55 .S X1=$E(SRSDATE,1,7),X2=30 D C^%DTC
56 .I SRDATE>X Q
57 .I '$G(SRDATE) S SRDATE=" "
58 .S SROCC=$P(^SRF(SRTN,16,SRPO,0),U,2) Q:'SROCC
59 .S ^TMP("SROCC",$J,SROCC,SRDATE,16)=SRPO
60 I '$D(^TMP("SROCC",$J)) D OCCEND Q
61 ;remove multiples
62 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
63 .I SROCC=21!(SROCC>28&(SROCC<33))!(SROCC=36) D
64 ..S SRDA=^TMP("SROCC",$J,SROCC,SROCCDT,SRTYPE),SRICD=$P(^SRF(SRTN,SRTYPE,SRDA,0),U,3)
65 ..I SRICD S SROOC(SROCC)=$P(^ICD9(SRICD,0),U)_"^"_$P(^SRF(SRTN,SRTYPE,SRDA,0),U)
66 ..E S SROOC(SROCC)="NO ICD9 CODE ENTERED"
67 .S ^TMP("SROCC",$J,"SR",SROCC,SROCCDT)=""
68 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
69 .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
70 .S SROC(SROCC)=SROCCDT
71 F I=1:1:22,29:1:32,35,36,38 S SRO=SRO_$J(SROC(I),7)
72 S X=$G(SRSEP),SRO=SRO_X I X S SRSEP=$S(X=2:"SEPSIS",X=3:"SEPTIC SHOCK",1:"SIRS")
73OCCEND K ^TMP("SROCC",$J),SRPOCC,SRPOCCD,SRSDATE,SRTYPE,SRDATE,SRDA,SRFLG,SRICD,SRJ,SRK,SROCC,SROCCDT,SRPO,X1,X2
74 Q
Note: See TracBrowser for help on using the repository browser.