SROPER ;B'HAM ISC/MAM - SELECT OPERATION ; [ 01/30/01 1:26 PM ]
;;3.0;Surgery;**37,107,100,177,184**;24 Jun 93;Build 35
;
; 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,DO 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
K SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN) ;AAS need SRICDV defined for next call
S DR="[SRSRES1]",DIE=130,DA=SRTN D ^DIE D RT S SPD=$$CHKS^SRSCOR(SRTN),ST="" D EN2^SROVAR K DR S DR=$S($$SPIN^SRTOVRF():"[SRSRES-ENTRY1]",1:"[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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPER 2445 printed Dec 13, 2024@02:45:02 Page 2
SROPER ;B'HAM ISC/MAM - SELECT OPERATION ; [ 01/30/01 1:26 PM ]
+1 ;;3.0;Surgery;**37,107,100,177,184**;24 Jun 93;Build 35
+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,DO
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 ;AAS need SRICDV defined for next call
KILL SRICDV
SET SRICDV=$$ICDSTR^SROICD(SRTN)
+10 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=$SELECT($$SPIN^SRTOVRF():"[SRSRES-ENTRY1]",1:"[SRSRES-ENTRY]")
SET DIE=130
SET DA=SRTN
DO ^SRCUSS
IF SPD'=$$CHKS^SRSCOR(SRTN)
SET ^TMP("CSLSUR1",$JOB)=""
+11 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
+12 DO UNLOCK^SROUTL(SRTN)
+13 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
