- 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 Jan 18, 2025@03:48:39 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)