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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCRAP 2438 printed Dec 13, 2024@02:47:26 Page 2
SRSCRAP ;B'HAM ISC/MAM - GARBAGE REQUEST COLLECTOR; [ 09/22/98 11:53 AM ]
+1 ;;3.0; Surgery ;**16,20,67,50,107**;24 Jun 93
BEG SET SRSDT=0
SET X="T-14"
DO ^%DT
SET ENDATE=Y
+1 FOR
SET SRSDT=$ORDER(^SRF("AR",SRSDT))
if SRSDT>ENDATE!('SRSDT)
QUIT
SET SRDFN=0
FOR
SET SRDFN=$ORDER(^SRF("AR",SRSDT,SRDFN))
if 'SRDFN
QUIT
DO MORE
+2 SET X="T-61"
DO ^%DT
SET SRSDT=Y
+3 FOR
SET SRSDT=$ORDER(^SRF("AC",SRSDT))
if 'SRSDT
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDT,SRTN))
if 'SRTN
QUIT
Begin DoDot:1
+4 IF '$DATA(^SRF(SRTN,0))
KILL ^SRF("AC",SRSDT,SRTN)
QUIT
+5 IF $ORDER(^SRF(SRTN,29,0))
SET RET=0
SET SRDPT(0)=$PIECE(^SRF(SRTN,0),"^")
FOR
SET RET=$ORDER(^SRF(SRTN,29,RET))
if 'RET
QUIT
DO RETURNS
End DoDot:1
OR SET X="T-14"
DO ^%DT
SET ENDATE=Y
SET SROR=0
+1 FOR
SET SROR=$ORDER(^SRS(SROR))
if 'SROR
QUIT
SET SRSDT=0
FOR
SET SRSDT=$ORDER(^SRS(SROR,"S",SRSDT))
if SRSDT>ENDATE!('SRSDT)
QUIT
KILL ^SRS(SROR,"S",SRSDT),^SRS(SROR,"SS",SRSDT)
CPTNOTE ; cleanup CPT COPYRIGHT NOTICE DATE multiple in file 133
+1 NEW SRDIV,SRDT
SET SRDIV=0
FOR
SET SRDIV=$ORDER(^SRO(133,SRDIV))
if 'SRDIV
QUIT
SET SRDT=0
FOR
SET SRDT=$ORDER(^SRO(133,SRDIV,6,SRDT))
if 'SRDT
QUIT
IF SRDT'=DT
KILL DA,DIE,DR
SET DIE="^SRO(133,SRDIV,6,"
SET DA=SRDT
SET DA(1)=SRDIV
SET DR=".01///@"
DO ^DIE
+2 SET SRDIV=$ORDER(^SRO(133,0))
IF '$DATA(^SRO(133,SRDIV,6,DT,0))
KILL DD,DO
SET X=DT
SET DA(1)=SRDIV
SET DIC="^SRO(133,SRDIV,6,"
SET DIC("P")=$PIECE(^DD(133,36,0),"^",2)
SET DIC(0)="L"
SET DINUM=X
DO FILE^DICN
END DO ^SRSKILL
KILL SRTN
+1 QUIT
MORE SET SRTN=0
FOR I=0:0
SET SRTN=$ORDER(^SRF("AR",SRSDT,SRDFN,SRTN))
if 'SRTN
QUIT
SET START=0
DO CHK
if START
QUIT
DO DEL
+1 QUIT
RETURNS ; check returns
+1 SET SROK=1
SET SRET1=$PIECE(^SRF(SRTN,29,RET,0),"^")
IF '$DATA(^SRF(SRET1))
SET SROK=0
+2 IF $DATA(^SRF(SRET1))
IF $PIECE(^SRF(SRET1,0),"^")'=SRDPT(0)
SET SROK=0
+3 IF $PIECE($GET(^SRF(SRET1,"NON")),"^")="Y"
SET SROK=0
+4 SET CAN=$PIECE($GET(^SRF(SRET1,30)),"^")
if CAN
SET SROK=0
SET CAN=$PIECE($GET(^SRF(SRET1,31)),"^",8)
IF CAN'=""
SET SROK=0
+5 SET SRDT=$PIECE($GET(^SRF(SRET1,0)),"^",9)
SET X1=SRSDT
SET X2=30
DO C^%DTC
IF SRDT'<X
SET SROK=0
+6 IF 'SROK
SET DA(1)=SRTN
SET DA=RET
SET DIK="^SRF("_SRTN_",29,"
DO ^DIK
+7 QUIT
CHK ; check start time
+1 IF '$DATA(^SRF(SRTN,0))
KILL ^SRF("AR",SRSDT,SRDFN,SRTN)
SET START=1
QUIT
+2 SET SRSITE=$$SITE^SROUTL0(SRTN)
+3 SET SR(.2)=$GET(^SRF(SRTN,.2))
+4 IF $PIECE(SR(.2),"^",2)'=""!($PIECE(SR(.2),"^",12)'="")
SET START=1
KILL DR,DIE,DA
SET DA=SRTN
SET DIE=130
SET DR="36///0;Q;.09///"_$PIECE(^SRF(SRTN,0),"^",9)
DO ^DIE
KILL DR,DA,DIE
SET SROERR=SRTN
DO ^SROERR0
+5 QUIT
DEL ; delete case
+1 SET SRSITE=$$SITE^SROUTL0(SRTN)
+2 SET SRKILL=0
IF $PIECE($GET(^SRF(SRTN,31)),"^",8)'=""!($PIECE($GET(^SRF(SRTN,30)),"^")'="")
KILL DIE,DR,DA
SET DA=SRTN
SET DIE=130
SET DR="36///0;Q;.09///"_SRSDT
DO ^DIE
KILL DR,DIE,DA
SET SRKILL=1
SET SROERR=SRTN
DO ^SROERR0
+3 if SRKILL
QUIT
DO DEL^SROERR
+4 SET DA=SRTN
SET DIK="^SRF("
DO ^DIK
+5 QUIT
