source: FOIAVistA/trunk/r/SURGERY-SR/SROAUTL.m@ 810

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1SROAUTL ;BIR/ADM - RISK ASSESSMENT UTILITY ;03/03/08
2 ;;3.0; Surgery ;**38,46,47,63,81,88,95,112,100,125,134,142,153,160,166**;24 Jun 93;Build 6
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
13NCODE 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
22LOOP 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
26HDR ; 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
33FUNCT() ; 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
37CARD() ; 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
41NC ; called from input transform to kill X if case is cardiac assessed
42 I $$CARD,X="NA"!(X="NS") K X
43 Q
44DATE ; called by output transform on several date fields
45 I $D(Y),Y="NA"!(Y="NS") Q
46 N SRY S SRY=Y D DD^%DT
47 Q
48INDX ; 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
52OP ; 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
55MS ; 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
58K901 ; kill logic for AOP and AMS cross references
59 S $P(^SRF(DA,.3),"^",9)=""
60 Q
61DUP ; 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
76STUFF ; 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
81CHK ; 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
85OTH K DA,DIC,DIQ,DR,SRY,SRZ D TECH^SROPRIN I SRTECH="NOT ENTERED" S SRX("ANESTHESIA TECHNIQUE")="Anesthesia Technique"
86 ;D RELATE^SROAUTL2
87OCC 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)"
96OCCEND K ^TMP("SROCC",$J)
97 Q
98PREOP S DR="236;237;346;202;246;325;238;492;204;203;326;212;213;396;394;220;266;395;208;329;330;328;211;332;333;400;334;335;336;401;338;218;339;215;216;217;338.1;338.2;218.1;269"
99 Q
100DEM S DR="413;.011;247;418;419;420;421;452;453;454;342;513;516"
101 Q
102LAB 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
104REM S DR="214;.035;1.09;1.13;.22;.23;340;443;446;504;504.1"
105 Q
106PREHD D PREOP S DR=DR_";402;241;244;242;243;210;245"
107 Q
Note: See TracBrowser for help on using the repository browser.