SROERR ;B'HAM ISC/MAM,ADM - ORDER ENTRY ROUTINE ;01/22/99 9:47 AM
;;3.0; Surgery ;**14,67,73,41,80,86,107,147,144**;24 Jun 93
;
; Reference to ^ORD(100.99 supported by DBIA #874
; Reference to FILE^ORX supported by DBIA #866
; Reference to ST^ORX supported by DBIA #866
; Reference to NEW^VPRSR supported by DBIA #4750
; Reference to DEL^VPRSR supported by DBIA #4750
;
CREATE ; create order in ORDER file (100)
I $P($G(^SRO(133,SRSITE,0)),"^",22)="Y" D
.N SROP,SROPER,SRTYPE,DYNOTE
.S SROP=SRTN,SROPER="" D ^SROP1 S SRTYPE=1
.I SROPER["REQUESTED" Q
.I $P($G(^SRF(SRTN,"OP")),"^",2)']"" D
..W !!," This Surgery case does not have a Planned Principal CPT Code entered. The ",!," information sent to SPD for creation of a case cart may not contain ",!," enough information for processing."
.I SROPER["SCHEDULED" S SRTYPE=1
.I SROPER["NOT COMPLETE",$P($G(^SRF(SRTN,.2)),"^",10) S SRTYPE=1
.D ST^SRSCOR(SRTN)
D SERR^SROPFSS(SRTN,"SROERR")
N SREVENT S SREVENT="S12",SROERR=SRTN D STATUS^SROERR0,MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
I $L($T(NEW^VPRSR)) D NEW^VPRSR(SROERR,$G(DFN),SRSTATUS) Q ;CPRS-R
I +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 K SROERR Q
I '$D(^ORD(100.99)) Q
I '$D(ORPCL) K DIC S DIC="^DIC(19,",X="SR SURGERY REQUEST",DIC(0)="" D ^DIC I Y'=-1 S ORPCL=+Y_";DIC(19,"
REQ S ORNP=SRSDOC,ORPK=SRTN,ORSTRT=SRSDATE S:'$D(ORVP) ORVP=DFN_";DPT(" D:'$D(ORL) LOC
S:'$D(SROERR) SROERR=SRTN D STATUS^SROERR0 S ORTX=SRSOP_"|>> Case #"_SRTN_" "_SRSTATUS
I DT<$E(ORSTRT,1,7) S X1=ORSTRT,X2=DT D ^%DTC S ORPURG=X+30
D FILE^ORX K DIE,DA,DR S DA=SRTN,DIE=130,DR="100////"_ORIFN D ^DIE K DA,DR,DIE,ORIFN,SROERR
Q
LOC S SRL=$P($G(^DPT(DFN,.1)),"^") I SRL'="" K DIC S DIC="^DIC(42,",X=SRL D ^DIC K DIC S SRL=$S(Y'=-1:+Y,1:"") S:SRL SRL=$P($G(^DIC(42,SRL,44)),"^")
S ORL=$S(SRL:SRL_";SC(",1:"")
Q
EN ; entry for OE/RR, process order actions
S:'$D(ORGY) ORGY="" Q:'$D(ORACTION)!(ORGY=9) I ORGY=10 S SROERR=ORPK D ^SROERR0 Q
I ORACTION=7 D PURGE Q
8 I ORACTION=8 D DETAIL S:'$O(ORSLST(ORNXT)) OREND=1 Q
I "2345"[ORACTION W !!,"Not allowed on Surgical Requests !" Q
I ORACTION,ORSTS'=5 W !!,"Cannot update/delete case not in 'REQUESTED' status !" Q
I '$D(^XUSEC("SROREQ",DUZ)) W !!,"You must hold the 'SROREQ' key to perform this function !" G PRESS
D:'$D(SRSITE) ^SROVAR S DFN=+ORVP D DEM^VADPT I ORACTION=0 S ORPCL=XQORNOD D ADD Q
I ORACTION=1 D DISPLAY,EDIT Q
I ORACTION=6 D DISPLAY D DEL^SRSUPRQ G END
Q
EDIT ; edit requested case
W !!,"1. Delete",!,"2. Update Request Information",!,"3. Change the Request Date",!!,"Select Number: " R Z:DTIME S:'$T Z="" G:"^"[Z END S:Z["?" Z=4
I Z<1!(Z>3)!(+Z\1'=Z) W !!,"If you want to delete this request, enter '1'. Enter '2' if you only want",!,"to update the general information about this case, or '3' to change the date",!,"for which this case is requested." G EDIT
I Z=1 D DEL^SRSUPRQ G END
I Z=2 D UPDATE^SRSUPRQ G END
I Z=3 D CHANGE^SRSDT
END K SRTN D ^SRSKILL
Q
DISPLAY S SRDFN=+ORVP,SRNM=VADM(1),SRTN=ORPK,SRSDATE=$P(^SRF(SRTN,0),"^",9)
W @IOF,!,SRNM," (",VA("PID"),")" I $P($G(^DPT(DFN,.35)),"^")'="" S Y=$P(^(.35),"^") D D^DIQ W " ** DIED: "_Y_" **" G END
S SRSDT=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3) S SROPER=$P(^SRF(SRTN,"OP"),"^")_" (#"_SRTN_")"
K SROPS,MM,MMM S:$L(SROPER)<71 SROPS(1)=SROPER I $L(SROPER)>70 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
W !!,SRSDT,?11,SROPS(1) I $D(SROPS(2)) W !,?11,SROPS(2) I $D(SROPS(3)) W !,?11,SROPS(3)
Q
LOOP ; break case information if longer than 70 characters
S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<70 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
PRESS W !!,"Press RETURN to continue " R X:DTIME G:'$T END
Q
DETAIL I $E(IOST)="C" W !!,"Press RETURN to review case information, or '^' to quit. " R X:DTIME I '$T!(X["^") S OREND=1 Q
S SRTN=ORPK I $P($G(^SRF(SRTN,"NON")),"^")="Y" D ^SROERR2 G END
D ^SROERR1,END
Q
ADD ; add new requests to ORDER file (100)
W @IOF,!,VADM(1)," (",VA("PID"),")" I $P($G(^DPT(+ORVP,.35)),"^")'="" S Y=$P(^(.35),"^") D D^DIQ W " ** DIED: "_Y_" **"
W !!,"Add New Surgery Requests",!!!,"1. Make Operation Requests",!,"2. Make a Request from the Waiting List",!,"3. Make a Request for Concurrent Cases"
W !!,"Select Number: " R Z:DTIME S:'$T Z="" G:"^"[Z END S:Z["?" Z=4
I Z<1!(Z>3)!(+Z\1'=Z) W !!,"If you want to make a new operation request, enter '1'. Enter '2' if you want",!,"to make a request from the surgery waiting list, or '3' to make a request for",!,"concurrent cases." D PRESS G ADD
I Z=1 D ^SRSMREQ G END
I Z=2 D ^SRSWREQ G END
I Z=3 D ^SRSCONR G END
Q
PURGE ; purge order from ORDER file
N SREVENT,SRSTATUS S SREVENT="S17",SRSTATUS="(DELETED)" D MSG^SRHLZIU(ORPK,SRSTATUS,SREVENT)
I $L($T(DEL^VPRSR)) D DEL^VPRSR(ORPK,$G(DFN)) Q ;CPRS-R
I +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 Q
I "589"'[ORSTS S:$D(^SRF(ORPK,0)) $P(^(0),"^",14)="" S ORSTS="K" D ST^ORX
Q
DEL ; delete from ORDER file (100) and call CoreFLS API
I $P($G(^SRO(133,SRSITE,0)),"^",22)="Y" D
.N SRDYNOTE,SRTYPE
.S SRDYNOTE=$P($G(^SRF(SRTN,31)),"^",10) Q:'SRDYNOTE
.I SRDYNOTE S SRTYPE=4 D ST^SRSCOR(SRTN)
N SREVENT,SRSTATUS S SREVENT="S17",SRSTATUS="(DELETED)" D MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
I $L($T(DEL^VPRSR)) D DEL^VPRSR(SRTN,$G(DFN)) Q ;CPRS-R
I +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 Q
S:'$D(ORIFN) ORIFN=$P(^SRF(SRTN,0),"^",14) I $D(ORIFN) S ORSTS="K" D ST^ORX K ORIFN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROERR 5576 printed Oct 16, 2024@18:43:56 Page 2
SROERR ;B'HAM ISC/MAM,ADM - ORDER ENTRY ROUTINE ;01/22/99 9:47 AM
+1 ;;3.0; Surgery ;**14,67,73,41,80,86,107,147,144**;24 Jun 93
+2 ;
+3 ; Reference to ^ORD(100.99 supported by DBIA #874
+4 ; Reference to FILE^ORX supported by DBIA #866
+5 ; Reference to ST^ORX supported by DBIA #866
+6 ; Reference to NEW^VPRSR supported by DBIA #4750
+7 ; Reference to DEL^VPRSR supported by DBIA #4750
+8 ;
CREATE ; create order in ORDER file (100)
+1 IF $PIECE($GET(^SRO(133,SRSITE,0)),"^",22)="Y"
Begin DoDot:1
+2 NEW SROP,SROPER,SRTYPE,DYNOTE
+3 SET SROP=SRTN
SET SROPER=""
DO ^SROP1
SET SRTYPE=1
+4 IF SROPER["REQUESTED"
QUIT
+5 IF $PIECE($GET(^SRF(SRTN,"OP")),"^",2)']""
Begin DoDot:2
+6 WRITE !!," This Surgery case does not have a Planned 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
+7 IF SROPER["SCHEDULED"
SET SRTYPE=1
+8 IF SROPER["NOT COMPLETE"
IF $PIECE($GET(^SRF(SRTN,.2)),"^",10)
SET SRTYPE=1
+9 DO ST^SRSCOR(SRTN)
End DoDot:1
+10 DO SERR^SROPFSS(SRTN,"SROERR")
+11 NEW SREVENT
SET SREVENT="S12"
SET SROERR=SRTN
DO STATUS^SROERR0
DO MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
+12 ;CPRS-R
IF $LENGTH($TEXT(NEW^VPRSR))
DO NEW^VPRSR(SROERR,$GET(DFN),SRSTATUS)
QUIT
+13 IF +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
KILL SROERR
QUIT
+14 IF '$DATA(^ORD(100.99))
QUIT
+15 IF '$DATA(ORPCL)
KILL DIC
SET DIC="^DIC(19,"
SET X="SR SURGERY REQUEST"
SET DIC(0)=""
DO ^DIC
IF Y'=-1
SET ORPCL=+Y_";DIC(19,"
REQ SET ORNP=SRSDOC
SET ORPK=SRTN
SET ORSTRT=SRSDATE
if '$DATA(ORVP)
SET ORVP=DFN_";DPT("
if '$DATA(ORL)
DO LOC
+1 if '$DATA(SROERR)
SET SROERR=SRTN
DO STATUS^SROERR0
SET ORTX=SRSOP_"|>> Case #"_SRTN_" "_SRSTATUS
+2 IF DT<$EXTRACT(ORSTRT,1,7)
SET X1=ORSTRT
SET X2=DT
DO ^%DTC
SET ORPURG=X+30
+3 DO FILE^ORX
KILL DIE,DA,DR
SET DA=SRTN
SET DIE=130
SET DR="100////"_ORIFN
DO ^DIE
KILL DA,DR,DIE,ORIFN,SROERR
+4 QUIT
LOC SET SRL=$PIECE($GET(^DPT(DFN,.1)),"^")
IF SRL'=""
KILL DIC
SET DIC="^DIC(42,"
SET X=SRL
DO ^DIC
KILL DIC
SET SRL=$SELECT(Y'=-1:+Y,1:"")
if SRL
SET SRL=$PIECE($GET(^DIC(42,SRL,44)),"^")
+1 SET ORL=$SELECT(SRL:SRL_";SC(",1:"")
+2 QUIT
EN ; entry for OE/RR, process order actions
+1 if '$DATA(ORGY)
SET ORGY=""
if '$DATA(ORACTION)!(ORGY=9)
QUIT
IF ORGY=10
SET SROERR=ORPK
DO ^SROERR0
QUIT
+2 IF ORACTION=7
DO PURGE
QUIT
8 IF ORACTION=8
DO DETAIL
if '$ORDER(ORSLST(ORNXT))
SET OREND=1
QUIT
+1 IF "2345"[ORACTION
WRITE !!,"Not allowed on Surgical Requests !"
QUIT
+2 IF ORACTION
IF ORSTS'=5
WRITE !!,"Cannot update/delete case not in 'REQUESTED' status !"
QUIT
+3 IF '$DATA(^XUSEC("SROREQ",DUZ))
WRITE !!,"You must hold the 'SROREQ' key to perform this function !"
GOTO PRESS
+4 if '$DATA(SRSITE)
DO ^SROVAR
SET DFN=+ORVP
DO DEM^VADPT
IF ORACTION=0
SET ORPCL=XQORNOD
DO ADD
QUIT
+5 IF ORACTION=1
DO DISPLAY
DO EDIT
QUIT
+6 IF ORACTION=6
DO DISPLAY
DO DEL^SRSUPRQ
GOTO END
+7 QUIT
EDIT ; edit requested case
+1 WRITE !!,"1. Delete",!,"2. Update Request Information",!,"3. Change the Request Date",!!,"Select Number: "
READ Z:DTIME
if '$TEST
SET Z=""
if "^"[Z
GOTO END
if Z["?"
SET Z=4
+2 IF Z<1!(Z>3)!(+Z\1'=Z)
WRITE !!,"If you want to delete this request, enter '1'. Enter '2' if you only want",!,"to update the general information about this case, or '3' to change the date",!,"for which this case is requested."
GOTO EDIT
+3 IF Z=1
DO DEL^SRSUPRQ
GOTO END
+4 IF Z=2
DO UPDATE^SRSUPRQ
GOTO END
+5 IF Z=3
DO CHANGE^SRSDT
END KILL SRTN
DO ^SRSKILL
+1 QUIT
DISPLAY SET SRDFN=+ORVP
SET SRNM=VADM(1)
SET SRTN=ORPK
SET SRSDATE=$PIECE(^SRF(SRTN,0),"^",9)
+1 WRITE @IOF,!,SRNM," (",VA("PID"),")"
IF $PIECE($GET(^DPT(DFN,.35)),"^")'=""
SET Y=$PIECE(^(.35),"^")
DO D^DIQ
WRITE " ** DIED: "_Y_" **"
GOTO END
+2 SET SRSDT=$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3)
SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")_" (#"_SRTN_")"
+3 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<71
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>70
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+4 WRITE !!,SRSDT,?11,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?11,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?11,SROPS(3)
+5 QUIT
LOOP ; break case information if longer than 70 characters
+1 SET SROPS(M)=""
FOR LOOP=1:1
SET MM=$PIECE(SROPER," ")
SET MMM=$PIECE(SROPER," ",2,200)
if MMM=""
QUIT
if $LENGTH(SROPS(M))+$LENGTH(MM)'<70
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
PRESS WRITE !!,"Press RETURN to continue "
READ X:DTIME
if '$TEST
GOTO END
+1 QUIT
DETAIL IF $EXTRACT(IOST)="C"
WRITE !!,"Press RETURN to review case information, or '^' to quit. "
READ X:DTIME
IF '$TEST!(X["^")
SET OREND=1
QUIT
+1 SET SRTN=ORPK
IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
DO ^SROERR2
GOTO END
+2 DO ^SROERR1
DO END
+3 QUIT
ADD ; add new requests to ORDER file (100)
+1 WRITE @IOF,!,VADM(1)," (",VA("PID"),")"
IF $PIECE($GET(^DPT(+ORVP,.35)),"^")'=""
SET Y=$PIECE(^(.35),"^")
DO D^DIQ
WRITE " ** DIED: "_Y_" **"
+2 WRITE !!,"Add New Surgery Requests",!!!,"1. Make Operation Requests",!,"2. Make a Request from the Waiting List",!,"3. Make a Request for Concurrent Cases"
+3 WRITE !!,"Select Number: "
READ Z:DTIME
if '$TEST
SET Z=""
if "^"[Z
GOTO END
if Z["?"
SET Z=4
+4 IF Z<1!(Z>3)!(+Z\1'=Z)
WRITE !!,"If you want to make a new operation request, enter '1'. Enter '2' if you want",!,"to make a request from the surgery waiting list, or '3' to make a request for",!,"concurrent cases."
DO PRESS
GOTO ADD
+5 IF Z=1
DO ^SRSMREQ
GOTO END
+6 IF Z=2
DO ^SRSWREQ
GOTO END
+7 IF Z=3
DO ^SRSCONR
GOTO END
+8 QUIT
PURGE ; purge order from ORDER file
+1 NEW SREVENT,SRSTATUS
SET SREVENT="S17"
SET SRSTATUS="(DELETED)"
DO MSG^SRHLZIU(ORPK,SRSTATUS,SREVENT)
+2 ;CPRS-R
IF $LENGTH($TEXT(DEL^VPRSR))
DO DEL^VPRSR(ORPK,$GET(DFN))
QUIT
+3 IF +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
QUIT
+4 IF "589"'[ORSTS
if $DATA(^SRF(ORPK,0))
SET $PIECE(^(0),"^",14)=""
SET ORSTS="K"
DO ST^ORX
+5 QUIT
DEL ; delete from ORDER file (100) and call CoreFLS API
+1 IF $PIECE($GET(^SRO(133,SRSITE,0)),"^",22)="Y"
Begin DoDot:1
+2 NEW SRDYNOTE,SRTYPE
+3 SET SRDYNOTE=$PIECE($GET(^SRF(SRTN,31)),"^",10)
if 'SRDYNOTE
QUIT
+4 IF SRDYNOTE
SET SRTYPE=4
DO ST^SRSCOR(SRTN)
End DoDot:1
+5 NEW SREVENT,SRSTATUS
SET SREVENT="S17"
SET SRSTATUS="(DELETED)"
DO MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
+6 ;CPRS-R
IF $LENGTH($TEXT(DEL^VPRSR))
DO DEL^VPRSR(SRTN,$GET(DFN))
QUIT
+7 IF +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5
QUIT
+8 if '$DATA(ORIFN)
SET ORIFN=$PIECE(^SRF(SRTN,0),"^",14)
IF $DATA(ORIFN)
SET ORSTS="K"
DO ST^ORX
KILL ORIFN
+9 QUIT
