Routine: SROATT2

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

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROATT2   1947     printed  Mar 13, 2025@21:47:29                                                                                                                                                                                                     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

SROATT2.m