| [613] | 1 | SROPCEX ;BIR/ADM - CROSS REFERENCE LOGIC ;01/11/06
|
|---|
| 2 | ;;3.0; Surgery ;**58,62,69,86,119,142**;24 Jun 93
|
|---|
| 3 | Q
|
|---|
| 4 | APCE ; send case data to PCE
|
|---|
| 5 | N SRCASE,SRDIV,SRCLINIC,SRPDATE,SRQ,SRSITE,SRSR,SRWC,SRX,SRZ S SRQ=0 S:$D(SRTN) SRCASE=SRTN I '$D(SRCASE) S SRCASE=$S($G(DA(1)):DA(1),1:DA)
|
|---|
| 6 | Q:($P($G(^SRF(SRCASE,30)),"^"))!($P($G(^SRF(SRCASE,37)),"^"))
|
|---|
| 7 | S SRSR="",SRDIV=$P($G(^SRF(SRCASE,8)),"^") I SRDIV D Q:SRQ
|
|---|
| 8 | .S SRSITE=$O(^SRO(133,"B",SRDIV,0)),SRWC=$P(^SRO(133,SRSITE,0),"^",15),SRSR=$P(^SRO(133,SRSITE,0),"^",19)
|
|---|
| 9 | .S SRPDATE=$P(^SRO(133,SRSITE,0),"^",17) I SRPDATE,$P(^SRF(SRCASE,0),"^",9)<SRPDATE S SRQ=1 Q
|
|---|
| 10 | .I $P(^SRO(133,SRSITE,0),"^",16),'$P(^SRF(SRCASE,0),"^",20) S SRQ=1 Q
|
|---|
| 11 | .Q:SRWC="A" I "N"[SRWC S SRQ=1 Q
|
|---|
| 12 | S SRCLINIC=$P(^SRF(SRCASE,0),"^",21)
|
|---|
| 13 | S SRX=$G(^SRF(SRCASE,"NON")) I $P(SRX,"^")="Y" Q:'$P(SRX,"^",4)!'$P(SRX,"^",5)!'$P(SRX,"^",6)!((SRSR'=0)&('$P(SRX,"^",7))) S:SRCLINIC="" SRCLINIC=$P(SRX,"^",2) Q:SRCLINIC="" Q:'$$CLINIC^SROUTL(SRCLINIC,SRCASE) G SET
|
|---|
| 14 | I $P(^SRF(SRCASE,0),"^",4),SRCLINIC="" S SRCLINIC=$P(^SRO(137.45,$P(^SRF(SRCASE,0),"^",4),0),"^",5)
|
|---|
| 15 | I SRCLINIC="",$P(^SRF(SRCASE,0),"^",2) S SRCLINIC=$P(^SRS($P(^SRF(SRCASE,0),"^",2),0),"^")
|
|---|
| 16 | Q:SRCLINIC="" I '$$CLINIC^SROUTL(SRCLINIC,SRCASE) Q
|
|---|
| 17 | S SRX=$G(^SRF(SRCASE,.2)) Q:'$P(SRX,"^",10)!'$P(SRX,"^",12)
|
|---|
| 18 | S SRX=$G(^SRF(SRCASE,.1)) Q:'$P(SRX,"^",4) I SRSR'=0,'$P(SRX,"^",13) Q
|
|---|
| 19 | Q:SRQ
|
|---|
| 20 | SET S SRZ=$P($G(^SRO(136,SRCASE,10)),"^") I SRZ S SRTN=SRCASE D START^SROPCEP
|
|---|
| 21 | Q
|
|---|
