1 | SROAUTL ;BIR/ADM - RISK ASSESSMENT UTILITY ;02/14/07
|
---|
2 | ;;3.0; Surgery ;**38,46,47,63,81,88,95,112,100,125,134,142,153,160**;24 Jun 93;Build 7
|
---|
3 | I $G(SRSUPCPT)=2 G NCODE
|
---|
4 | N SRCMOD,SRCOMMA,X K SRHDR S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRHDR=VADM(1)_" ("_VA("PID")_") Case #"_SRTN
|
---|
5 | S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) X ^DD("DD") S SRSDATE=Y
|
---|
6 | S X=^SRF(SRTN,"OP"),SROPER=$P(X,"^"),Y=$P(X,"^",2),SRCPT=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"CPT MISSING") I SRCPT,$O(^SRF(SRTN,"OPMOD",0)) D
|
---|
7 | .S (SRCOMMA,SRI)=0,SRCMOD="",SRCPT=SRCPT_"-" F S SRI=$O(^SRF(SRTN,"OPMOD",SRI)) Q:'SRI D
|
---|
8 | ..S SRM=$P(^SRF(SRTN,"OPMOD",SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2)
|
---|
9 | ..S SRCPT=SRCPT_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
|
---|
10 | S SRCPT=$S($G(SRSUPCPT)=1:"",1:"("_SRCPT_")")
|
---|
11 | S SROPER=SROPER_" "_SRCPT D LOOP S SRHDR(1)=SRSDATE_" "_SRHDR(1)
|
---|
12 | Q
|
---|
13 | NCODE N SRCMOD,SRCOMMA,X K SRHDR S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRHDR=VADM(1)_" ("_VA("PID")_") Case #"_SRTN
|
---|
14 | S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) X ^DD("DD") S SRSDATE=Y
|
---|
15 | S X=^SRF(SRTN,"OP"),SROPER=$P(X,"^"),Y=$P($G(^SRO(136,SRTN,0)),"^",2),SRCPT=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"CPT MISSING") I SRCPT,$O(^SRO(136,SRTN,1,0)) D
|
---|
16 | .S (SRCOMMA,SRI)=0,SRCMOD="",SRCPT=SRCPT_"-" F S SRI=$O(^SRO(136,SRTN,1,SRI)) Q:'SRI D
|
---|
17 | ..S SRM=$P(^SRO(136,SRTN,1,SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2)
|
---|
18 | ..S SRCPT=SRCPT_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
|
---|
19 | S SRCPT="(CPT Code: "_SRCPT_")"
|
---|
20 | S SROPER=SROPER_" "_SRCPT D LOOP S SRHDR(1)=SRSDATE_" "_SRHDR(1)
|
---|
21 | Q
|
---|
22 | LOOP I $L(SROPER)<68 S SRHDR(1)=SROPER Q
|
---|
23 | I $L(SROPER)>67 S X=SROPER,K=1 F D I $L(X)<68 S SRHDR(K)=X Q
|
---|
24 | .F I=0:1:66 S J=67-I,Y=$E(X,J) I Y=" " S SRHDR(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
|
---|
25 | Q
|
---|
26 | HDR ; print screen header
|
---|
27 | W @IOF,!,SRHDR W:$G(SRPAGE)'="" ?(79-$L(SRPAGE)),SRPAGE
|
---|
28 | S I=0 F S I=$O(SRHDR(I)) Q:'I W !,SRHDR(I) I I=.5,$L($G(SRCSTAT)) W ?(79-$L(SRCSTAT)),SRCSTAT
|
---|
29 | W:$D(SRCSTAT)&'$D(SRHDR(.5)) !,SRCSTAT
|
---|
30 | K SRHDR(.5),SRCSTAT,SRPAGE W ! F I=1:1:80 W "-"
|
---|
31 | W !
|
---|
32 | Q
|
---|
33 | FUNCT() ; called by screen on functional health status field (#240)
|
---|
34 | N SRSCR S SRSCR="I 1"
|
---|
35 | I $$CARD S SRSCR="I Y'=4"
|
---|
36 | Q SRSCR
|
---|
37 | CARD() ; is this a cardiac assessed case?
|
---|
38 | N SRX S SRX=$S($D(SRTN):SRTN,$D(DA):DA,1:"") I 'SRX Q 0
|
---|
39 | I $P($G(^SRF(SRX,"RA")),"^",2)="C" Q 1
|
---|
40 | Q 0
|
---|
41 | NC ; called from input transform to kill X if case is cardiac assessed
|
---|
42 | I $$CARD,X="NA"!(X="NS") K X
|
---|
43 | Q
|
---|
44 | DATE ; called by output transmform on several date fields
|
---|
45 | I $D(Y),Y="NA"!(Y="NS") Q
|
---|
46 | N SRY S SRY=Y D DD^%DT
|
---|
47 | Q
|
---|
48 | INDX ; set airway index
|
---|
49 | S SRY=$S(SRI>4:5,SRI>3:4,SRI>2:3,SRI>0:2,1:1),$P(^SRF(DA,.3),"^",9)=SRY
|
---|
50 | K SRI,SRMS,SROP,SRY
|
---|
51 | Q
|
---|
52 | OP ; set logic for AOP cross reference on Oral-Pharyngeal field (901.1)
|
---|
53 | N SRI,SRMS,SRY S SRMS=$P(^SRF(DA,.3),"^",12) I SRMS'="" S SRMS=SRMS*.1,SRI=2.5*X-SRMS D INDX
|
---|
54 | Q
|
---|
55 | MS ; set logic for AMS cross reference on Mandibular Space field (901.2)
|
---|
56 | N SRI,SRY,SRMS,SROP S SROP=$P(^SRF(DA,.3),"^",11) I SROP'="" S SRMS=X*.1,SRI=2.5*SROP-SRMS D INDX
|
---|
57 | Q
|
---|
58 | K901 ; kill logic for AOP and AMS cross references
|
---|
59 | S $P(^SRF(DA,.3),"^",9)=""
|
---|
60 | Q
|
---|
61 | DUP ; duplicate preop information from prior operation within 60 days
|
---|
62 | S SR200=$G(^SRF(SRTN,200)) S NOGO="" F I=1,9,13,18,30,37,44 S X=$P(SR200,"^",I) I X'="" S NOGO=1 K SR200 Q
|
---|
63 | S X=$P($G(^SRF(SRTN,200.1)),"^") I X'="" S NOGO=1
|
---|
64 | I NOGO K NOGO Q
|
---|
65 | K SRCASE S SR=^SRF(SRTN,0),DFN=$P(SR,"^"),(SRSDATE,X1)=$P(SR,"^",9),X2=-60 D C^%DTC S SRENDT=X,SRCASE=0 F S SRCASE=$O(^SRF("B",DFN,SRCASE)) Q:'SRCASE I SRCASE,SRCASE'=SRTN D
|
---|
66 | .S SRX=$P(^SRF(SRCASE,0),"^",9) I SRX>SRSDATE!(SRX<SRENDT) Q
|
---|
67 | .Q:$P($G(^SRF(SRCASE,"NON")),"^")="Y"!$P($G(^SRF(SRCASE,30)),"^")!$P($G(^SRF(SRCASE,31)),"^",8)!($P($G(^SRF(SRCASE,"CON")),"^")=SRTN)!'$P($G(^SRF(SRCASE,.2)),"^",12)
|
---|
68 | .S SRX=9999999-SRX,SRCASE(SRX,SRCASE)=""
|
---|
69 | K SRDT S (SRX,Y)=0 F S SRX=$O(SRCASE(SRX)) Q:'SRX!$D(SRDT) S SRCASE="" F S SRCASE=$O(SRCASE(SRX,SRCASE)) Q:'SRCASE S SR=$G(^SRF(SRCASE,"RA")) I $P(SR,"^",2)="N",$P(SR,"^",6)="Y" D Q
|
---|
70 | .S Y=$P(^SRF(SRCASE,0),"^",9) X ^DD("DD") S SRDT=Y K DIR
|
---|
71 | .W !! S DIR("A",1)="This patient had a previous non-cardiac operation on "_SRDT_".",DIR("A",2)="",DIR("A",3)="Case #"_SRCASE_" "_$P(^SRF(SRCASE,"OP"),"^")
|
---|
72 | .S DIR("A",4)="",DIR("A",5)="Do you want to duplicate the preoperative information from the earlier",DIR("A")="assessment in this assessment? "
|
---|
73 | .S DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
|
---|
74 | .D:Y STUFF
|
---|
75 | Q
|
---|
76 | STUFF ; stuff preop information from previous case
|
---|
77 | I $$LOCK^SROUTL(SRCASE) D D UNLOCK^SROUTL(SRCASE)
|
---|
78 | .K DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRCASE,DIQ="SRY",DIQ(0)="I" D PREHD D EN^DIQ1 K DA,DIC,DIQ,DR
|
---|
79 | .S SRZ=0 F S SRZ=$O(SRY(130,SRCASE,SRZ)) Q:'SRZ S DIE=130,DA=SRTN,DR=SRZ_"////"_SRY(130,SRCASE,SRZ,"I") D ^DIE K DA,DIE,DR
|
---|
80 | Q
|
---|
81 | CHK ; check for missing non-cardiac assessment data items
|
---|
82 | N SRSEP K SRX
|
---|
83 | F SRC="PREOP","DEM" K DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I" D @SRC D EN^DIQ1 D ^SROAUTL1
|
---|
84 | F SRC="LAB","REM" K DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I" D @SRC D EN^DIQ1 D ^SROAUTL2
|
---|
85 | OTH K DA,DIC,DIQ,DR,SRY,SRZ D TECH^SROPRIN I SRTECH="NOT ENTERED" S SRX("ANESTHESIA TECHNIQUE")="Anesthesia Technique"
|
---|
86 | ;D RELATE^SROAUTL2
|
---|
87 | OCC D EN^SROCCAT S SRSDATE=$E($P(^SRF(SRTN,0),"^",9),1,7) K ^TMP("SROCC",$J),SRO
|
---|
88 | S SRPO=0 F S SRPO=$O(^SRF(SRTN,10,SRPO)) Q:'SRPO S ^TMP("SROCC",$J,$P(^SRF(SRTN,10,SRPO,0),"^",2),SRSDATE)=""
|
---|
89 | S SRPO=0 F S SRPO=$O(^SRF(SRTN,16,SRPO)) Q:'SRPO S SRDATE=$E($P(^SRF(SRTN,16,SRPO,0),"^",7),1,7) D
|
---|
90 | .S SRSEP=$P(^SRF(SRTN,16,SRPO,0),"^",4)
|
---|
91 | .I '$G(SRDATE) S SRDATE="NO DATE"
|
---|
92 | .S ^TMP("SROCC",$J,$P(^SRF(SRTN,16,SRPO,0),"^",2),SRDATE)=SRSEP
|
---|
93 | I '$D(^TMP("SROCC",$J)) D OCCEND Q
|
---|
94 | S SRPO=0 F S SRPO=$O(^TMP("SROCC",$J,SRPO)) Q:'SRPO S SRDATE="" F S SRDATE=$O(^TMP("SROCC",$J,SRPO,SRDATE)) Q:SRDATE S SRX("POSTOP OCCURRENCE DATE"_SRPO)="Date Noted on "_$P(^SRO(136.5,SRPO,0),"^")_" (Postop Occurrence)" Q
|
---|
95 | S SRDATE="",SRDATE=$O(^TMP("SROCC",$J,3,SRDATE)) Q:SRDATE="" I ^TMP("SROCC",$J,3,SRDATE)="" S SRX("SEPSIS CATEGORY")="SEPSIS CATEGORY on SYSTEMIC SEPSIS (Postop Occurrence)"
|
---|
96 | OCCEND K ^TMP("SROCC",$J)
|
---|
97 | Q
|
---|
98 | PREOP S DR="236;237;346;202;202.1;246;325;238;240;492;204;203;326;212;213;396;394;220;266;395;208;329;330;328;211;332;333;398;399;400;334;335;336;401;338;218;339;215;216;217;338.1;338.2;218.1;269"
|
---|
99 | Q
|
---|
100 | DEM S DR="413;.011;247;418;419;420;421;452;453;454;342"
|
---|
101 | Q
|
---|
102 | LAB S DR="270;304;224;291;223;290;225;292;228;295;227;294;229;296;230;297;234;301;231;298;233;300;232;299;487;487.1;274;305;405;407;275;306;406;408;277;308;278;309;279;310;280;311;281;312;283;314;455;455.1;456;456.1;444;444.1;445;445.1"
|
---|
103 | Q
|
---|
104 | REM S DR="214;.035;1.09;1.13;.22;.23;340;443;446;504;504.1"
|
---|
105 | Q
|
---|
106 | PREHD D PREOP S DR=DR_";402;241;244;242;243;210;245"
|
---|
107 | Q
|
---|