38 lines
2.3 KiB
Mathematica
38 lines
2.3 KiB
Mathematica
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
|