- SROPCEX ;BIR/ADM - CROSS REFERENCE LOGIC ; JAN 11,2006
- ;;3.0;Surgery;**58,62,69,86,119,142,204**;24 Jun 93;Build 3
- 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
- .N DE,DQ,DG,DIFLD ; SR*3.0*204; these are FM variables from the calling routine that must survive the call below:
- .D START^SROPCEP
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPCEX 1590 printed Mar 13, 2025@21:50:10 Page 2
- SROPCEX ;BIR/ADM - CROSS REFERENCE LOGIC ; JAN 11,2006
- +1 ;;3.0;Surgery;**58,62,69,86,119,142,204**;24 Jun 93;Build 3
- +2 QUIT
- APCE ; send case data to PCE
- +1 NEW SRCASE,SRDIV,SRCLINIC,SRPDATE,SRQ,SRSITE,SRSR,SRWC,SRX,SRZ
- SET SRQ=0
- if $DATA(SRTN)
- SET SRCASE=SRTN
- IF '$DATA(SRCASE)
- SET SRCASE=$SELECT($GET(DA(1)):DA(1),1:DA)
- +2 if ($PIECE($GET(^SRF(SRCASE,30)),"^"))!($PIECE($GET(^SRF(SRCASE,37)),"^"))
- QUIT
- +3 SET SRSR=""
- SET SRDIV=$PIECE($GET(^SRF(SRCASE,8)),"^")
- IF SRDIV
- Begin DoDot:1
- +4 SET SRSITE=$ORDER(^SRO(133,"B",SRDIV,0))
- SET SRWC=$PIECE(^SRO(133,SRSITE,0),"^",15)
- SET SRSR=$PIECE(^SRO(133,SRSITE,0),"^",19)
- +5 SET SRPDATE=$PIECE(^SRO(133,SRSITE,0),"^",17)
- IF SRPDATE
- IF $PIECE(^SRF(SRCASE,0),"^",9)<SRPDATE
- SET SRQ=1
- QUIT
- +6 IF $PIECE(^SRO(133,SRSITE,0),"^",16)
- IF '$PIECE(^SRF(SRCASE,0),"^",20)
- SET SRQ=1
- QUIT
- +7 if SRWC="A"
- QUIT
- IF "N"[SRWC
- SET SRQ=1
- QUIT
- End DoDot:1
- if SRQ
- QUIT
- +8 SET SRCLINIC=$PIECE(^SRF(SRCASE,0),"^",21)
- +9 SET SRX=$GET(^SRF(SRCASE,"NON"))
- IF $PIECE(SRX,"^")="Y"
- if '$PIECE(SRX,"^",4)!'$PIECE(SRX,"^",5)!'$PIECE(SRX,"^",6)!((SRSR'=0)&('$PIECE(SRX,"^",7)))
- QUIT
- if SRCLINIC=""
- SET SRCLINIC=$PIECE(SRX,"^",2)
- if SRCLINIC=""
- QUIT
- if '$$CLINIC^SROUTL(SRCLINIC,SRCASE)
- QUIT
- GOTO SET
- +10 IF $PIECE(^SRF(SRCASE,0),"^",4)
- IF SRCLINIC=""
- SET SRCLINIC=$PIECE(^SRO(137.45,$PIECE(^SRF(SRCASE,0),"^",4),0),"^",5)
- +11 IF SRCLINIC=""
- IF $PIECE(^SRF(SRCASE,0),"^",2)
- SET SRCLINIC=$PIECE(^SRS($PIECE(^SRF(SRCASE,0),"^",2),0),"^")
- +12 if SRCLINIC=""
- QUIT
- IF '$$CLINIC^SROUTL(SRCLINIC,SRCASE)
- QUIT
- +13 SET SRX=$GET(^SRF(SRCASE,.2))
- if '$PIECE(SRX,"^",10)!'$PIECE(SRX,"^",12)
- QUIT
- +14 SET SRX=$GET(^SRF(SRCASE,.1))
- if '$PIECE(SRX,"^",4)
- QUIT
- IF SRSR'=0
- IF '$PIECE(SRX,"^",13)
- QUIT
- +15 if SRQ
- QUIT
- SET SET SRZ=$PIECE($GET(^SRO(136,SRCASE,10)),"^")
- IF SRZ
- SET SRTN=SRCASE
- Begin DoDot:1
- +1 ; SR*3.0*204; these are FM variables from the calling routine that must survive the call below:
- NEW DE,DQ,DG,DIFLD
- +2 DO START^SROPCEP
- End DoDot:1
- +3 QUIT
