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
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRORAT2 1956 printed Nov 22, 2024@17:55:35 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
