source: WorldVistAEHR/trunk/r/SURGERY-SR/SRONP2.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1SRONP2 ;BIR/ADM - PROCEDURE REPORT (NON-OR) ;07/26/04 9:45 AM
2 ;;3.0; Surgery ;**132,142**;24 Jun 93
3 Q
4OPTOP(SRTN) ; send op-top to ^TMP
5 ; SRTN - case number in file 130
6 ;
7 N ANE,DFN,ICD,J,NUM,SR,SRATT,SRCASE,SRDIV,SRI,SRL,SRLINE,SRLOC,SRN,SROPTOP,SRSPEC,SRSTATUS,SRTECH,X,Y
8 S SRCASE=SRTN,SRG=$NA(^TMP("SRNOR",$J,SRCASE)) K @SRG
9 S SRI=0,SRDIV=$$SITE^SROUTL0(SRTN)
10 I $P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8) D LINE(1) S @SRG@(SRI)=" * * PROCEDURE ABORTED * *" D LINE(1)
11 F SRN=0:.1:1.1,"NON" S SR(SRN)=$G(^SRF(SRTN,SRN))
12 S Y=$P(SR("NON"),"^",8),C=$P(^DD(130,125,0),"^",2) D:Y'="" Y^DIQ S SRSPEC=$S(Y="":"NOT ENTERED",1:$E(Y,1,25))
13 S SRLOC="NOT ENTERED",SRL=$P(SR("NON"),"^",2) S:SRL SRLOC=$E($P(^SC(SRL,0),"^"),1,25)
14 D LINE(1) S @SRG@(SRI)="Med. Specialty: "_SRSPEC,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(44)_"Location: "_SRLOC
15 S X=$P($G(^SRF(SRTN,33)),"^",2) D LINE(2) S @SRG@(SRI)="Principal Diagnosis: " D
16 .I X="" S @SRG@(SRI)=@SRG@(SRI)_"NOT ENTERED" Q
17 .D LINE(1) S @SRG@(SRI)=" "_X
18 .S @SRG@(SRI)=@SRG@(SRI)
19 .N OTH,CNT S (OTH,CNT)=0 F S OTH=$O(^SRF(SRTN,15,OTH)) Q:'OTH S CNT=CNT+1 D DIAG
20 S Y=$P(SR("NON"),"^",6),C=$P(^DD(130,123,0),"^",2) D:Y'="" Y^DIQ D LINE(2) S @SRG@(SRI)="Provider: "_Y
21 S X=$P($G(SR(0)),"^",12),SRSTATUS=$S(X="I":"INPATIENT",X="O":"OUTPATIENT",1:"NOT ENTERED")
22 S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(50)_"Patient Status: "_SRSTATUS
23 S Y=$P(SR("NON"),"^",7),C=$P(^DD(130,124,0),"^",2) D:Y'="" Y^DIQ,N(28) S:Y="" Y="N/A" D LINE(1) S @SRG@(SRI)="Attending: "_Y
24 D RS S:SRATT="" SRATT="NOT ENTERED" D LINE(1) S @SRG@(SRI)="Attending Code: "_SRATT
25 S Y=$P(SR(.3),"^",4),C=$P(^DD(130,.34,0),"^",2) D:Y'="" Y^DIQ S:Y="" Y="N/A" D LINE(2) S @SRG@(SRI)="Attend Anesth: "_Y
26 S X=$P(SR(.3),"^",6),X=$S(X:$P(^SRO(132.95,X,0),"^"),1:"N/A")
27 D LINE(1) S @SRG@(SRI)="Anesthesia Supervisor Code: "_X
28 S Y=$P(SR(.3),"^"),C=$P(^DD(130,.31,0),"^",2) D:Y'="" Y^DIQ S:Y="" Y="N/A" D LINE(1) S @SRG@(SRI)="Anesthetist: "_Y
29 D LINE(2) S @SRG@(SRI)="Anesthesia Technique(s): " D
30 .I '$O(^SRF(SRTN,6,0)) S @SRG@(SRI)=@SRG@(SRI)_"N/A" Q
31 .S ANE=0 F S ANE=$O(^SRF(SRTN,6,ANE)) Q:'ANE D ANE
32 D TECH I $E(SRTECH,1,2)'="NO" S X=$P($G(^SRF(SRTN,31)),"^",9),X=$S(X="N":"NO",X="Y":"YES",1:"") I X'="" D LINE(2) S @SRG@(SRI)="Diagnostic/Therapeutic: "_X
33 D ^SRONP0
34 Q
35DIAG D LINE(1) S X=$G(^SRF(SRTN,15,OTH,0)),@SRG@(SRI)=$S(CNT=1:" Other: ",1:" ")_$P(X,"^"),ICD=$P(X,"^",3)
36 S ICD=$S(ICD:$P(^ICD9(ICD,0),"^"),1:"NOT ENTERED"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(50)_"ICD9 Code: "_ICD
37 Q
38N(SRL) N SRNM I $L(Y)>SRL S SRNM=$P(Y,",")_","_$E($P(Y,",",2))_".",Y=SRNM
39 Q
40TECH N SRT,SRZ D TECH^SROPRIN
41 Q
42ANE ; print anesthesia technique
43 N A,AGNT,C,CNT
44 S A=^SRF(SRTN,6,ANE,0),Y=$P(A,"^"),C=$P(^DD(130.06,.01,0),"^",2) D:Y'="" Y^DIQ D LINE(1) S Y=Y_$S($P(A,"^",3)="Y":" (PRINCIPAL)",1:""),@SRG@(SRI)=$$SPACE(2)_Y D AGENT
45 Q
46AGENT ; print agents
47 Q:$P(A,"^")="N" N SRDOSE,SRY
48 D LINE(1) S @SRG@(SRI)=" Agent: " I '$O(^SRF(SRTN,6,ANE,1,0)) S @SRG@(SRI)=@SRG@(SRI)_"NONE ENTERED" Q
49 S (AGNT,CNT)=0 F S AGNT=$O(^SRF(SRTN,6,ANE,1,AGNT)) Q:'AGNT S CNT=CNT+1 D
50 .S SRY=^SRF(SRTN,6,ANE,1,AGNT,0),SRDOSE=$P(SRY,"^",2)
51 .S Y=$P(SRY,"^"),C=$P(^DD(130.47,.01,0),"^",2) D Y^DIQ
52 .D:CNT>1 LINE(1) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(13)_Y
53 .I SRDOSE S @SRG@(SRI)=@SRG@(SRI)_" "_SRDOSE_" mg"
54 Q
55RS ; attending code
56 I $$GET1^DID(130,.166,"","LABEL")["ATTENDING CODE" D Q
57 .S Y=$P(SR(.1),"^",10),C=$P(^DD(130,.166,0),"^",2) D Y^DIQ S SRATT=Y
58 S Y=$P(SR(.1),"^",16),C=$P(^DD(130,.165,0),"^",2) D Y^DIQ S SRATT=Y
59 Q
60COMM(X,NUM) ; output word-processing text
61 ; X = line of text to be processed
62 ; NUM = left margin
63 N I,J,K,Y,SRL S SRL=80-NUM
64 I $L(X)<(SRL+1)!($E(X,1,SRL)'[" ") D LINE(1) S @SRG@(SRI)=$$SPACE(NUM)_X Q
65 S K=1 F D I $L(X)<SRL+1 S X(K)=X Q
66 .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
67 F I=1:1:K D LINE(1) S @SRG@(SRI)=$$SPACE(NUM)_X(I)
68 Q
69SPACE(NUM) ; create spaces
70 ; pass in position returns number of needed spaces
71 I '$D(@SRG@(SRI)) S @SRG@(SRI)=""
72 Q $J("",NUM-$L(@SRG@(SRI)))
73LINE(NUM) ; create carriage returns
74 F J=1:1:NUM S SRI=SRI+1,@SRG@(SRI)=""
75 Q
Note: See TracBrowser for help on using the repository browser.