source: WorldVistAEHR/trunk/r/SURGERY-SR/SROANR1.m@ 1608

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1SROANR1 ;BIR/ADM - ANESTHESIA REPORT ; [ 09/09/03 12:45 PM ]
2 ;;3.0; Surgery ;**100**;24 Jun 93
3 ;
4 ;** NOTICE: This routine is part of an implementation of a nationally
5 ;** controlled procedure. Local modifications to this routine
6 ;** are prohibited.
7 ;
8 N C,SRLINE,SRT,X,Y
9 S X=$P(SR(.3),"^",7) I X'="" D LINE(2) S @SRG@(SRI)="Min Intraoperative Temp: "_X
10 I $O(^SRF(SRTN,27,0)) D LINE(2) S @SRG@(SRI)="Monitors:" D MON
11 I $O(^SRF(SRTN,4,0)) D LINE(2) S @SRG@(SRI)="Blood Replacement Fluids:" D REP
12 D LINE(2) S Y=$P(SR(.2),"^",5) S:Y'="" Y=Y_" ml" S @SRG@(SRI)="Intraoperative Blood Loss: "_Y
13 S Y=$P(SR(.2),"^",16) S:Y'="" Y=Y_" ml" S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Urine Output: "_Y
14 D LINE(1) S @SRG@(SRI)="PAC(U) Admit Score: "_$P(SR(1.1),"^"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"PAC(U) Discharge Score: "_$P(SR(1.1),"^",2)
15 I $O(^SRF(SRTN,5,0)) D LINE(2) S @SRG@(SRI)="General Comments:" S SRLINE=0 D
16 .F S SRLINE=$O(^SRF(SRTN,5,SRLINE)) Q:'SRLINE S X=^SRF(SRTN,5,SRLINE,0) D COMM(X,2)
17NOTE S Y=$P(SR(1.1),"^",9) D:Y D^DIQ S SRT=$S(Y'="":$P(Y,"@")_" "_$P(Y,"@",2),1:"") D LINE(2) S @SRG@(SRI)="Postop Anesthesia Note Date/Time: "_SRT
18 I $O(^SRF(SRTN,48,0)) D LINE(1) S @SRG@(SRI)="Postop Anesthesia Note:" S SRLINE=0 D
19 .F S SRLINE=$O(^SRF(SRTN,48,SRLINE)) Q:'SRLINE S X=^SRF(SRTN,48,SRLINE,0) D COMM(X,2)
20 Q
21N(SRL) N SRN I $L(Y)>SRL S SRN=$P(Y,",")_","_$E($P(Y,",",2))_".",Y=SRN
22 Q
23MON ; monitors
24 N C,MON,SRM,SRT,Y
25 S MON=0 F S MON=$O(^SRF(SRTN,27,MON)) Q:'MON S SRM=^SRF(SRTN,27,MON,0) D
26 .S Y=$P(SRM,"^"),C=$P(^DD(130.41,.01,0),"^",2) D:Y'="" Y^DIQ D LINE(1) S @SRG@(SRI)=" "_Y
27 .S Y=$P(SRM,"^",4),C=$P(^DD(130.41,3,0),"^",2) D:Y'="" Y^DIQ,N(27) S:Y="" Y="N/A" S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Applied By: "_Y
28 .S Y=$P(SRM,"^",2) D:Y D^DIQ S SRT=$S(Y'="":$P(Y,"@")_" "_$P(Y,"@",2),1:"N/A") D LINE(1) S @SRG@(SRI)=" Installed: "_SRT
29 .S Y=$P(SRM,"^",3) D:Y D^DIQ S SRT=$S(Y'="":$P(Y,"@")_" "_$P(Y,"@",2),1:"N/A") S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Removed: "_SRT
30 Q
31REP ; blood replacement fluids
32 N C,REP,SRLINE,SRX,X,Y
33 S REP=0 F S REP=$O(^SRF(SRTN,4,REP)) Q:'REP S SRX=^SRF(SRTN,4,REP,0) D
34 .S Y=$P(SRX,"^"),C=$P(^DD(130.04,.01,0),"^",2) D:Y'="" Y^DIQ D LINE(1) S @SRG@(SRI)=" "_Y
35 .S Y=$P(SRX,"^",2),Y=$S(Y="":"N/A",1:Y_" ml"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(40)_"Quantity: "_Y
36 .S Y=$P(SRX,"^",4),Y=$S(Y="":"N/A",1:Y) D LINE(1) S @SRG@(SRI)=" Source ID: "_Y
37 .S Y=$P(SRX,"^",5),Y=$S(Y="":"N/A",1:Y) D LINE(1) S @SRG@(SRI)=" VA ID: "_Y
38 Q
39COMM(X,NUM) ; output word-processing text
40 ; X = line of text to be processed
41 ; NUM = left margin
42 N I,J,K,Y,SRL S SRL=80-NUM
43 I $L(X)<(SRL+1)!($E(X,1,SRL)'[" ") D LINE(1) S @SRG@(SRI)=$$SPACE(NUM)_X Q
44 S K=1 F D I $L(X)<SRL+1 S X(K)=X Q
45 .F I=0:1:SRL-1 S J=SRL-I,Y=$E(X,J) I Y=" " S X(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
46 F I=1:1:K D LINE(1) S @SRG@(SRI)=$$SPACE(NUM)_X(I)
47 Q
48SPACE(NUM) ;create spaces
49 ;pass in position returns number of needed spaces
50 I '$D(@SRG@(SRI)) S @SRG@(SRI)=""
51 Q $J("",NUM-$L(@SRG@(SRI)))
52LINE(NUM) ;create carriage returns
53 F J=1:1:NUM S SRI=SRI+1,@SRG@(SRI)=""
54 Q
Note: See TracBrowser for help on using the repository browser.