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