source: WorldVistAEHR/trunk/r/SURGERY-SR/SROAL2.m@ 700

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1SROAL2 ;BIR/ADM - LOAD POSTOPERATIVE LAB DATA ;02/14/07
2 ;;3.0; Surgery ;**18,38,47,54,65,71,88,100,125,153,160**;24 Jun 93;Build 7
3 ;
4 ; Reference to ^LR( supported by DBIA #194
5 ;
6 Q:'$D(SRTN) N SRBLUD K SRAD,SRAT S SRSOUT=0
7 W !!,"This selection loads highest or lowest lab data for tests performed within",!,"30 days after the operation."
8YEP W !!,"Do you want to automatically load postoperative lab data ? YES// " R SRYN:DTIME G:'$T!(SRYN["^") END
9 S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter <RET> to automatically load postoperative lab data from the patient's lab record, or 'NO' to return to the menu." G YEP
10 I "Yy"'[SRYN W !!,"Lab data NOT loaded." G END
11START S SRALR=$S($D(^DPT($P(^SRF(SRTN,0),"^"),"LR")):$P(^("LR"),"^"),1:"")
12 S SRAOP=$P($G(^SRF(SRTN,.2)),"^",3) I 'SRAOP W !!,"'Time the Operation Ends' must be entered before continuing." D TMCHK G:SRSOUT END
13 S SREND=9999999-SRAOP,X1=SRAOP,X2=30 D C^%DTC S SRST=9999999-X
14SRAT ; Get test from file 139.2.
15 W !!,"..Searching lab record for postoperative lab test data...."
16 K DIC S DIC=61,DIC(0)="",X="SERUM" D ^DIC S SRSER=+Y K DIC S DIC=61,DIC(0)="",X="PLASMA" D ^DIC K DIC S SRP=+Y
17 K DIC S DIC=61,DIC(0)="",X="BLOOD" D ^DIC S SRBLUD=+Y
18 S SRFLG="H" F SRAT=2,3,4,5,7,9,10,14,16,26 S SRASP=$P(^SRO(139.2,SRAT,2),"^") D SRADN,NS
19 S SRFLG="L" F SRAT=4,5,17 S SRASP=$P(^SRO(139.2,SRAT,2),"^") D SRADN,NS
20 I $$LOCK^SROUTL(SRTN) D ^SROAL21,UNLOCK^SROUTL(SRTN)
21END I 'SRSOUT W !!,"Press <RET> to continue " R X:DTIME
22 W @IOF
23 Q
24SRADN ; Get data name(s) for test, make call to check lab record.
25 F SRADN=0:0 S SRADN=$O(^SRO(139.2,SRAT,1,SRADN)) Q:SRADN'>0 S SRATN=$P(^(SRADN,0),"^") D LABCHK
26 Q
27LABCHK ; Get test values from patient's lab record.
28 S SRX="" I SRALR F SRAIDT=SRST:0 S SRAIDT=$O(^LR(SRALR,"CH",SRAIDT)) Q:SRAIDT'>0!(SRAIDT>SREND) I $D(^(SRAIDT,SRATN)) S SRSP=$P(^(0),"^",5) D Q:(SRFLG="H"&(SRX[">"))!(SRFLG="L"&(SRX["<")) I SRX="*" D STAR
29 .I (SRAT>1&(SRAT<16))!(SRAT=26)!(SRAT>20&(SRAT<25)),SRSP=SRSER!(SRSP=SRP)!(SRSP=SRBLUD) D COMP Q
30 .I SRSP=SRASP D COMP Q
31 Q
32COMP S SRAVAL=$P(^LR(SRALR,"CH",SRAIDT,SRATN),"^") I $P(^LR(SRALR,"CH",SRAIDT,0),"^",3)'="","canccommentpending"'[SRAVAL,SRAVAL'["CANC" D DATA
33 I $D(SRAT(SRFLG,SRAT)),SRAT(SRFLG,SRAT)["." D
34 .I SRAT(SRFLG,SRAT)=+SRAT(SRFLG,SRAT) S SRAT(SRFLG,SRAT)=SRAT(SRFLG,SRAT)+.005\.01*.01 Q
35 .S SR1=$E(SRAT(SRFLG,SRAT)),SR2=$E(SRAT(SRFLG,SRAT),2,99),SR2=SR2+.005\.01*.01,SRAT(SRFLG,SRAT)=SR1_SR2
36 Q
37NS ; check for no sample
38 I '$D(SRAT(SRFLG,SRAT)) S SRAT(SRFLG,SRAT)="NS",SRAD(SRFLG,SRAT)=""
39 Q
40STAR ; questional result, require manual input
41 S (SRAT(SRFLG,SRAT),SRAD(SRFLG,SRAT))=""
42 Q
43DATA ; Decide to save test result or not
44 N SRSWAP,SRVAL S SRSWAP=0
45 S (SRT,SRX)=SRAVAL I +SRAVAL'=SRAVAL D CONV Q:SRX="*" S (SRT,SRAVAL)=SRZ_SRX
46 I $D(SRAT(SRFLG,SRAT)) S SRT1=SRAT(SRFLG,SRAT) D I SRSWAP S SRAT(SRFLG,SRAT)=SRAVAL,SRAD(SRFLG,SRAT)=$E($P(^LR(SRALR,"CH",SRAIDT,0),"^"),1,7) Q
47 .I SRFLG="H" Q:SRT1[">" D
48 ..I SRT[">" S SRSWAP=1 Q
49 ..S SRVAL=SRX,SRX=SRT1 D CONV I SRVAL>SRX S SRSWAP=1 Q
50 .I SRFLG="L" Q:SRT1["<" D
51 ..I SRT["<" S SRSWAP=1 Q
52 ..S SRVAL=SRX,SRX=SRT1 D CONV I SRVAL<SRX S SRSWAP=1 Q
53 I '$D(SRAT(SRFLG,SRAT)) S SRAT(SRFLG,SRAT)=SRAVAL,SRAD(SRFLG,SRAT)=$E($P(^LR(SRALR,"CH",SRAIDT,0),"^"),1,7)
54 Q
55TMCHK W !!,"Do you want to enter the time that the operation was completed at ",!,"this time ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
56 S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' to input 'Time the Operation Ends' or ",!,"'NO' to return to the menu." G TMCHK
57 I "Yy"'[SRYN S SRSOUT=1 Q
58 I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN)
59 .W ! K DR S DR=".23T",DA=SRTN,DIE=130 D ^DIE K DR S SRAOP=$P($G(^SRF(SRTN,.2)),"^",3) I 'SRAOP S SRSOUT=1
60 Q
61CONV ; convert value to numeric for comparison
62 N SRELSE,X1,X2 S SRZ="" I " <>"[$E(SRX) S SRZ=$E(SRX),SRX=$E(SRX,2,99)
63 I SRX?.N0.1".".N D Q
64 .I SRX'["." S SRX=+SRX Q
65 .S X1=$P(SRX,"."),X1=+X1 S:X1=0 X1=""
66 .S X2="."_$P(SRX,".",2),X2=+X2 S:X2=0 X2=""
67 .S SRX=X1_X2,SRX=+SRX
68 S SRX="*"
69 Q
Note: See TracBrowser for help on using the repository browser.