Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROAUTL3.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/SURGERY-SR/SROAUTL3.m (modified) (1 diff)

WorldVistAEHR/trunk/r/SURGERY-SR/SROAUTL3.m

@@ -1 @@
-SROAUTL3        ;BIR/ADM - RISK ASSESSMENT UTILITY ;01/07/08
-        ;;3.0; Surgery ;**38,47,63,77,142,163,166**;24 Jun 93;Build 7
-        ;
-        ; Reference to ^DIC(45.3 supported by DBIA #218
-        ;
-        Q
-RISK    ; allow entry of risk assessment preop information with case request
-        S Y=$P(^SRO(133,SRSITE,0),"^",14) I 'Y Q
-        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
-        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
-        .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
-        .I 'Y S SRCARD=0 Q
-        .D CARD S SRCARD=1
-        I 'SRCARD D ^SROAPRE
-        Q
-CARD    ; allow input of cardiac risk assessment preop information
-        N SRSDATE,SRNM,SRSOUT
-        W @IOF,!,"Enter Cardiac Preoperative information",!!,"  1. Clinical Information",!,"  2. Cardiac Catheterization & Angiographic Data",!,"  3. Operative Risk Summary Data",!
-        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
-        I Y=1 D ^SROACLN G CARD
-        I Y=2 D ^SROACAT G CARD
-        D ^SROACOP G CARD
-        Q
-PREOP   ; print preop information (managerial)
-        W:$E(IOST)="P" !! D PREOP^SROAUTL0 S SRDR=DR W !,?28,"PREOPERATIVE INFORMATION",! S SRQ=1 D OUT
-        Q
-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
-        K SRX S SRX=0 F M=1:1 S I=$P(SRDR,";",M) Q:'I  D
-        .Q:I=413  D TR D:SRQ GET^SROAUTL1 D:'SRQ GET^SROAUTL2
-        .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
-        .W !,$J($P(Z,"^")_": ",39) S SREXT=SRY(130,SRTN,SRFLD,"E") D EXT
-        Q
-EXT     I SRFLD=27 S SREXT=$S(SREXT="":"MISSING",1:$E(SREXT,1,5))
-        I $L(SREXT)<40 W SREXT Q
-        N I,J,X,Y S X=SREXT F  D  W:$L(X) ! I $L(X)<40!(X'[" ") W ?40,X Q
-        .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
-        Q
-LAB     ; print preoperative laboratory test information (managerial)
-        W !,?20,"PREOPERATIVE LABORATORY TEST INFORMATION",!
-        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
-        K SRX S SRX=0 F M=1:2 S L=$P(SRDR,";",M) Q:'L  S I=L D
-        .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
-        .W !,$J($P(Z,"^")_": ",39),SRY(130,SRTN,SRFLD,"E") W:SRY(130,SRTN,SRDT,"E")'="" ?50,"("_$P(SRY(130,SRTN,SRDT,"E"),"@")_")"
-        Q
-TR      S J=I,J=$TR(J,"1234567890.","ABCDEFGHIJP")
-        Q
-NON     S DR=".03;102;.035"
-        Q
-CHK     ; check for missing information for excluded cases
-        K SRX,DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I" D NON D EN^DIQ1 D ^SROAUTL2
-        K DA,DIC,DIQ,DR,SRY,SRZ D TECH^SROPRIN I SRTECH="NOT ENTERED" S SRX("ANESTHESIA TECHNIQUE")="Anesthesia Technique"
-        Q
+SROAUTL3 ;BIR/ADM - RISK ASSESSMENT UTILITY ;08/16/07
+ ;;3.0; Surgery ;**38,47,63,77,142,163**;24 Jun 93;Build 2
+ ;
+ ; Reference to ^DIC(45.3 supported by DBIA #218
+ ;
+ Q
+RISK ; allow entry of risk assessment preop information with case request
+ S Y=$P(^SRO(133,SRSITE,0),"^",14) I 'Y Q
+ 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
+ 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
+ .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
+ .I 'Y S SRCARD=0 Q
+ .D CARD S SRCARD=1
+ I 'SRCARD D ^SROAPRE
+ Q
+CARD ; allow input of cardiac risk assessment preop information
+ W @IOF,!,"Enter Cardiac Preoperative information",!!,"  1. Clinical Information",!,"  2. Cardiac Catheterization & Angiographic Data",!,"  3. Operative Risk Summary Data",!
+ 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
+ I Y=1 D ^SROACLN G CARD
+ I Y=2 D ^SROACAT G CARD
+ D ^SROACOP G CARD
+ Q
+PREOP ; print preop information (managerial)
+ W:$E(IOST)="P" !! D PREOP^SROAUTL0 S SRDR=DR W !,?28,"PREOPERATIVE INFORMATION",! S SRQ=1 D OUT
+ Q
+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
+ K SRX S SRX=0 F M=1:1 S I=$P(SRDR,";",M) Q:'I  D
+ .Q:I=413  D TR D:SRQ GET^SROAUTL1 D:'SRQ GET^SROAUTL2
+ .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
+ .W !,$J($P(Z,"^")_": ",39) S SREXT=SRY(130,SRTN,SRFLD,"E") D EXT
+ Q
+EXT I SRFLD=27 S SREXT=$S(SREXT="":"MISSING",1:$E(SREXT,1,5))
+ I $L(SREXT)<40 W SREXT Q
+ N I,J,X,Y S X=SREXT F  D  W:$L(X) ! I $L(X)<40!(X'[" ") W ?40,X Q
+ .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
+ Q
+LAB ; print preoperative laboratory test information (managerial)
+ W !,?20,"PREOPERATIVE LABORATORY TEST INFORMATION",!
+ 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
+ K SRX S SRX=0 F M=1:2 S L=$P(SRDR,";",M) Q:'L  S I=L D
+ .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
+ .W !,$J($P(Z,"^")_": ",39),SRY(130,SRTN,SRFLD,"E") W:SRY(130,SRTN,SRDT,"E")'="" ?50,"("_$P(SRY(130,SRTN,SRDT,"E"),"@")_")"
+ Q
+TR S J=I,J=$TR(J,"1234567890.","ABCDEFGHIJP")
+ Q
+NON S DR=".03;102;.035"
+ Q
+CHK ; check for missing information for excluded cases
+ K SRX,DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I" D NON D EN^DIQ1 D ^SROAUTL2
+ K DA,DIC,DIQ,DR,SRY,SRZ D TECH^SROPRIN I SRTECH="NOT ENTERED" S SRX("ANESTHESIA TECHNIQUE")="Anesthesia Technique"
+ Q