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