source: FOIAVistA/trunk/r/SURGERY-SR/SRSDT.m@ 711

Last change on this file since 711 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1SRSDT ;B'HAM ISC/MAM - CHANGE DATE OF OPERATION REQUEST; [ 06/14/01 9:54 AM ]
2 ;;3.0; Surgery ;**3,16,34,67,77,103,114,100**;24 Jun 93
3CHANGE ; change date of request
4 N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) Q:'SRLCK
5 D ^SRSTCH I SRSOUT Q
6 W !! S CON=0,SRDT=SRSDATE,%DT="AEFX",%DT("A")="Change to which Date ? " D ^%DT K %DT Q:Y<1 S SRSDATE=+Y
7 I SRSDATE<DT W !!,"Requests cannot be made for past dates. Please select another date." K Y S SRSDATE=SRDT G CHANGE
8 K SRLATE S SRDTCH=1 D LATE^SRSREQ I $D(SRLATE) G CHANGE
9NEWDT I SRSDATE=SRDT Q
10 K ^SRF("AC",SRDT,SRTN)
11 K DR,DIE,DA S DIE=130,DA=SRTN,DR=".09////"_SRSDATE D ^DIE K DR
12 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
13 S SRINVDT=9999999.999999-SRDT K ^SRF("ADT",DFN,SRINVDT,SRTN),SRINVDT
14 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)")
15 I SRTS K ^SRF("ASP",SRTS,SRDT,SRTN)
16 S SROERR=SRTN K SRTX D ^SROERR0
17 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
18 S Y=SRSDATE D D^DIQ S SRSDATE=Y W !!,"The request for "_SRNM_" has been changed to "_SRSDATE_"."
19 D UNLOCK^SROUTL(SRTN)
20 Q
21CC ; concurrent case check
22 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"
23 I SRBOTH="^" W !!,"Please answer 'YES' or 'NO'. A '^' is not allowed. " G CC
24 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
25 I SRBOTH["Y" S SRBOTH=1 Q
26 S DIE=130,DA=$P(^SRF(SRTN,"CON"),"^"),DR="35///@" D ^DIE,UNLOCK^SROUTL(DA)
27 S DA=SRTN D ^DIE
28 Q
Note: See TracBrowser for help on using the repository browser.