Routine: SRORAT2

SRORAT2 ;B'HAM ISC/MAM - CANCELLATION RATES, ALL ; [ 04/06/00  10:19 AM ]

 ;;3.0; Surgery ;**14,63,94**;24 Jun 93

 S (PAGE,SRSOUT,SRHDR)=0 K ^TMP("SR",$J),^TMP("SRT",$J)

 S SRSDATE=SRSD-.0001,SREDT=SRED+.9999,^TMP("SR",$J)="0^0^0"

 F  S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>SREDT)  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN  I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTIL

 D ^SRORATP

UTIL ; set ^TMP

 Q:$P($G(^SRF(SRTN,"NON")),"^")="Y"  S STORE=0,TYPE=$P(^SRF(SRTN,0),"^",10) Q:TYPE="EM"

 I $P($G(^SRF(SRTN,30)),"^")=""&($P($G(^(31)),"^",4)="")&($P($G(^(31)),"^",5)="") Q

 I $P($G(^SRF(SRTN,30)),"^") S STORE=2

 I $P($G(^SRF(SRTN,31)),"^",8) S STORE=2

 I $P($G(^SRF(SRTN,.2)),"^",12) S STORE=1,AVOID=""

 I 'STORE Q

 I STORE=2 S AVOID=0,X=$S($D(^SRF(SRTN,31)):$P(^(31),"^",8),1:""),REASON=$S(X:$P(^SRO(135,X,0),"^")_"^"_$P($G(^SRF(SRTN,30)),"^",2),1:"ZZNO REASON ENTERED"_"^"_"A") S AVOID=$S($P(REASON,"^",2)="N":0,1:1),REASON=$P(REASON,"^")

 S SRSS=$P(^SRF(SRTN,0),"^",4),SRSS=$S('SRSS:"ZZ",1:$P(^SRO(137.45,SRSS,0),"^"))

 I '$D(^TMP("SRT",$J,SRSS)) S ^TMP("SRT",$J,SRSS)="0^0^0"

 I STORE=2,'$D(^TMP("SRT",$J,SRSS,REASON)) S ^TMP("SRT",$J,SRSS,REASON)="0^0"

 I STORE=2,'$D(^TMP("SR",$J,REASON)) S ^TMP("SR",$J,REASON)="0^0"

 I STORE=1 S $P(^TMP("SR",$J),"^",3)=$P(^TMP("SR",$J),"^",3)+1,$P(^TMP("SRT",$J,SRSS),"^",3)=$P(^TMP("SRT",$J,SRSS),"^",3)+1 Q

 S $P(^TMP("SR",$J),"^")=$P(^TMP("SR",$J),"^")+1 I STORE=2 S $P(^TMP("SR",$J,REASON),"^")=$P(^TMP("SR",$J,REASON),"^")+1

 S $P(^TMP("SRT",$J,SRSS),"^")=$P(^TMP("SRT",$J,SRSS),"^")+1 I STORE=2 S $P(^TMP("SRT",$J,SRSS,REASON),"^")=$P(^TMP("SRT",$J,SRSS,REASON),"^")+1

 I 'AVOID Q

 S $P(^TMP("SR",$J),"^",2)=$P(^TMP("SR",$J),"^",2)+1,$P(^TMP("SR",$J,REASON),"^",2)=$P(^TMP("SR",$J,REASON),"^",2)+1

 S $P(^TMP("SRT",$J,SRSS),"^",2)=$P(^TMP("SRT",$J,SRSS),"^",2)+1,$P(^TMP("SRT",$J,SRSS,REASON),"^",2)=$P(^TMP("SRT",$J,SRSS,REASON),"^",2)+1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRORAT2   1956     printed  Mar 13, 2025@21:50:48                                                                                                                                                                                                     Page 2

SRORAT2   ;B'HAM ISC/MAM - CANCELLATION RATES, ALL ; [ 04/06/00  10:19 AM ]

 +1       ;;3.0; Surgery ;**14,63,94**;24 Jun 93

 +2        SET (PAGE,SRSOUT,SRHDR)=0

           KILL ^TMP("SR",$JOB),^TMP("SRT",$JOB)

 +3        SET SRSDATE=SRSD-.0001

           SET SREDT=SRED+.9999

           SET ^TMP("SR",$JOB)="0^0^0"

 +4        FOR

               SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))

               if 'SRSDATE!(SRSDATE>SREDT)

                   QUIT

               SET SRTN=0

