SROPER.m

SROPER ;B'HAM ISC/MAM - SELECT OPERATION ; [ 01/30/01  1:26 PM ]

 ;;3.0; Surgery ;**37,107,100**;24 Jun 93

 ;

 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498

 ;

NEW ; enter a new surgery

 S %DT("A")="Select the Date of Operation: ",%DT="AEX" D ^%DT I Y<0 W !!,"When entering a new surgery case, a date MUST be entered.  If you do not",!,"know the date of operation, enter this patient on the Waiting List." W !!!

 I Y<0 D CONT G:"Yy"'[SRYN END G NEW

 G:Y'>0 END S SRSDATE=Y

 S SRSC1=1 K SRCTN S SRSDPT=DFN,SRSCC="" D CONCUR^SRSREQ G:SRSCC="^" END

OPER D ^SROPROC I SRSOUT G END

 S SRPRIN=SRSOP K SRSOP

 G:Y'>0 END S SRSDATE=Y

 K DA,DIC,DO,DD,DINUM,SRTN S X=DFN,DIC="^SRF(",DIC(0)="L",DLAYGO=130 D FILE^DICN K DIC,DLAYGO S SRTN=+Y

 N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK Q

 K DIE,DR S DA=SRTN,DIE=130,DR=".09///"_SRSDATE_";26///"_SRPRIN_";68///"_SRPRIN D ^DIE K DR

 K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR

 S ^SRF(SRTN,8)=SRSITE("DIV") D ^SROXRET

 D ^SROBLOD K DR,DIE,DA S DR="38////"_BLOOD_";40////"_CROSSM,DA=SRTN,DIE=130 D ^DIE K DR,DA,DIE

 S DR="[SRSRES1]",DIE=130,DA=SRTN D ^DIE D RT S SPD=$$CHKS^SRSCOR(SRTN),ST="" D EN2^SROVAR K DR S DR="[SRSRES-ENTRY]",DIE=130,DA=SRTN D ^SRCUSS I SPD'=$$CHKS^SRSCOR(SRTN) S ^TMP("CSLSUR1",$J)=""

 I $D(SRCTN) S DIE=130,DR="35////"_SRCTN,DA=SRTN D ^DIE S SROERR=SRTN D ^SROERR0 S DR="35////"_SRTN,DA=SRCTN,DIE=130 D ^DIE S SROERR=SRCTN D ^SROERR0

 D UNLOCK^SROUTL(SRTN)

 Q

END D ^SRSKILL

 Q

SEL ; select case

 W !!!,"Select Operation, or enter RETURN to continue listing Procedures: " R X:DTIME W @IOF I '$T!(X["^") S SRSOUT=1 Q

 I X="" Q

 I '$D(SRCASE(X)) W !!,"Please enter the number corresponding to the Surgical Case you want to edit.",!,"If the case desired does not appear, enter RETURN to continue listing",!,"additional cases."

 I '$D(SRCASE(X)) W !!,"Press RETURN to continue  " R X:DTIME S:'$T SRSOUT=1 S SRBACK=1 Q

 S SRTN=+SRCASE(X)

 Q

CONT ; continue new entry ?

 W !!,"Do you want to continue  ?  YES//  " R SRYN:DTIME I '$T S SRYN="N" Q

 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I "YyNn"'[SRYN W !!,"Enter RETURN if you want to re-enter a date and continue creating a new",!,"case, or 'NO' to leave this option." G CONT

 Q

RT ; start RT logging

 I $D(XRTL) S XRTN="SROPER" D T0^%ZOSV

 Q

SROPER    ;B'HAM ISC/MAM - SELECT OPERATION ; [ 01/30/01  1:26 PM ]

 +1       ;;3.0; Surgery ;**37,107,100**;24 Jun 93

 +2       ;

 +3       ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498

 +4       ;

NEW       ; enter a new surgery

 +1        SET %DT("A")="Select the Date of Operation: "

           SET %DT="AEX"

           DO ^%DT

           IF Y<0

               WRITE !!,"When entering a new surgery case, a date MUST be entered.  If you do not",!,"know the date of operation, enter this patient on the Waiting List."

               WRITE !!!

 +2        IF Y<0

               DO CONT

               IF "Yy"'[SRYN

                   GOTO END

               GOTO NEW

 +3        IF Y'>0

               GOTO END

           SET SRSDATE=Y

 +4        SET SRSC1=1

           KILL SRCTN

           SET SRSDPT=DFN

           SET SRSCC=""

           DO CONCUR^SRSREQ

           IF SRSCC="^"

               GOTO END

