SROPCEX.m

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

SROPCEX   ;BIR/ADM - CROSS REFERENCE LOGIC ;01/11/06

 +1       ;;3.0; Surgery ;**58,62,69,86,119,142**;24 Jun 93

 +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

               DO START^SROPCEP

 +1        QUIT