- 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 Jan 18, 2025@03:48:36 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