Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SRSCAN0

SRSCAN0.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. G SWAP ; change of SR*3*176
  1. 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)
  1. S SRTYPE=$P(^SRF(SRTN,0),"^",10) I SRTYPE="S" W !!,"Case schedule type is STANDBY. "
  1. D NOW^%DTC S SRN=+$E(%,1,12) I SRTYPE'="S",SRN'<SRTIME G SWAP
  1. S SRBOTH=0 I $P($G(^SRF(SRTN,"CON")),"^") S SRBOTH=1
  1. REQ I 'SRBOTH D ^SRSCG
  1. S SRSCHST=$P($G(^SRF(SRTN,31)),"^",4) K:SRSCHST&SRSOR ^SRF("AMM",SRSOR,SRSCHST,SRTN)
  1. S $P(^SRF(SRTN,31),"^",4)="",$P(^SRF(SRTN,31),"^",5)="",^SRF(SRTN,"REQ")=1,^SRF("AR",SRSDATE,DFN,SRTN)="",^TMP("SRPFSS",$J)=""
  1. K DR S DA=SRTN,DR=".02///@",DIE=130 D ^DIE K DR D OERR
  1. I '$P($G(^SRF(SRTN,"1.0")),"^",11) D
  1. .N SREQ
  1. .S SREQ(130,SRTN_",",1.098)=+SRN,SREQ(130,SRTN_",",1.099)=DUZ
  1. .D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
  1. W !!,"Case #"_SRTN_" has been removed from the schedule and changed to a request."
  1. I SRBOTH G ASK
  1. PRESS W ! K DIR S DIR(0)="E" D ^DIR
  1. Q
  1. 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"
  1. S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
  1. 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
  1. I "Yy"[SRYN S SRTN=$P(^SRF(SRTN,"CON"),"^") G REQ
  1. NOCC ; no longer concurrent cases
  1. ;Modified for SR*3.0*201: call to SRSCHD1 UNLOCK procedure
  1. 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)
  1. Q
  1. SWAP ; move data into a new entry and set up the cancel date in the old
  1. 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
  1. 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
  1. 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
  1. S SRSCHST=$P($G(^SRF(SRTN,31)),"^",4),AVOID=$P(^(30),"^",2)
  1. I '$P($G(^SRF(SRTN,"CON")),"^") D ^SRSCG
  1. S SRSDPT=$P(^SRF(SRTN,0),"^"),SRSOP=$P(^SRF(SRTN,"OP"),"^")
  1. S SRSSET=$P(^SRF(SRTN,31),"^",5),$P(^SRF(SRTN,31),"^",4)="",$P(^SRF(SRTN,31),"^",5)=""
  1. SWAP2 K:SRSCHST&SRSOR ^SRF("AMM",SRSOR,SRSCHST,SRTN) D NOW^%DTC S $P(^SRF(SRTN,30),"^")=$E(%,1,12)
  1. I '$P($G(^SRF(SRTN,"CON")),"^") D OERR
  1. I SRSCAN'="" G:$P(^SRO(135,SRSCAN,0),"^",2)="D" CON
  1. D:'SRSOUT ^SRSCAN2
  1. CON I '$D(SRSCC),$D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" D CANCC^SRSUTL2 Q:SRBOTH="^"!SRSOUT I SRBOTH=1 G CON1
  1. 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
  1. I $G(SRDEAD)=0,$G(SRBOTH)=1,$G(SRSCC)=1 S SROERR=$P(^SRF(SRTN,"CON"),"^") D ^SROERR0 S SROERR=SRTN D ^SROERR0
  1. ;Modified for SR*3.0*201: call to SRSCHD1 UNLOCK procedure
  1. END D UNLOCK^SRSCHD1(SRTN),^SRSKILL K SRTN W @IOF
  1. Q
  1. CON1 I SRDEAD=0 G SWAP2
  1. 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
  1. D NOW^%DTC S $P(^SRF(SRTN,30),"^")=$E(%,1,12),$P(^SRF(SRTN,31),"^",4)="",$P(^SRF(SRTN,31),"^",5)=""
  1. OERR ; update ORDER file (100)
  1. S SROERR=SRTN K SRTX D ^SROERR0
  1. Q
  1. ABORT ; abort surgery case
  1. N SRDT,SRIN,SROUT
  1. S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) X ^DD("DD") S SRDT=Y
  1. W @IOF,!," "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRDT
  1. W !! F I=1:1:80 W "-"
  1. I $P($G(^SRF(SRTN,30)),"^")'=""!($P($G(^SRF(SRTN,31)),"^",8)'="") W !!,"Case has been cancelled/Aborted. No action taken." D PRESS Q
  1. S SROUT=$P($G(^SRF(SRTN,.2)),"^",12),SRIN=$P($G(^SRF(SRTN,.2)),"^",10)
  1. 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
  1. 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
  1. .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
  1. .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
  1. 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
  1. 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
  1. S $P(^SRF(SRTN,30),"^",6)=SRTF I SRTF>1 S $P(^SRF(SRTN,30),"^",5)=1
  1. W !!!,$S(SRTF=1:"Cancelling",1:"Aborting")_" Surgery case #",SRTN D PRESS
  1. S SROERR=SRTN
  1. Q