source: WorldVistAEHR/trunk/r/SURGERY-SR/SROATT1.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1SROATT1 ;B'HAM ISC/MAM - ATTENDING SURGEON REPORT (1 SPECIALTY) ; [ 05/11/04 2:33 PM ]
2 ;;3.0; Surgery ;**50,129**;24 Jun 93
3 K ^TMP("SR",$J),^TMP("SRTOT",$J)
4 S ^TMP("SRTOT",$J)=0,SRSOUT=0,SRSDATE=SRSD-.0001,SREDT=SRED+.9999
5 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
6 I SRBOTH'=2 D ^SROAT1P
7 Q:SRSOUT I SRBOTH'=1 D:SRBOTH'=2 RET Q:SRSOUT D ^SROAT1T
8 Q
9UTIL ; set ^TMP
10 I '$D(^SRF(SRTN,.2)) Q
11 I '$P(^SRF(SRTN,.2),"^",12) Q
12 S X=$P(^SRF(SRTN,0),"^",4) I X'=SRSS Q
13 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")
14 S SRCODE=$P(SR(.1),"^",10) S:SRCODE="" SRCODE="ZZ"
15 I '$D(^TMP("SRTOT",$J,SRCODE)) S ^TMP("SRTOT",$J,SRCODE)=0
16 S ^TMP("SR",$J,SRATT,SRCODE,SRSDATE,SRTN)=""
17 S ^TMP("SRTOT",$J)=^TMP("SRTOT",$J)+1,^TMP("SRTOT",$J,SRCODE)=^TMP("SRTOT",$J,SRCODE)+1
18 Q
19RET I $E(IOST)="P" Q
20 W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
21 I X["?" W !!,"Enter RETURN to continue with this report, or '^' to quit this option." G RET
22 Q
Note: See TracBrowser for help on using the repository browser.