source: WorldVistAEHR/trunk/r/SURGERY-SR/SRSCRAP.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1SRSCRAP ;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
3BEG 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
9OR 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)
11CPTNOTE ; 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
14END D ^SRSKILL K SRTN
15 Q
16MORE 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
18RETURNS ; 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
26CHK ; 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
32DEL ; 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
Note: See TracBrowser for help on using the repository browser.