FOR

                   SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))

                   if 'SRTN

                       QUIT

                   IF $DATA(^SRF(SRTN,0))

                       IF $$MANDIV^SROUTL0(SRINSTP,SRTN)

                           DO UTIL

 +5        DO ^SRORATP

 +6        QUIT

UTIL      ; set ^TMP

 +1        if $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"

               QUIT

           SET STORE=0

           SET TYPE=$PIECE(^SRF(SRTN,0),"^",10)

           if TYPE="EM"

               QUIT

 +2        IF $PIECE($GET(^SRF(SRTN,30)),"^")=""&($PIECE($GET(^(31)),"^",4)="")&($PIECE($GET(^(31)),"^",5)="")

               QUIT

 +3        IF $PIECE($GET(^SRF(SRTN,30)),"^")

               SET STORE=2

 +4        IF $PIECE($GET(^SRF(SRTN,31)),"^",8)

               SET STORE=2

 +5        IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)

               SET STORE=1

               SET AVOID=""

 +6        IF 'STORE

               QUIT

 +7        IF STORE=2

               SET AVOID=0

               SET X=$SELECT($DATA(^SRF(SRTN,31)):$PIECE(^(31),"^",8),1:"")

               SET REASON=$SELECT(X:$PIECE(^SRO(135,X,0),"^")_"^"_$PIECE($GET(^SRF(SRTN,30)),"^",2),1:"ZZNO REASON ENTERED"_"^"_"A")

               SET AVOID=$SELECT($PIECE(REASON,"^",2)="N":0,1:1)

               SET REASON=$PIECE(REASON,"^")

 +8        SET SRSS=$PIECE(^SRF(SRTN,0),"^",4)

           SET SRSS=$SELECT('SRSS:"ZZ",1:$PIECE(^SRO(137.45,SRSS,0),"^"))

 +9        IF '$DATA(^TMP("SRT",$JOB,SRSS))

               SET ^TMP("SRT",$JOB,SRSS)="0^0^0"

 +10       IF STORE=2

               IF '$DATA(^TMP("SRT",$JOB,SRSS,REASON))

                   SET ^TMP("SRT",$JOB,SRSS,REASON)="0^0"

 +11       IF STORE=2

               IF '$DATA(^TMP("SR",$JOB,REASON))

                   SET ^TMP("SR",$JOB,REASON)="0^0"

 +12       IF STORE=1

               SET $PIECE(^TMP("SR",$JOB),"^",3)=$PIECE(^TMP("SR",$JOB),"^",3)+1

               SET $PIECE(^TMP("SRT",$JOB,SRSS),"^",3)=$PIECE(^TMP("SRT",$JOB,SRSS),"^",3)+1

               QUIT

 +13       SET $PIECE(^TMP("SR",$JOB),"^")=$PIECE(^TMP("SR",$JOB),"^")+1

           IF STORE=2

               SET $PIECE(^TMP("SR",$JOB,REASON),"^")=$PIECE(^TMP("SR",$JOB,REASON),"^")+1

 +14       SET $PIECE(^TMP("SRT",$JOB,SRSS),"^")=$PIECE(^TMP("SRT",$JOB,SRSS),"^")+1

           IF STORE=2

               SET $PIECE(^TMP("SRT",$JOB,SRSS,REASON),"^")=$PIECE(^TMP("SRT",$JOB,SRSS,REASON),"^")+1

 +15       IF 'AVOID

               QUIT

 +16       SET $PIECE(^TMP("SR",$JOB),"^",2)=$PIECE(^TMP("SR",$JOB),"^",2)+1

           SET $PIECE(^TMP("SR",$JOB,REASON),"^",2)=$PIECE(^TMP("SR",$JOB,REASON),"^",2)+1

 +17       SET $PIECE(^TMP("SRT",$JOB,SRSS),"^",2)=$PIECE(^TMP("SRT",$JOB,SRSS),"^",2)+1

           SET $PIECE(^TMP("SRT",$JOB,SRSS,REASON),"^",2)=$PIECE(^TMP("SRT",$JOB,SRSS,REASON),"^",2)+1

 +18       QUIT

SRORAT2.m