Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROAUTL.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROAUTL.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROAUTL.m
r613 r623 1 SROAUTL ;BIR/ADM - RISK ASSESSMENT UTILITY ;03/03/082 ;;3.0; Surgery ;**38,46,47,63,81,88,95,112,100,125,134,142,153,160,166**;24 Jun 93;Build 73 4 5 6 7 8 9 10 11 12 13 NCODE 14 15 16 17 18 19 20 21 22 LOOP 23 24 25 26 HDR 27 28 29 30 31 32 33 FUNCT() 34 35 36 37 CARD() 38 39 40 41 NC 42 43 44 DATE ; called by output transform on several date fields45 46 47 48 INDX 49 50 51 52 OP 53 54 55 MS 56 57 58 K901 59 60 61 DUP 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 STUFF 77 78 79 80 81 CHK 82 83 84 85 OTH 86 87 OCC 88 89 90 91 92 93 94 95 96 OCCEND 97 98 PREOP 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 100 DEM S DR="413;.011;247;418;419;420;421;452;453;454;342;513;516"101 102 LAB 103 104 REM 105 106 PREHD 107 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
Note:
See TracChangeset
for help on using the changeset viewer.
