| 1 | SRSCAN0 ;B'HAM ISC/MAM - CANCEL SCHEDULED OPERATIONS (CONT) ;03/21/02 10:24 PM
|
|---|
| 2 | ;;3.0; Surgery ;**34,42,67,103,107,114,100,144**;24 Jun 93
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
|
|---|
| 5 | ;
|
|---|
| 6 | 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)
|
|---|
| 7 | S SRTYPE=$P(^SRF(SRTN,0),"^",10) I SRTYPE="S" W !!,"Case schedule type is STANDBY. "
|
|---|
| 8 | D NOW^%DTC S SRN=+$E(%,1,12) I SRTYPE'="S",SRN'<SRTIME G SWAP
|
|---|
| 9 | S SRBOTH=0 I $P($G(^SRF(SRTN,"CON")),"^") S SRBOTH=1
|
|---|
| 10 | REQ I 'SRBOTH D ^SRSCG
|
|---|
| 11 | S SRSCHST=$P($G(^SRF(SRTN,31)),"^",4) K:SRSCHST&SRSOR ^SRF("AMM",SRSOR,SRSCHST,SRTN)
|
|---|
| 12 | S $P(^SRF(SRTN,31),"^",4)="",$P(^SRF(SRTN,31),"^",5)="",^SRF(SRTN,"REQ")=1,^SRF("AR",SRSDATE,DFN,SRTN)="",^TMP("SRPFSS",$J)=""
|
|---|
| 13 | K DR S DA=SRTN,DR=".02///@",DIE=130 D ^DIE K DR D OERR
|
|---|
| 14 | I '$P($G(^SRF(SRTN,"1.0")),"^",11) D
|
|---|
| 15 | .N SREQ
|
|---|
| 16 | .S SREQ(130,SRTN_",",1.098)=+SRN,SREQ(130,SRTN_",",1.099)=DUZ
|
|---|
| 17 | .D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
|
|---|
| 18 | W !!,"Case #"_SRTN_" has been removed from the schedule and changed to a request."
|
|---|
| 19 | I SRBOTH G ASK
|
|---|
| 20 | PRESS W ! K DIR S DIR(0)="E" D ^DIR
|
|---|
| 21 | Q
|
|---|
| 22 | 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"
|
|---|
| 23 | S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
|
|---|
| 24 | 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
|
|---|
| 25 | I "Yy"[SRYN S SRTN=$P(^SRF(SRTN,"CON"),"^") G REQ
|
|---|
| 26 | NOCC ; no longer concurrent cases
|
|---|
| 27 | S DA=$P(^SRF(SRTN,"CON"),"^"),DIE=130,DR="35///@" D ^DIE S SROERR=DA D ^SROERR0 S DA=SRTN D ^DIE,OERR,UNLOCK^SROUTL(DA)
|
|---|
| 28 | Q
|
|---|
| 29 | SWAP ; move data into a new entry and set up the cancel date in the old
|
|---|
| 30 | W ! K DIR S DIR(0)="130,18",DIR("A")="Cancellation Reason" D ^DIR S SRSCAN=$P(Y,"^") I $D(DIRUT) W !!,"Case NOT cancelled." D PRESS G END
|
|---|
| 31 | K DR S SRCON=0,DA=SRTN,DR=".02///@;102///@;235///@;284///@;323///@;18////"_SRSCAN_";67T;70////"_DUZ,DIE=130 D ^DIE S:$D(DTOUT)!$D(DUOUT) SRSOUT=1
|
|---|
| 32 | S SRSCHST=$P($G(^SRF(SRTN,31)),"^",4),AVOID=$P(^(30),"^",2)
|
|---|
| 33 | I '$P($G(^SRF(SRTN,"CON")),"^") D ^SRSCG
|
|---|
| 34 | S SRSDPT=$P(^SRF(SRTN,0),"^"),SRSOP=$P(^SRF(SRTN,"OP"),"^")
|
|---|
| 35 | S SRSSET=$P(^SRF(SRTN,31),"^",5),$P(^SRF(SRTN,31),"^",4)="",$P(^SRF(SRTN,31),"^",5)=""
|
|---|
| 36 | SWAP2 K:SRSCHST&SRSOR ^SRF("AMM",SRSOR,SRSCHST,SRTN) D NOW^%DTC S $P(^SRF(SRTN,30),"^")=$E(%,1,12)
|
|---|
| 37 | I '$P($G(^SRF(SRTN,"CON")),"^") D OERR
|
|---|
| 38 | I SRSCAN'="" G:$P(^SRO(135,SRSCAN,0),"^",2)="D" CON
|
|---|
| 39 | D:'SRSOUT ^SRSCAN2
|
|---|
| 40 | CON I '$D(SRSCC),$D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" D CANCC^SRSUTL2 Q:SRBOTH="^"!SRSOUT I SRBOTH=1 G CON1
|
|---|
| 41 | 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
|
|---|
| 42 | I $G(SRDEAD)=0,$G(SRBOTH)=1,$G(SRSCC)=1 S SROERR=$P(^SRF(SRTN,"CON"),"^") D ^SROERR0 S SROERR=SRTN,^TMP("CSLSUR1",$J)="" D ^SROERR0
|
|---|
| 43 | END D UNLOCK^SROUTL(SRTN),^SRSKILL K SRTN W @IOF
|
|---|
| 44 | Q
|
|---|
| 45 | CON1 I SRDEAD=0 G SWAP2
|
|---|
| 46 | K DR S DA=SRTN,DR=".02///@;102///@;235///@;284///@;323///@;18///"_$P(^SRO(135,SRSCAN,0),"^")_";67///"_AVOID_";70////"_DUZ,DIE=130 D ^DIE
|
|---|
| 47 | D NOW^%DTC S $P(^SRF(SRTN,30),"^")=$E(%,1,12),$P(^SRF(SRTN,31),"^",4)="",$P(^SRF(SRTN,31),"^",5)=""
|
|---|
| 48 | OERR ; update ORDER file (100)
|
|---|
| 49 | S SROERR=SRTN K SRTX D ^SROERR0
|
|---|
| 50 | Q
|
|---|
