SRSDT.m

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**;24 Jun 93

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 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

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**;24 Jun 93

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

           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