SRSCRAP ;B'HAM ISC/MAM - GARBAGE REQUEST COLLECTOR; [ 09/22/98  11:53 AM ]
 ;;3.0; Surgery ;**16,20,67,50,107**;24 Jun 93
BEG S SRSDT=0,X="T-14" D ^%DT S ENDATE=Y
 F  S SRSDT=$O(^SRF("AR",SRSDT)) Q:SRSDT>ENDATE!('SRSDT)  S SRDFN=0 F  S SRDFN=$O(^SRF("AR",SRSDT,SRDFN)) Q:'SRDFN  D MORE
 S X="T-61" D ^%DT S SRSDT=Y
 F  S SRSDT=$O(^SRF("AC",SRSDT)) Q:'SRSDT  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN  D
 .I '$D(^SRF(SRTN,0)) K ^SRF("AC",SRSDT,SRTN) Q
 .I $O(^SRF(SRTN,29,0)) S RET=0,SRDPT(0)=$P(^SRF(SRTN,0),"^") F  S RET=$O(^SRF(SRTN,29,RET)) Q:'RET  D RETURNS
OR S X="T-14" D ^%DT S ENDATE=Y,SROR=0
 F  S SROR=$O(^SRS(SROR)) Q:'SROR  S SRSDT=0 F  S SRSDT=$O(^SRS(SROR,"S",SRSDT)) Q:SRSDT>ENDATE!('SRSDT)  K ^SRS(SROR,"S",SRSDT),^SRS(SROR,"SS",SRSDT)
CPTNOTE ; cleanup CPT COPYRIGHT NOTICE DATE multiple in file 133
 N SRDIV,SRDT S SRDIV=0 F  S SRDIV=$O(^SRO(133,SRDIV)) Q:'SRDIV  S SRDT=0 F  S SRDT=$O(^SRO(133,SRDIV,6,SRDT)) Q:'SRDT  I SRDT'=DT K DA,DIE,DR S DIE="^SRO(133,SRDIV,6,",DA=SRDT,DA(1)=SRDIV,DR=".01///@" D ^DIE
 S SRDIV=$O(^SRO(133,0)) I '$D(^SRO(133,SRDIV,6,DT,0)) K DD,DO S X=DT,DA(1)=SRDIV,DIC="^SRO(133,SRDIV,6,",DIC("P")=$P(^DD(133,36,0),"^",2),DIC(0)="L",DINUM=X D FILE^DICN
END D ^SRSKILL K SRTN
 Q
MORE S SRTN=0 F I=0:0 S SRTN=$O(^SRF("AR",SRSDT,SRDFN,SRTN)) Q:'SRTN  S START=0 D CHK Q:START  D DEL
 Q
RETURNS ; check returns
 S SROK=1,SRET1=$P(^SRF(SRTN,29,RET,0),"^") I '$D(^SRF(SRET1)) S SROK=0
 I $D(^SRF(SRET1)),$P(^SRF(SRET1,0),"^")'=SRDPT(0) S SROK=0
 I $P($G(^SRF(SRET1,"NON")),"^")="Y" S SROK=0
 S CAN=$P($G(^SRF(SRET1,30)),"^") S:CAN SROK=0 S CAN=$P($G(^SRF(SRET1,31)),"^",8) I CAN'="" S SROK=0
 S SRDT=$P($G(^SRF(SRET1,0)),"^",9),X1=SRSDT,X2=30 D C^%DTC I SRDT'<X S SROK=0
 I 'SROK S DA(1)=SRTN,DA=RET,DIK="^SRF("_SRTN_",29," D ^DIK
 Q
CHK ; check start time
 I '$D(^SRF(SRTN,0)) K ^SRF("AR",SRSDT,SRDFN,SRTN) S START=1 Q
 S SRSITE=$$SITE^SROUTL0(SRTN)
 S SR(.2)=$G(^SRF(SRTN,.2))
 I $P(SR(.2),"^",2)'=""!($P(SR(.2),"^",12)'="") S START=1 K DR,DIE,DA S DA=SRTN,DIE=130,DR="36///0;Q;.09///"_$P(^SRF(SRTN,0),"^",9) D ^DIE K DR,DA,DIE S SROERR=SRTN D ^SROERR0
 Q
DEL ; delete case
 S SRSITE=$$SITE^SROUTL0(SRTN)
 S SRKILL=0 I $P($G(^SRF(SRTN,31)),"^",8)'=""!($P($G(^SRF(SRTN,30)),"^")'="") K DIE,DR,DA S DA=SRTN,DIE=130,DR="36///0;Q;.09///"_SRSDT D ^DIE K DR,DIE,DA S SRKILL=1 S SROERR=SRTN D ^SROERR0
 Q:SRKILL  D DEL^SROERR
 S DA=SRTN,DIK="^SRF(" D ^DIK
 Q