SROERR0 ;B'HAM ISC/ADM - ORDER ENTRY ROUTINE ;02/03/05
;;3.0; Surgery ;**4,67,73,41,86,107,147,144**;24 Jun 93
;
; Reference to RETURN^ORX supported by DBIA #866
; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
; Reference to UPD^VPRSR supported by DBIA #4750
;
N SROP,SROPER,SRDYNOTE,SRTYPE S SRTYPE=0
I $P($G(^SRO(133,SRSITE,0)),"^",22)="Y",$D(^TMP("CSLSUR1",$J)) D
.S SROP=SROERR,SROPER="" D ^SROP1 S SRDYNOTE=$P($G(^SRF(SROERR,31)),"^",10)
.I SROPER["REQUESTED",'SRDYNOTE Q
.I SROPER["CANCELLED"!(SROPER["ABORTED") S SRTYPE=3
.I 'SRTYPE,'SRDYNOTE S SRTYPE=1
.I 'SRTYPE,SRDYNOTE=1 S SRTYPE=2
.I '$P($G(^SRF(SROERR,.2)),"^",10),'$P($G(^SRF(SROERR,"OP")),"^",2) D
..W !!," This Surgery case does not have a Principal CPT Code entered. The ",!," information sent to SPD for creation of a case cart may not contain ",!," enough information for processing."
.D ST^SRSCOR(SROERR)
D SERR^SROPFSS(SROERR,"SROERR0")
D STATUS
I '$D(SREVENT) N SREVENT S SREVENT=$S(SRSTATUS="(CANCELLED)":"S15",1:"S14")
D MSG^SRHLZIU(SROERR,SRSTATUS,SREVENT)
I SRSTATUS="(COMPLETED)"!(SRSTATUS="(NOT COMPLETE)")!(SRSTATUS="(ABORTED)") D MSG^SRHLOORU(SROERR,SRSTATUS,SREVENT)
I $L($T(UPD^VPRSR)) D UPD^VPRSR(SROERR,$G(DFN),SRSTATUS) Q ;CPRS-R
I +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 D END Q
S:'$G(ORIFN) ORIFN=$P(^SRF(SROERR,0),"^",14) I 'ORIFN K ORIFN D END Q
S ORNP=$S($P($G(^SRF(SROERR,"NON")),"^")="Y":$P(^("NON"),"^",6),1:$P(^(.1),"^",4)),SRSOP=$P(^("OP"),"^")
S ORTX=SRSOP_"|>> Case #"_SROERR_" "_SRSTATUS,ORSTRT=$P(^SRF(SROERR,0),"^",9)
I DT<$E(ORSTRT,1,7) S X1=ORSTRT,X2=DT D ^%DTC S ORPURG=X+30
D RETURN^ORX
END K SROERR
Q
STATUS ; case status
I $P($G(^SRF(SROERR,"NON")),"^")="Y" S:+$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 ORSTS=2 S SRSTATUS=$S($P($G(^(30)),"^"):"(ABORTED)",$P($G(^("NON")),"^",5):"(COMPLETED)",1:"(NOT COMPLETE)") Q
I $P($G(^SRF(SROERR,30)),"^")'="" D CAN Q
I $P($G(^SRF(SROERR,31)),"^",8)'="" D CAN Q
I $P($G(^SRF(SROERR,.2)),"^",12) S:+$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 ORSTS=2 S SRSTATUS="(COMPLETED)" Q
I $D(^SRF(SROERR,.2)),$P(^(.2),"^",12)="" S SRSTAT=0 D SCH I SRST=0 D REQ Q:SRST G NO
I '$D(^SRF(SROERR,.2)) S SRSTAT=0 D SCH I SRST=0 D REQ Q:SRST=1 G NO
Q
NO ; not requested or scheduled
I +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 S ORSTS=9
S SRSTATUS="(NOT COMPLETE)"
Q
CAN ; cancelled or aborted
I +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 S ORSTS=1
S SR(.2)=$G(^SRF(SROERR,.2)) I $P(SR(.2),"^")!($P(SR(.2),"^",10)) S SRSTATUS="(ABORTED)" Q
S SRSTATUS="(CANCELLED)"
Q
SCH ; check to see if case is scheduled
I '$D(^SRF(SROERR,31)) S SRST=0 Q
I $P($G(^SRF(SROERR,31)),"^",4)="" S SRST=0 Q
I $P($G(^SRF(SROERR,31)),"^",4) D:SRSTAT=0 TIM0 D:SRSTAT=1 TIM1 S SRST=1 Q
Q
TIM0 I '$D(^SRF(SROERR,.2)) S:+$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 ORSTS=8 S SRSTATUS="(SCHEDULED)" Q
I $P(^SRF(SROERR,.2),"^",2) S:+$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 ORSTS=9 S SRSTATUS="(NOT COMPLETE)" Q
I $P(^SRF(SROERR,.2),"^",2)="" S:+$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 ORSTS=8 S SRSTATUS="(SCHEDULED)"
Q
TIM1 S:+$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 ORSTS=8 S SRSTATUS="(SCHEDULED)" Q
REQ ; check to see if case has been requested
I $P($G(^SRF(SROERR,"REQ")),"^")=1,'$D(^SRF(SROERR,.2)) S:+$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 ORSTS=5 S SRSTATUS="(REQUESTED)",SRST=1 Q
I $P($G(^SRF(SROERR,"REQ")),"^")=1,$P($G(^(.2)),"^",2)="" S:+$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 ORSTS=5 S SRSTATUS="(REQUESTED)",SRST=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROERR0 3702 printed Oct 16, 2024@18:43:57 Page 2
SROERR0 ;B'HAM ISC/ADM - ORDER ENTRY ROUTINE ;02/03/05
+1 ;;3.0; Surgery ;**4,67,73,41,86,107,147,144**;24 Jun 93
+2 ;
+3 ; Reference to RETURN^ORX supported by DBIA #866
+4 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
+5 ; Reference to UPD^VPRSR supported by DBIA #4750
+6 ;
+7 NEW SROP,SROPER,SRDYNOTE,SRTYPE
SET SRTYPE=0
+8 IF $PIECE($GET(^SRO(133,SRSITE,0)),"^",22)="Y"
IF $DATA(^TMP("CSLSUR1",$JOB))
Begin DoDot:1
+9 SET SROP=SROERR
SET SROPER=""
DO ^SROP1
SET SRDYNOTE=$PIECE($GET(^SRF(SROERR,31)),"^",10)
+10 IF SROPER["REQUESTED"
IF 'SRDYNOTE
QUIT
+11 IF SROPER["CANCELLED"!(SROPER["ABORTED")
SET SRTYPE=3
+12 IF 'SRTYPE
IF 'SRDYNOTE
SET SRTYPE=1
+13 IF 'SRTYPE
IF SRDYNOTE=1
SET SRTYPE=2
+14 IF '$PIECE($GET(^SRF(SROERR,.2)),"^",10)
IF '$PIECE($GET(^SRF(SROERR,"OP")),"^",2)
Begin DoDot:2
+15 WRITE !!," This Surgery case does not have a Principal CPT Code entered. The ",!," information sent to SPD for creation of a case cart may not contain ",!," enough information for processing."
End DoDot:2
+16 DO ST^SRSCOR(SROERR)
End DoDot:1
+17 DO SERR^SROPFSS(SROERR,"SROERR0")
+18 DO STATUS
+19 IF '$DATA(SREVENT)
NEW SREVENT
SET SREVENT=$SELECT(SRSTATUS="(CANCELLED)":"S15",1:"S14")
+20 DO MSG^SRHLZIU(SROERR,SRSTATUS,SREVENT)
+21 IF SRSTATUS="(COMPLETED)"!(SRSTATUS="(NOT COMPLETE)")!(SRSTATUS="(ABORTED)")
DO MSG^SRHLOORU(SROERR,SRSTATUS,SREVENT)
+22 ;CPRS-R
IF $LENGTH($TEXT(UPD^VPRSR))
DO UPD^VPRSR(SROERR,$GET(DFN),SRSTATUS)
QUIT
+23 IF +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
DO END
QUIT
+24 if '$GET(ORIFN)
SET ORIFN=$PIECE(^SRF(SROERR,0),"^",14)
IF 'ORIFN
KILL ORIFN
DO END
QUIT
+25 SET ORNP=$SELECT($PIECE($GET(^SRF(SROERR,"NON")),"^")="Y":$PIECE(^("NON"),"^",6),1:$PIECE(^(.1),"^",4))
SET SRSOP=$PIECE(^("OP"),"^")
+26 SET ORTX=SRSOP_"|>> Case #"_SROERR_" "_SRSTATUS
SET ORSTRT=$PIECE(^SRF(SROERR,0),"^",9)
+27 IF DT<$EXTRACT(ORSTRT,1,7)
SET X1=ORSTRT
SET X2=DT
DO ^%DTC
SET ORPURG=X+30
+28 DO RETURN^ORX
END KILL SROERR
+1 QUIT
STATUS ; case status
+1 IF $PIECE($GET(^SRF(SROERR,"NON")),"^")="Y"
if +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=2
SET SRSTATUS=$SELECT($PIECE($GET(^(30)),"^"):"(ABORTED)",$PIECE($GET(^("NON")),"^",5):"(COMPLETED)",1:"(NOT COMPLETE)")
QUIT
+2 IF $PIECE($GET(^SRF(SROERR,30)),"^")'=""
DO CAN
QUIT
+3 IF $PIECE($GET(^SRF(SROERR,31)),"^",8)'=""
DO CAN
QUIT
+4 IF $PIECE($GET(^SRF(SROERR,.2)),"^",12)
if +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=2
SET SRSTATUS="(COMPLETED)"
QUIT
+5 IF $DATA(^SRF(SROERR,.2))
IF $PIECE(^(.2),"^",12)=""
SET SRSTAT=0
DO SCH
IF SRST=0
DO REQ
if SRST
QUIT
GOTO NO
+6 IF '$DATA(^SRF(SROERR,.2))
SET SRSTAT=0
DO SCH
IF SRST=0
DO REQ
if SRST=1
QUIT
GOTO NO
+7 QUIT
NO ; not requested or scheduled
+1 IF +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=9
+2 SET SRSTATUS="(NOT COMPLETE)"
+3 QUIT
CAN ; cancelled or aborted
+1 IF +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=1
+2 SET SR(.2)=$GET(^SRF(SROERR,.2))
IF $PIECE(SR(.2),"^")!($PIECE(SR(.2),"^",10))
SET SRSTATUS="(ABORTED)"
QUIT
+3 SET SRSTATUS="(CANCELLED)"
+4 QUIT
SCH ; check to see if case is scheduled
+1 IF '$DATA(^SRF(SROERR,31))
SET SRST=0
QUIT
+2 IF $PIECE($GET(^SRF(SROERR,31)),"^",4)=""
SET SRST=0
QUIT
+3 IF $PIECE($GET(^SRF(SROERR,31)),"^",4)
if SRSTAT=0
DO TIM0
if SRSTAT=1
DO TIM1
SET SRST=1
QUIT
+4 QUIT
TIM0 IF '$DATA(^SRF(SROERR,.2))
if +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=8
SET SRSTATUS="(SCHEDULED)"
QUIT
+1 IF $PIECE(^SRF(SROERR,.2),"^",2)
if +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=9
SET SRSTATUS="(NOT COMPLETE)"
QUIT
+2 IF $PIECE(^SRF(SROERR,.2),"^",2)=""
if +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=8
SET SRSTATUS="(SCHEDULED)"
+3 QUIT
TIM1 if +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=8
SET SRSTATUS="(SCHEDULED)"
QUIT
REQ ; check to see if case has been requested
+1 IF $PIECE($GET(^SRF(SROERR,"REQ")),"^")=1
IF '$DATA(^SRF(SROERR,.2))
if +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=5
SET SRSTATUS="(REQUESTED)"
SET SRST=1
QUIT
+2 IF $PIECE($GET(^SRF(SROERR,"REQ")),"^")=1
IF $PIECE($GET(^(.2)),"^",2)=""
if +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
SET ORSTS=5
SET SRSTATUS="(REQUESTED)"
SET SRST=1
+3 QUIT
