| 1 | SRSCRAP ;B'HAM ISC/MAM - GARBAGE REQUEST COLLECTOR; [ 09/22/98 11:53 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**16,20,67,50,107**;24 Jun 93
|
|---|
| 3 | BEG S SRSDT=0,X="T-14" D ^%DT S ENDATE=Y
|
|---|
| 4 | 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
|
|---|
| 5 | S X="T-61" D ^%DT S SRSDT=Y
|
|---|
| 6 | F S SRSDT=$O(^SRF("AC",SRSDT)) Q:'SRSDT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN D
|
|---|
| 7 | .I '$D(^SRF(SRTN,0)) K ^SRF("AC",SRSDT,SRTN) Q
|
|---|
| 8 | .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
|
|---|
| 9 | OR S X="T-14" D ^%DT S ENDATE=Y,SROR=0
|
|---|
| 10 | 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)
|
|---|
| 11 | CPTNOTE ; cleanup CPT COPYRIGHT NOTICE DATE multiple in file 133
|
|---|
| 12 | 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
|
|---|
| 13 | 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
|
|---|
| 14 | END D ^SRSKILL K SRTN
|
|---|
| 15 | Q
|
|---|
| 16 | 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
|
|---|
| 17 | Q
|
|---|
| 18 | RETURNS ; check returns
|
|---|
| 19 | S SROK=1,SRET1=$P(^SRF(SRTN,29,RET,0),"^") I '$D(^SRF(SRET1)) S SROK=0
|
|---|
| 20 | I $D(^SRF(SRET1)),$P(^SRF(SRET1,0),"^")'=SRDPT(0) S SROK=0
|
|---|
| 21 | I $P($G(^SRF(SRET1,"NON")),"^")="Y" S SROK=0
|
|---|
| 22 | S CAN=$P($G(^SRF(SRET1,30)),"^") S:CAN SROK=0 S CAN=$P($G(^SRF(SRET1,31)),"^",8) I CAN'="" S SROK=0
|
|---|
| 23 | S SRDT=$P($G(^SRF(SRET1,0)),"^",9),X1=SRSDT,X2=30 D C^%DTC I SRDT'<X S SROK=0
|
|---|
| 24 | I 'SROK S DA(1)=SRTN,DA=RET,DIK="^SRF("_SRTN_",29," D ^DIK
|
|---|
| 25 | Q
|
|---|
| 26 | CHK ; check start time
|
|---|
| 27 | I '$D(^SRF(SRTN,0)) K ^SRF("AR",SRSDT,SRDFN,SRTN) S START=1 Q
|
|---|
| 28 | S SRSITE=$$SITE^SROUTL0(SRTN)
|
|---|
| 29 | S SR(.2)=$G(^SRF(SRTN,.2))
|
|---|
| 30 | 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
|
|---|
| 31 | Q
|
|---|
| 32 | DEL ; delete case
|
|---|
| 33 | S SRSITE=$$SITE^SROUTL0(SRTN)
|
|---|
| 34 | 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
|
|---|
| 35 | Q:SRKILL D DEL^SROERR
|
|---|
| 36 | S DA=SRTN,DIK="^SRF(" D ^DIK
|
|---|
| 37 | Q
|
|---|
