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

SRSDT.m

Go to the documentation of this file.
  1. SRSDT ;B'HAM ISC/MAM - CHANGE DATE OF OPERATION REQUEST; [ 06/14/01 9:54 AM ]
  1. ;;3.0;Surgery;**3,16,34,67,77,103,114,100,175**;24 Jun 93;Build 6
  1. CHANGE ; change date of request
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) Q:'SRLCK
  1. D ^SRSTCH I SRSOUT Q
  1. W !! S CON=0,SRDT=SRSDATE,%DT="AEFX",%DT("A")="Change to which Date ? " D ^%DT K %DT Q:Y<1 S SRSDATE=+Y
  1. I SRSDATE<DT W !!,"Requests cannot be made for past dates. Please select another date." K Y S SRSDATE=SRDT G CHANGE
  1. K SRLATE S SRDTCH=1 D LATE^SRSREQ I $D(SRLATE) G CHANGE
  1. NEWDT I SRSDATE=SRDT Q
  1. K ^SRF("AC",SRDT,SRTN)
  1. K DR,DIE,DA S DIE=130,DA=SRTN,DR=".09////"_SRSDATE_";616////"_SRSDATE D ^DIE K DR
  1. K DR,X S SRSREQ=1,SRSATT=$S($D(^SRF(SRTN,.1)):$P(^(.1),"^",13),1:""),SRTS=$P(^SRF(SRTN,0),"^",4),DIE=130,DA=SRTN,DR=".04////"_SRTS_";.164////"_SRSATT D ^DIE K DR D ^SROXRET
  1. S SRINVDT=9999999.999999-SRDT K ^SRF("ADT",DFN,SRINVDT,SRTN),SRINVDT
  1. N SREQ D NOW^%DTC S SREQ(130,SRTN_",",1.098)=+$E(%,1,12),SREQ(130,SRTN_",",1.099)=DUZ D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
  1. I SRTS K ^SRF("ASP",SRTS,SRDT,SRTN)
  1. S SROERR=SRTN K SRTX D ^SROERR0
  1. I CON=0,$D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" D CC I SRBOTH=1 S SRTN=$P(^SRF(SRTN,"CON"),"^") Q:SRTN="" S CON=1 G NEWDT
  1. S Y=SRSDATE D D^DIQ S SRSDATE=Y W !!,"The request for "_SRNM_" has been changed to "_SRSDATE_"."
  1. D UNLOCK^SROUTL(SRTN)
  1. Q
  1. CC ; concurrent case check
  1. W !!,"There is a concurrent case associated with this operation. Do you want to",!,"change the date of it also ? YES// " R SRBOTH:DTIME I '$T S SRBOTH="Y"
  1. I SRBOTH="^" W !!,"Please answer 'YES' or 'NO'. A '^' is not allowed. " G CC
  1. S:SRBOTH="" SRBOTH="Y" S SRBOTH=$E(SRBOTH) I "YyNn"'[SRBOTH W !!,"Enter RETURN if these cases will remain concurrent, or 'NO' if they will no",!,"longer be associated together." G CC
  1. I SRBOTH["Y" S SRBOTH=1 Q
  1. S DIE=130,DA=$P(^SRF(SRTN,"CON"),"^"),DR="35///@" D ^DIE,UNLOCK^SROUTL(DA)
  1. S DA=SRTN D ^DIE
  1. Q
  1. DSMP() ; date/time stamp
  1. D NOW^%DTC Q +$E(%,1,12)