source: WorldVistAEHR/trunk/r/SURGERY-SR/SROATT2.m@ 623

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1SROATT2 ;B'HAM ISC/MAM - ATTENDING SURGEON REPORT (ALL SPECIALTIES) ; [ 05/11/04 2:33 PM ]
2 ;;3.0; Surgery ;**50,129**;24 Jun 93
3 K ^TMP("SR",$J)
4 S SRSS=0 F S SRSS=$O(^SRO(137.45,SRSS)) Q:'SRSS S SRSSN=$P(^SRO(137.45,SRSS,0),"^") D UT
5 S (^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED"),^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED","ZZ"))=0
6 S (SRFLG,SRSOUT)=0,SRSDATE=SRSD-.0001,SREDT=SRED+.9999
7 F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>SREDT)!(SRSOUT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN!(SRSOUT) I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D UTIL
8 I SRBOTH'=2 D ^SROAT2P
9 Q:SRSOUT I SRBOTH'=1 D RET Q:SRSOUT D ^SROAT2T S SRSOUT=1
10 Q
11UTIL ; set ^TMP
12 I '$D(^SRF(SRTN,.2)) Q
13 I '$P(^SRF(SRTN,.2),"^",12) Q
14 S SRSS=$P(^SRF(SRTN,0),"^",4) S SRSS=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"ZZ SPECIALTY NOT ENTERED")
15 S SR(.1)=$S($D(^SRF(SRTN,.1)):^(.1),1:""),SRATT=$P(SR(.1),"^",13),SRATT=$S(SRATT:$P(^VA(200,SRATT,0),"^"),1:"ZZ ATTENDING NOT ENTERED")
16 S SRCODE=$P(SR(.1),"^",10) S:SRCODE="" SRCODE="ZZ"
17 S ^TMP("SR",$J,SRSS,SRATT,SRCODE,SRSDATE,SRTN)=""
18 I '$D(^TMP("SRTOT",$J,SRSS,SRCODE)) S ^TMP("SRTOT",$J,SRSS,SRCODE)=0
19 I '$D(^TMP("SRTC",$J,SRCODE)) S ^TMP("SRTC",$J,SRCODE)=0
20 I '$D(^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED",SRCODE)) S ^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED",SRCODE)=0
21 S ^TMP("SRTOT",$J)=^TMP("SRTOT",$J)+1
22 S ^TMP("SRTOT",$J,SRSS)=^TMP("SRTOT",$J,SRSS)+1
23 S ^TMP("SRTOT",$J,SRSS,SRCODE)=^TMP("SRTOT",$J,SRSS,SRCODE)+1
24 S ^TMP("SRTC",$J,SRCODE)=^TMP("SRTC",$J,SRCODE)+1
25 Q
26UT ; initialize ^TMP
27 S ^TMP("SRTOT",$J,SRSSN,"ZZ")=0,^TMP("SRTC",$J,"ZZ")=0
28 S (^TMP("SRTOT",$J),^TMP("SRTOT",$J,SRSSN),SRCODE)=0
29 ;F SRCD=0:1:3 S (^TMP("SRTOT",$J,SRSSN,SRCD),^TMP("SRTC",$J,SRCD),^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED",SRCD))=0
30 Q
31RET I $E(IOST)="P"!('SRFLG) S SRFLG=1 Q
32 W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
33 Q
Note: See TracBrowser for help on using the repository browser.