OPER       DO ^SROPROC

           IF SRSOUT

               GOTO END

 +1        SET SRPRIN=SRSOP

           KILL SRSOP

 +2        IF Y'>0

               GOTO END

           SET SRSDATE=Y

 +3        KILL DA,DIC,DO,DD,DINUM,SRTN

           SET X=DFN

           SET DIC="^SRF("

           SET DIC(0)="L"

           SET DLAYGO=130

           DO FILE^DICN

           KILL DIC,DLAYGO

           SET SRTN=+Y

 +4        NEW SRLCK

           SET SRLCK=$$LOCK^SROUTL(SRTN)

           IF 'SRLCK

               QUIT 

 +5        KILL DIE,DR

           SET DA=SRTN

           SET DIE=130

           SET DR=".09///"_SRSDATE_";26///"_SRPRIN_";68///"_SRPRIN

           DO ^DIE

           KILL DR

 +6        KILL DR,DA

           SET DR="[SRO-NOCOMP]"

           SET DA=SRTN

           SET DIE=130

           DO ^DIE

           KILL DR

 +7        SET ^SRF(SRTN,8)=SRSITE("DIV")

           DO ^SROXRET

 +8        DO ^SROBLOD

           KILL DR,DIE,DA

           SET DR="38////"_BLOOD_";40////"_CROSSM

           SET DA=SRTN

           SET DIE=130

           DO ^DIE

           KILL DR,DA,DIE

 +9        SET DR="[SRSRES1]"

           SET DIE=130

           SET DA=SRTN

           DO ^DIE

           DO RT

           SET SPD=$$CHKS^SRSCOR(SRTN)

           SET ST=""

           DO EN2^SROVAR

           KILL DR

           SET DR="[SRSRES-ENTRY]"

           SET DIE=130

           SET DA=SRTN

           DO ^SRCUSS

           IF SPD'=$$CHKS^SRSCOR(SRTN)

               SET ^TMP("CSLSUR1",$JOB)=""

 +10       IF $DATA(SRCTN)

               SET DIE=130

               SET DR="35////"_SRCTN

               SET DA=SRTN

               DO ^DIE

               SET SROERR=SRTN

               DO ^SROERR0

               SET DR="35////"_SRTN

               SET DA=SRCTN

               SET DIE=130

               DO ^DIE

               SET SROERR=SRCTN

               DO ^SROERR0

 +11       DO UNLOCK^SROUTL(SRTN)

 +12       QUIT 

END        DO ^SRSKILL

 +1        QUIT 

SEL       ; select case

 +1        WRITE !!!,"Select Operation, or enter RETURN to continue listing Procedures: "

           READ X:DTIME

           WRITE @IOF

           IF '$TEST!(X["^")

               SET SRSOUT=1

               QUIT 

 +2        IF X=""

               QUIT 

 +3        IF '$DATA(SRCASE(X))

               WRITE !!,"Please enter the number corresponding to the Surgical Case you want to edit.",!,"If the case desired does not appear, enter RETURN to continue listing",!,"additional cases."

 +4        IF '$DATA(SRCASE(X))

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

               IF '$TEST

                   SET SRSOUT=1

               SET SRBACK=1

               QUIT 

 +5        SET SRTN=+SRCASE(X)

 +6        QUIT 

CONT      ; continue new entry ?

 +1        WRITE !!,"Do you want to continue  ?  YES//  "

           READ SRYN:DTIME

           IF '$TEST

               SET SRYN="N"

               QUIT 

 +2        SET SRYN=$EXTRACT(SRYN)

           IF SRYN=""

               SET SRYN="Y"

           IF "YyNn"'[SRYN

               WRITE !!,"Enter RETURN if you want to re-enter a date and continue creating a new",!,"case, or 'NO' to leave this option."

               GOTO CONT

 +3        QUIT 

RT        ; start RT logging

 +1        IF $DATA(XRTL)

               SET XRTN="SROPER"

               DO T0^%ZOSV

 +2        QUIT