| [623] | 1 | SROAUTL3 ;BIR/ADM - RISK ASSESSMENT UTILITY ;08/16/07
|
|---|
| 2 | ;;3.0; Surgery ;**38,47,63,77,142,163**;24 Jun 93;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^DIC(45.3 supported by DBIA #218
|
|---|
| 5 | ;
|
|---|
| 6 | Q
|
|---|
| 7 | RISK ; allow entry of risk assessment preop information with case request
|
|---|
| 8 | S Y=$P(^SRO(133,SRSITE,0),"^",14) I 'Y Q
|
|---|
| 9 | W ! K DIR S DIR("A")="Enter risk assessment preop information for this patient (Y/N)",DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y Q
|
|---|
| 10 | S SREQST=1,SRCARD=0 I $$CARD^SROAUTLC S SRSP=$P(^DIC(45.3,$P(^SRO(137.45,$P(^SRF(SRTN,0),"^",4),0),"^",2),0),"^") I SRSP=48!(SRSP=58) D I SRCARD Q
|
|---|
| 11 | .S SRCARD=1 W ! K DIR S DIR("A")="Will this procedure require cardiopulmonary bypass (Y/N) ? ",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q
|
|---|
| 12 | .I 'Y S SRCARD=0 Q
|
|---|
| 13 | .D CARD S SRCARD=1
|
|---|
| 14 | I 'SRCARD D ^SROAPRE
|
|---|
| 15 | Q
|
|---|
| 16 | CARD ; allow input of cardiac risk assessment preop information
|
|---|
| 17 | W @IOF,!,"Enter Cardiac Preoperative information",!!," 1. Clinical Information",!," 2. Cardiac Catheterization & Angiographic Data",!," 3. Operative Risk Summary Data",!
|
|---|
| 18 | K DIR S DIR(0)="NO^1:3:0",DIR("?")="Enter the number of the selection to be edited." D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y Q
|
|---|
| 19 | I Y=1 D ^SROACLN G CARD
|
|---|
| 20 | I Y=2 D ^SROACAT G CARD
|
|---|
| 21 | D ^SROACOP G CARD
|
|---|
| 22 | Q
|
|---|
| 23 | PREOP ; print preop information (managerial)
|
|---|
| 24 | W:$E(IOST)="P" !! D PREOP^SROAUTL0 S SRDR=DR W !,?28,"PREOPERATIVE INFORMATION",! S SRQ=1 D OUT
|
|---|
| 25 | Q
|
|---|
| 26 | OUT K DA,DIC,DIQ,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="E",DR=SRDR D EN^DIQ1 K DA,DIC,DIQ,DR
|
|---|
| 27 | K SRX S SRX=0 F M=1:1 S I=$P(SRDR,";",M) Q:'I D
|
|---|
| 28 | .Q:I=413 D TR D:SRQ GET^SROAUTL1 D:'SRQ GET^SROAUTL2
|
|---|
| 29 | .S SRX=SRX+1,Y=$P(X,";;",2),SRFLD=$P(Y,"^"),(Z,SRX(SRX))=$S($P(Y,"^",3)'="":$P(Y,"^",3),1:$P(Y,"^",2))_"^"_SRFLD
|
|---|
| 30 | .W !,$J($P(Z,"^")_": ",39) S SREXT=SRY(130,SRTN,SRFLD,"E") D EXT
|
|---|
| 31 | Q
|
|---|
| 32 | EXT I SRFLD=27 S SREXT=$S(SREXT="":"MISSING",1:$E(SREXT,1,5))
|
|---|
| 33 | I $L(SREXT)<40 W SREXT Q
|
|---|
| 34 | N I,J,X,Y S X=SREXT F D W:$L(X) ! I $L(X)<40!(X'[" ") W ?40,X Q
|
|---|
| 35 | .F I=0:1:38 S J=39-I,Y=$E(X,J) I Y=" " W ?40,$E(X,1,J-1) S X=$E(X,J+1,$L(X)) Q
|
|---|
| 36 | Q
|
|---|
| 37 | LAB ; print preoperative laboratory test information (managerial)
|
|---|
| 38 | W !,?20,"PREOPERATIVE LABORATORY TEST INFORMATION",!
|
|---|
| 39 | D LR^SROAUTL0 S SRDR=DR K DA,DIC,DIQ,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="E",DR=SRDR D EN^DIQ1 K DA,DIC,DIQ,DR
|
|---|
| 40 | K SRX S SRX=0 F M=1:2 S L=$P(SRDR,";",M) Q:'L S I=L D
|
|---|
| 41 | .D TR D GET^SROAUTL2 S SRX=SRX+1,Y=$P(X,";;",2),SRFLD=$P(Y,"^"),SRDT=$P(Y,"^",4),(Z,SRX(SRX))=$S($P(Y,"^",3)'="":$P(Y,"^",3),1:$P(Y,"^",2))_"^"_SRFLD_"^"_SRDT
|
|---|
| 42 | .W !,$J($P(Z,"^")_": ",39),SRY(130,SRTN,SRFLD,"E") W:SRY(130,SRTN,SRDT,"E")'="" ?50,"("_$P(SRY(130,SRTN,SRDT,"E"),"@")_")"
|
|---|
| 43 | Q
|
|---|
| 44 | TR S J=I,J=$TR(J,"1234567890.","ABCDEFGHIJP")
|
|---|
| 45 | Q
|
|---|
| 46 | NON S DR=".03;102;.035"
|
|---|
| 47 | Q
|
|---|
| 48 | CHK ; check for missing information for excluded cases
|
|---|
| 49 | K SRX,DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I" D NON D EN^DIQ1 D ^SROAUTL2
|
|---|
| 50 | K DA,DIC,DIQ,DR,SRY,SRZ D TECH^SROPRIN I SRTECH="NOT ENTERED" S SRX("ANESTHESIA TECHNIQUE")="Anesthesia Technique"
|
|---|
| 51 | Q
|
|---|
