- 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 Jan 18, 2025@03:44:28 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