- 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
