- SRSCAN0 ;BIR/MAM - CANCEL SCHEDULED OPERATIONS (CONT);[AUG 10,2011@14:19]
- ;;3.0;Surgery;**34,42,67,103,107,114,100,144,175,176,182,184,188,201**;24 Jun 93;Build 5
- ;
- G SWAP ; change of SR*3*176
- CUT S X1=SRSDATE,X2=-1 D C^%DTC S SRSDT=X,X=$P($G(^SRO(133,SRSITE,0)),"^",12) S SRTIME=SRSDT_"."_$S(X'="":X,1:1500)
- S SRTYPE=$P(^SRF(SRTN,0),"^",10) I SRTYPE="S" W !!,"Case schedule type is STANDBY. "
- D NOW^%DTC S SRN=+$E(%,1,12) I SRTYPE'="S",SRN'<SRTIME G SWAP
- S SRBOTH=0 I $P($G(^SRF(SRTN,"CON")),"^") S SRBOTH=1
- REQ I 'SRBOTH D ^SRSCG
- S SRSCHST=$P($G(^SRF(SRTN,31)),"^",4) K:SRSCHST&SRSOR ^SRF("AMM",SRSOR,SRSCHST,SRTN)
- S $P(^SRF(SRTN,31),"^",4)="",$P(^SRF(SRTN,31),"^",5)="",^SRF(SRTN,"REQ")=1,^SRF("AR",SRSDATE,DFN,SRTN)="",^TMP("SRPFSS",$J)=""
- K DR S DA=SRTN,DR=".02///@",DIE=130 D ^DIE K DR D OERR
- I '$P($G(^SRF(SRTN,"1.0")),"^",11) D
- .N SREQ
- .S SREQ(130,SRTN_",",1.098)=+SRN,SREQ(130,SRTN_",",1.099)=DUZ
- .D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
- W !!,"Case #"_SRTN_" has been removed from the schedule and changed to a request."
- I SRBOTH G ASK
- PRESS W ! K DIR S DIR(0)="E" D ^DIR
- Q
- ASK S SRBOTH=0 W !!,"There is a concurrent case associated with this operation. Do you want to",!,"remove it from the schedule also ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N"
- S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
- I "YyNn"'[SRYN W !!,"If you want to remove both cases from the schedule, enter 'YES'. If you",!,"answer 'NO', the cases will no longer be associated with each other." G ASK
- I "Yy"[SRYN S SRTN=$P(^SRF(SRTN,"CON"),"^") G REQ
- NOCC ; no longer concurrent cases
- ;Modified for SR*3.0*201: call to SRSCHD1 UNLOCK procedure
- S DA=$P(^SRF(SRTN,"CON"),"^"),DIE=130,DR="35///@" D ^DIE S SROERR=DA D ^SROERR0 S DA=SRTN D ^DIE,OERR,UNLOCK^SRSCHD1(DA)
- Q
- SWAP ; move data into a new entry and set up the cancel date in the old
- W ! K DIR S DIR(0)="130,17.5",DIR("A")="Cancellation Timeframe" D ^DIR S SRTF=$P(Y,"^") I $D(DIRUT) W !!,"Case NOT cancelled." D PRESS G END
- K DIR S DIR(0)="130,18",DIR("A")="Primary Cancellation Reason" D ^DIR S SRSCAN=$P(Y,"^") I $D(DIRUT) W !!,"Case NOT cancelled." D PRESS G END
- K DR S SRCON=0,DA=SRTN,DR=".02///@;102///@;235///@;284///@;323///@;17.5////"_SRTF_";18////"_SRSCAN_";67T;70////"_DUZ,DIE=130 D ^DIE S:$D(DTOUT)!$D(DUOUT) SRSOUT=1
- S SRSCHST=$P($G(^SRF(SRTN,31)),"^",4),AVOID=$P(^(30),"^",2)
- I '$P($G(^SRF(SRTN,"CON")),"^") D ^SRSCG
- S SRSDPT=$P(^SRF(SRTN,0),"^"),SRSOP=$P(^SRF(SRTN,"OP"),"^")
- S SRSSET=$P(^SRF(SRTN,31),"^",5),$P(^SRF(SRTN,31),"^",4)="",$P(^SRF(SRTN,31),"^",5)=""
- SWAP2 K:SRSCHST&SRSOR ^SRF("AMM",SRSOR,SRSCHST,SRTN) D NOW^%DTC S $P(^SRF(SRTN,30),"^")=$E(%,1,12)
- I '$P($G(^SRF(SRTN,"CON")),"^") D OERR
- I SRSCAN'="" G:$P(^SRO(135,SRSCAN,0),"^",2)="D" CON
- D:'SRSOUT ^SRSCAN2
- CON I '$D(SRSCC),$D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" D CANCC^SRSUTL2 Q:SRBOTH="^"!SRSOUT I SRBOTH=1 G CON1
- I SRCON'=0,SRTNEW'=SRCON K DR S DA=SRTNEW,DIE=130,DR="35////"_SRCON D ^DIE S DA=SRCON,DR="35////"_SRTNEW D ^DIE K DR S SROERR=SRCON D ^SROERR0
- I $G(SRDEAD)=0,$G(SRBOTH)=1,$G(SRSCC)=1 S SROERR=$P(^SRF(SRTN,"CON"),"^") D ^SROERR0 S SROERR=SRTN D ^SROERR0
- ;Modified for SR*3.0*201: call to SRSCHD1 UNLOCK procedure
- END D UNLOCK^SRSCHD1(SRTN),^SRSKILL K SRTN W @IOF
- Q
- CON1 I SRDEAD=0 G SWAP2
- K DR S DA=SRTN,DR=".02///@;102///@;235///@;284///@;323///@;17.5////"_SRTF_";18///"_$P(^SRO(135,SRSCAN,0),"^")_";67///"_AVOID_";70////"_DUZ,DIE=130 D ^DIE
- D NOW^%DTC S $P(^SRF(SRTN,30),"^")=$E(%,1,12),$P(^SRF(SRTN,31),"^",4)="",$P(^SRF(SRTN,31),"^",5)=""
- OERR ; update ORDER file (100)
- S SROERR=SRTN K SRTX D ^SROERR0
- Q
- ABORT ; abort surgery case
- N SRDT,SRIN,SROUT
- S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) X ^DD("DD") S SRDT=Y
- W @IOF,!," "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRDT
- W !! F I=1:1:80 W "-"
- I $P($G(^SRF(SRTN,30)),"^")'=""!($P($G(^SRF(SRTN,31)),"^",8)'="") W !!,"Case has been cancelled/Aborted. No action taken." D PRESS Q
- S SROUT=$P($G(^SRF(SRTN,.2)),"^",12),SRIN=$P($G(^SRF(SRTN,.2)),"^",10)
- W ! K DIR S DIR(0)="130,18.5",DIR("A")="Case Aborted?",DIR("B")="N" D ^DIR S SRTF=$P(Y,"^") I $D(DIRUT) W !!,"Case NOT cancelled/aborted." D PRESS Q
- I $G(SRTF)>1,('SROUT!'SRIN) D I $D(DTOUT)!$D(DUOUT)!(Y="") W !!," TIME PAT OUT OR and TIME PAT OUT OR must be entered to ABORT the case. Please enter these times first" D PRESS Q
- .I 'SRIN K DIR S DA=SRTN,DIR(0)="130,.205",DIR("A")="Time Patient In the O.R." D ^DIR S SRIN=Y S:Y $P(^SRF(SRTN,.2),"^",10)=Y K DIR
- .I 'SROUT K DIR S DA=SRTN,DIR(0)="130,.232",DIR("A")="Time Patient Out of the O.R." D ^DIR S SROUT=Y K DIR
- K DIR S DIR(0)="130,18",DIR("A")="Primary Cancellation Reason" D ^DIR S SRSCAN=$P(Y,"^") I $D(DIRUT) W !!,"Case NOT cancelled/aborted." D PRESS Q
- K DR S SRCON=0,DA=SRTN,DR="17T;67T;70////"_DUZ_";.205////"_SRIN_";.232////"_SROUT,DIE=130 D ^DIE S:$D(DTOUT)!$D(DUOUT) SRSOUT=1
- S $P(^SRF(SRTN,30),"^",6)=SRTF I SRTF>1 S $P(^SRF(SRTN,30),"^",5)=1
- W !!!,$S(SRTF=1:"Cancelling",1:"Aborting")_" Surgery case #",SRTN D PRESS
- S SROERR=SRTN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCAN0 5058 printed Feb 19, 2025@00:13:28 Page 2
- SRSCAN0 ;BIR/MAM - CANCEL SCHEDULED OPERATIONS (CONT);[AUG 10,2011@14:19]
- +1 ;;3.0;Surgery;**34,42,67,103,107,114,100,144,175,176,182,184,188,201**;24 Jun 93;Build 5
- +2 ;
- +3 ; change of SR*3*176
- GOTO SWAP
- CUT SET X1=SRSDATE
- SET X2=-1
- DO C^%DTC
- SET SRSDT=X
- SET X=$PIECE($GET(^SRO(133,SRSITE,0)),"^",12)
- SET SRTIME=SRSDT_"."_$SELECT(X'="":X,1:1500)
- +1 SET SRTYPE=$PIECE(^SRF(SRTN,0),"^",10)
- IF SRTYPE="S"
- WRITE !!,"Case schedule type is STANDBY. "
- +2 DO NOW^%DTC
- SET SRN=+$EXTRACT(%,1,12)
- IF SRTYPE'="S"
- IF SRN'<SRTIME
- GOTO SWAP
- +3 SET SRBOTH=0
- IF $PIECE($GET(^SRF(SRTN,"CON")),"^")
- SET SRBOTH=1
- REQ IF 'SRBOTH
- DO ^SRSCG
- +1 SET SRSCHST=$PIECE($GET(^SRF(SRTN,31)),"^",4)
- if SRSCHST&SRSOR
- KILL ^SRF("AMM",SRSOR,SRSCHST,SRTN)
- +2 SET $PIECE(^SRF(SRTN,31),"^",4)=""
- SET $PIECE(^SRF(SRTN,31),"^",5)=""
- SET ^SRF(SRTN,"REQ")=1
- SET ^SRF("AR",SRSDATE,DFN,SRTN)=""
- SET ^TMP("SRPFSS",$JOB)=""
- +3 KILL DR
- SET DA=SRTN
- SET DR=".02///@"
- SET DIE=130
- DO ^DIE
- KILL DR
- DO OERR
- +4 IF '$PIECE($GET(^SRF(SRTN,"1.0")),"^",11)
- Begin DoDot:1
- +5 NEW SREQ
- +6 SET SREQ(130,SRTN_",",1.098)=+SRN
- SET SREQ(130,SRTN_",",1.099)=DUZ
- +7 DO FILE^DIE("","SREQ","^TMP(""SR"",$J)")
- End DoDot:1
- +8 WRITE !!,"Case #"_SRTN_" has been removed from the schedule and changed to a request."
- +9 IF SRBOTH
- GOTO ASK
- PRESS WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- +1 QUIT
- ASK SET SRBOTH=0
- WRITE !!,"There is a concurrent case associated with this operation. Do you want to",!,"remove it from the schedule also ? YES// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRYN="N"
- +1 SET SRYN=$EXTRACT(SRYN)
- if SRYN=""
- SET SRYN="Y"
- +2 IF "YyNn"'[SRYN
- WRITE !!,"If you want to remove both cases from the schedule, enter 'YES'. If you",!,"answer 'NO', the cases will no longer be associated with each other."
- GOTO ASK
- +3 IF "Yy"[SRYN
- SET SRTN=$PIECE(^SRF(SRTN,"CON"),"^")
- GOTO REQ
- NOCC ; no longer concurrent cases
- +1 ;Modified for SR*3.0*201: call to SRSCHD1 UNLOCK procedure
- +2 SET DA=$PIECE(^SRF(SRTN,"CON"),"^")
- SET DIE=130
- SET DR="35///@"
- DO ^DIE
- SET SROERR=DA
- DO ^SROERR0
- SET DA=SRTN
- DO ^DIE
- DO OERR
- DO UNLOCK^SRSCHD1(DA)
- +3 QUIT
- SWAP ; move data into a new entry and set up the cancel date in the old
- +1 WRITE !
- KILL DIR
- SET DIR(0)="130,17.5"
- SET DIR("A")="Cancellation Timeframe"
- DO ^DIR
- SET SRTF=$PIECE(Y,"^")
- IF $DATA(DIRUT)
- WRITE !!,"Case NOT cancelled."
- DO PRESS
- GOTO END
- +2 KILL DIR
- SET DIR(0)="130,18"
- SET DIR("A")="Primary Cancellation Reason"
- DO ^DIR
- SET SRSCAN=$PIECE(Y,"^")
- IF $DATA(DIRUT)
- WRITE !!,"Case NOT cancelled."
- DO PRESS
- GOTO END
- +3 KILL DR
- SET SRCON=0
- SET DA=SRTN
- SET DR=".02///@;102///@;235///@;284///@;323///@;17.5////"_SRTF_";18////"_SRSCAN_";67T;70////"_DUZ
- SET DIE=130
- DO ^DIE
- if $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- +4 SET SRSCHST=$PIECE($GET(^SRF(SRTN,31)),"^",4)
- SET AVOID=$PIECE(^(30),"^",2)
- +5 IF '$PIECE($GET(^SRF(SRTN,"CON")),"^")
- DO ^SRSCG
- +6 SET SRSDPT=$PIECE(^SRF(SRTN,0),"^")
- SET SRSOP=$PIECE(^SRF(SRTN,"OP"),"^")
- +7 SET SRSSET=$PIECE(^SRF(SRTN,31),"^",5)
- SET $PIECE(^SRF(SRTN,31),"^",4)=""
- SET $PIECE(^SRF(SRTN,31),"^",5)=""
- SWAP2 if SRSCHST&SRSOR
- KILL ^SRF("AMM",SRSOR,SRSCHST,SRTN)
- DO NOW^%DTC
- SET $PIECE(^SRF(SRTN,30),"^")=$EXTRACT(%,1,12)
- +1 IF '$PIECE($GET(^SRF(SRTN,"CON")),"^")
- DO OERR
- +2 IF SRSCAN'=""
- if $PIECE(^SRO(135,SRSCAN,0),"^",2)="D"
- GOTO CON
- +3 if 'SRSOUT
- DO ^SRSCAN2
- CON IF '$DATA(SRSCC)
- IF $DATA(^SRF(SRTN,"CON"))
- IF $PIECE(^("CON"),"^")'=""
- DO CANCC^SRSUTL2
- if SRBOTH="^"!SRSOUT
- QUIT
- IF SRBOTH=1
- GOTO CON1
- +1 IF SRCON'=0
- IF SRTNEW'=SRCON
- KILL DR
- SET DA=SRTNEW
- SET DIE=130
- SET DR="35////"_SRCON
- DO ^DIE
- SET DA=SRCON
- SET DR="35////"_SRTNEW
- DO ^DIE
- KILL DR
- SET SROERR=SRCON
- DO ^SROERR0
- +2 IF $GET(SRDEAD)=0
- IF $GET(SRBOTH)=1
- IF $GET(SRSCC)=1
- SET SROERR=$PIECE(^SRF(SRTN,"CON"),"^")
- DO ^SROERR0
- SET SROERR=SRTN
- DO ^SROERR0
- +3 ;Modified for SR*3.0*201: call to SRSCHD1 UNLOCK procedure
- END DO UNLOCK^SRSCHD1(SRTN)
- DO ^SRSKILL
- KILL SRTN
- WRITE @IOF
- +1 QUIT
- CON1 IF SRDEAD=0
- GOTO SWAP2
- +1 KILL DR
- SET DA=SRTN
- SET DR=".02///@;102///@;235///@;284///@;323///@;17.5////"_SRTF_";18///"_$PIECE(^SRO(135,SRSCAN,0),"^")_";67///"_AVOID_";70////"_DUZ
- SET DIE=130
- DO ^DIE
- +2 DO NOW^%DTC
- SET $PIECE(^SRF(SRTN,30),"^")=$EXTRACT(%,1,12)
- SET $PIECE(^SRF(SRTN,31),"^",4)=""
- SET $PIECE(^SRF(SRTN,31),"^",5)=""
- OERR ; update ORDER file (100)
- +1 SET SROERR=SRTN
- KILL SRTX
- DO ^SROERR0
- +2 QUIT
- ABORT ; abort surgery case
- +1 NEW SRDT,SRIN,SROUT
- +2 SET Y=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
- XECUTE ^DD("DD")
- SET SRDT=Y
- +3 WRITE @IOF,!," "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRDT
- +4 WRITE !!
- FOR I=1:1:80
- WRITE "-"
- +5 IF $PIECE($GET(^SRF(SRTN,30)),"^")'=""!($PIECE($GET(^SRF(SRTN,31)),"^",8)'="")
- WRITE !!,"Case has been cancelled/Aborted. No action taken."
- DO PRESS
- QUIT
- +6 SET SROUT=$PIECE($GET(^SRF(SRTN,.2)),"^",12)
- SET SRIN=$PIECE($GET(^SRF(SRTN,.2)),"^",10)
- +7 WRITE !
- KILL DIR
- SET DIR(0)="130,18.5"
- SET DIR("A")="Case Aborted?"
- SET DIR("B")="N"
- DO ^DIR
- SET SRTF=$PIECE(Y,"^")
- IF $DATA(DIRUT)
- WRITE !!,"Case NOT cancelled/aborted."
- DO PRESS
- QUIT
- +8 IF $GET(SRTF)>1
- IF ('SROUT!'SRIN)
- Begin DoDot:1
- +9 IF 'SRIN
- KILL DIR
- SET DA=SRTN
- SET DIR(0)="130,.205"
- SET DIR("A")="Time Patient In the O.R."
- DO ^DIR
- SET SRIN=Y
- if Y
- SET $PIECE(^SRF(SRTN,.2),"^",10)=Y
- KILL DIR
- +10 IF 'SROUT
- KILL DIR
- SET DA=SRTN
- SET DIR(0)="130,.232"
- SET DIR("A")="Time Patient Out of the O.R."
- DO ^DIR
- SET SROUT=Y
- KILL DIR
- End DoDot:1
- IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
- WRITE !!," TIME PAT OUT OR and TIME PAT OUT OR must be entered to ABORT the case. Please enter these times first"
- DO PRESS
- QUIT
- +11 KILL DIR
- SET DIR(0)="130,18"
- SET DIR("A")="Primary Cancellation Reason"
- DO ^DIR
- SET SRSCAN=$PIECE(Y,"^")
- IF $DATA(DIRUT)
- WRITE !!,"Case NOT cancelled/aborted."
- DO PRESS
- QUIT
- +12 KILL DR
- SET SRCON=0
- SET DA=SRTN
- SET DR="17T;67T;70////"_DUZ_";.205////"_SRIN_";.232////"_SROUT
- SET DIE=130
- DO ^DIE
- if $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- +13 SET $PIECE(^SRF(SRTN,30),"^",6)=SRTF
- IF SRTF>1
- SET $PIECE(^SRF(SRTN,30),"^",5)=1
- +14 WRITE !!!,$SELECT(SRTF=1:"Cancelling",1:"Aborting")_" Surgery case #",SRTN
- DO PRESS
- +15 SET SROERR=SRTN
- +16 QUIT