SROATT2 ;B'HAM ISC/MAM - ATTENDING SURGEON REPORT (ALL SPECIALTIES) ; [ 05/11/04 2:33 PM ]
;;3.0; Surgery ;**50,129**;24 Jun 93
K ^TMP("SR",$J)
S SRSS=0 F S SRSS=$O(^SRO(137.45,SRSS)) Q:'SRSS S SRSSN=$P(^SRO(137.45,SRSS,0),"^") D UT
S (^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED"),^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED","ZZ"))=0
S (SRFLG,SRSOUT)=0,SRSDATE=SRSD-.0001,SREDT=SRED+.9999
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
I SRBOTH'=2 D ^SROAT2P
Q:SRSOUT I SRBOTH'=1 D RET Q:SRSOUT D ^SROAT2T S SRSOUT=1
Q
UTIL ; set ^TMP
I '$D(^SRF(SRTN,.2)) Q
I '$P(^SRF(SRTN,.2),"^",12) Q
S SRSS=$P(^SRF(SRTN,0),"^",4) S SRSS=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"ZZ SPECIALTY NOT ENTERED")
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")
S SRCODE=$P(SR(.1),"^",10) S:SRCODE="" SRCODE="ZZ"
S ^TMP("SR",$J,SRSS,SRATT,SRCODE,SRSDATE,SRTN)=""
I '$D(^TMP("SRTOT",$J,SRSS,SRCODE)) S ^TMP("SRTOT",$J,SRSS,SRCODE)=0
I '$D(^TMP("SRTC",$J,SRCODE)) S ^TMP("SRTC",$J,SRCODE)=0
I '$D(^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED",SRCODE)) S ^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED",SRCODE)=0
S ^TMP("SRTOT",$J)=^TMP("SRTOT",$J)+1
S ^TMP("SRTOT",$J,SRSS)=^TMP("SRTOT",$J,SRSS)+1
S ^TMP("SRTOT",$J,SRSS,SRCODE)=^TMP("SRTOT",$J,SRSS,SRCODE)+1
S ^TMP("SRTC",$J,SRCODE)=^TMP("SRTC",$J,SRCODE)+1
Q
UT ; initialize ^TMP
S ^TMP("SRTOT",$J,SRSSN,"ZZ")=0,^TMP("SRTC",$J,"ZZ")=0
S (^TMP("SRTOT",$J),^TMP("SRTOT",$J,SRSSN),SRCODE)=0
;F SRCD=0:1:3 S (^TMP("SRTOT",$J,SRSSN,SRCD),^TMP("SRTC",$J,SRCD),^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED",SRCD))=0
Q
RET I $E(IOST)="P"!('SRFLG) S SRFLG=1 Q
W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROATT2 1947 printed Nov 22, 2024@17:52:16 Page 2
SROATT2 ;B'HAM ISC/MAM - ATTENDING SURGEON REPORT (ALL SPECIALTIES) ; [ 05/11/04 2:33 PM ]
+1 ;;3.0; Surgery ;**50,129**;24 Jun 93
+2 KILL ^TMP("SR",$JOB)
+3 SET SRSS=0
FOR
SET SRSS=$ORDER(^SRO(137.45,SRSS))
if 'SRSS
QUIT
SET SRSSN=$PIECE(^SRO(137.45,SRSS,0),"^")
DO UT
+4 SET (^TMP("SRTOT",$JOB,"ZZ SPECIALTY NOT ENTERED"),^TMP("SRTOT",$JOB,"ZZ SPECIALTY NOT ENTERED","ZZ"))=0
+5 SET (SRFLG,SRSOUT)=0
SET SRSDATE=SRSD-.0001
SET SREDT=SRED+.9999
+6 FOR
SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
if 'SRSDATE!(SRSDATE>SREDT)!(SRSOUT)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
if 'SRTN!(SRSOUT)
QUIT
IF $DATA(^SRF(SRTN,0))
IF $$DIV^SROUTL0(SRTN)
DO UTIL
+7 IF SRBOTH'=2
DO ^SROAT2P
+8 if SRSOUT
QUIT
IF SRBOTH'=1
DO RET
if SRSOUT
QUIT
DO ^SROAT2T
SET SRSOUT=1
+9 QUIT
UTIL ; set ^TMP
+1 IF '$DATA(^SRF(SRTN,.2))
QUIT
+2 IF '$PIECE(^SRF(SRTN,.2),"^",12)
QUIT
+3 SET SRSS=$PIECE(^SRF(SRTN,0),"^",4)
SET SRSS=$SELECT(SRSS:$PIECE(^SRO(137.45,SRSS,0),"^"),1:"ZZ SPECIALTY NOT ENTERED")
+4 SET SR(.1)=$SELECT($DATA(^SRF(SRTN,.1)):^(.1),1:"")
SET SRATT=$PIECE(SR(.1),"^",13)
SET SRATT=$SELECT(SRATT:$PIECE(^VA(200,SRATT,0),"^"),1:"ZZ ATTENDING NOT ENTERED")
+5 SET SRCODE=$PIECE(SR(.1),"^",10)
if SRCODE=""
SET SRCODE="ZZ"
+6 SET ^TMP("SR",$JOB,SRSS,SRATT,SRCODE,SRSDATE,SRTN)=""
+7 IF '$DATA(^TMP("SRTOT",$JOB,SRSS,SRCODE))
SET ^TMP("SRTOT",$JOB,SRSS,SRCODE)=0
+8 IF '$DATA(^TMP("SRTC",$JOB,SRCODE))
SET ^TMP("SRTC",$JOB,SRCODE)=0
+9 IF '$DATA(^TMP("SRTOT",$JOB,"ZZ SPECIALTY NOT ENTERED",SRCODE))
SET ^TMP("SRTOT",$JOB,"ZZ SPECIALTY NOT ENTERED",SRCODE)=0
+10 SET ^TMP("SRTOT",$JOB)=^TMP("SRTOT",$JOB)+1
+11 SET ^TMP("SRTOT",$JOB,SRSS)=^TMP("SRTOT",$JOB,SRSS)+1
+12 SET ^TMP("SRTOT",$JOB,SRSS,SRCODE)=^TMP("SRTOT",$JOB,SRSS,SRCODE)+1
+13 SET ^TMP("SRTC",$JOB,SRCODE)=^TMP("SRTC",$JOB,SRCODE)+1
+14 QUIT
UT ; initialize ^TMP
+1 SET ^TMP("SRTOT",$JOB,SRSSN,"ZZ")=0
SET ^TMP("SRTC",$JOB,"ZZ")=0
+2 SET (^TMP("SRTOT",$JOB),^TMP("SRTOT",$JOB,SRSSN),SRCODE)=0
+3 ;F SRCD=0:1:3 S (^TMP("SRTOT",$J,SRSSN,SRCD),^TMP("SRTC",$J,SRCD),^TMP("SRTOT",$J,"ZZ SPECIALTY NOT ENTERED",SRCD))=0
+4 QUIT
RET IF $EXTRACT(IOST)="P"!('SRFLG)
SET SRFLG=1
QUIT
+1 WRITE !!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+2 QUIT
