SRONEW ;B'HAM ISC/MAM - ENTER A NEW CASE ;01/29/01 1:09 PM
;;3.0; Surgery ;**3,23,26,30,47,58,48,67,107,100,144**;24 Jun 93
;
; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
;
DEAD S SRSOUT=0,X=$P($G(VADM(6)),"^") I X D I SRSOUT D ^SRSKILL G ^SROP
.S SRDEATH=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) W @IOF,!,?1,VADM(1)_" "_VA("PID")_" * Died "_SRDEATH_" *"
.W !!,$C(7) K DIR S DIR("A",1)=">>> The patient you have selected died on "_SRDEATH_"."
.S DIR("A")=" Are you sure this is the correct patient ? ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
.W @IOF I 'Y!$D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
.W !,"Entering a new surgical case for "_VADM(1)_".",!!
DATE K %DT W ! 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."
I Y<0 D CONT G:"Yy"'[SRYN END G DATE
G:Y'>0 END S SRSDATE=Y
S SRSC1=1 K SRCTN S SRSDPT=DFN,SRSCC="" D CON G:SRSCC="^" END
OP D ^SROPROC I SRSOUT G END
S SRPRIN=SRSOP
OPD ; Principal Preoperative Diagnosis
K DIR S DIR(0)="130,32",DIR("A")="Principal Preoperative Diagnosis" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G END
I Y=""!(X["^") W !!,"A Principal Preoperative Diagnosis must be entered",!,"when creating a new case. Enter '^' to exit.",! G OPD
I X[";" W !,"The Principal Preoperative Diagnosis cannot contain a semicolon (;).",!,"Please re-enter the Diagnosis, using commas in place of the semicolons." G OPD
S SRSOPD=Y
W !!,"The information entered into the Principal Preoperative Diagnosis field",!,"has been transferred into the Indications for Operation field.",!,"The Indications for Operation field can be updated later if necessary.",!
DOC W ! S DIC("A")="Select Surgeon: ",DIC=200,DIC(0)="QEAM",SRSDOC="" D ^DIC K DIC("A") I $D(DTOUT)!(X="^") S SRSOUT=1 G END
I Y<0!(X["^") W !!,"A Surgeon must be entered when creating a case. Enter '^' to exit.",! G DOC
S (DA,SRSDOC)=+Y
S RESTRICT="130,.14",Y=SRSDOC K SROK D KEY^SROXPR I '$D(SROK) W !!,"The person you selected does not have the appropriate keys necessary to be",!,"entered as a surgeon. Please make another selection.",! K SRSDOC,DA,DIC G DOC
CASE ; create case in SURGERY file
K DA,DIC,DD,DO,DINUM,SRTN S X=DFN,DIC="^SRF(",DIC(0)="L" D FILE^DICN K DIC S SRTN=+Y G:'$$LOCK^SROUTL(SRTN) DEL
S ^SRF(SRTN,8)=SRSITE("DIV"),^SRF(SRTN,"OP")=""
K DIE,DR S DA=SRTN,DIE=130,DR=".09////"_SRSDATE_";26////"_SRPRIN_";68////"_SRPRIN_";.14////"_SRSDOC D ^DIE K DR
ASURG ; attending surgeon
K DIR S DIR(0)="130,.164",DIR("A")="Attending Surgeon" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
I Y=""!(X["^") W !!,"An Attending Surgeon must be entered when creating a case. Enter '^' to exit.",! G ASURG
S SRATTND=+Y
SPEC W ! K DIC S DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select Surgical Specialty: ",DIC("S")="I '$P(^(0),""^"",3)" D ^DIC I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
I Y<0!(X["^") W !!,"To create a surgical case, a Surgical Specialty MUST be selected. Enter '^'",!,"to exit.",! G SPEC
S SRSS=+Y
UPDATE ; update case in SURGERY file
S DA=SRTN,DIE=130,DR=".04////"_SRSS_";.164////"_SRATTND_";32////"_SRSOPD D ^DIE K DR
S SRSOPD(1)=SRSOPD D WP^DIE(130,SRTN_",",55,"A","SRSOPD")
; Brief Clinical History
K DR S DR="60T",DA=SRTN,DIE=130 W ! D ^DIE
K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR
S ^SRF(SRTN,8)=SRSITE("DIV") D ^SROXRET
DIE 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,RT S ST="NEW SURGERY" D EN2^SROVAR
S SPD=$$CHKS^SRSCOR(SRTN)
K DR S DR="[SRSRES-ENTRY]",DIE=130,DA=SRTN D ^SRCUSS,RISK^SROAUTL3,^SROPCE1
I SPD'=$$CHKS^SRSCOR(SRTN) S ^TMP("CSLSUR1",$J)=""
I $D(SRCTN) D
.S SRCTN(.02)=$P(^SRF(SRCTN,0),"^",2),SRCTN(10)=$P($G(^SRF(SRCTN,31)),"^",4),SRCTN(11)=$P($G(^SRF(SRCTN,31)),"^",5)
.S DIE=130,DR=".02////"_SRCTN(.02)_";10////"_SRCTN(10)_";11////"_SRCTN(11)_";35////"_SRCTN,DA=SRTN D ^DIE
.S DR="35////"_SRTN,DA=SRCTN,DIE=130 D ^DIE
D UNLOCK^SROUTL(SRTN),^SROERR
Q
DEL S DA=SRTN,DIK="^SRF(" D ^DIK
END K SRTN D ^SRSKILL
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="SRONEW" D T0^%ZOSV
Q
CON ; check for concurrent case
S SRSCON=0,SRDT=SRSDATE-.0001 F S SRDT=$O(^SRF("AC",SRDT)) Q:'SRDT!($E(SRDT,1,7)'=SRSDATE)!(SRSCON) S (SRSCC,SRSCON)=0 F S SRSCC=$O(^SRF("AC",SRDT,SRSCC)) Q:'SRSCC D Q:SRSCON
.I ^(SRSCC)=SRSDPT,'$P($G(^SRF(SRSCC,"CON")),"^"),$P($G(^SRF(SRSCC,"NON")),"^")'="Y",'$P($G(^SRF(SRSCC,30)),"^"),'$P($G(^SRF(SRSCC,.2)),"^",12),'$P($G(^SRF(SRSCC,"LOCK")),"^") S SRSCON=1
.I SRSCON D CC^SRSREQ I '$D(SRCTN) S SRSCON=0
Q
SRONEW ;B'HAM ISC/MAM - ENTER A NEW CASE ;01/29/01 1:09 PM
+1 ;;3.0; Surgery ;**3,23,26,30,47,58,48,67,107,100,144**;24 Jun 93
+2 ;
+3 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
+4 ;
DEAD SET SRSOUT=0
SET X=$PIECE($GET(VADM(6)),"^")
IF X
Begin DoDot:1
+1 SET SRDEATH=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
WRITE @IOF,!,?1,VADM(1)_" "_VA("PID")_" * Died "_SRDEATH_" *"
+2 WRITE !!,$CHAR(7)
KILL DIR
SET DIR("A",1)=">>> The patient you have selected died on "_SRDEATH_"."
+3 SET DIR("A")=" Are you sure this is the correct patient ? "
SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
+4 WRITE @IOF
IF 'Y!$DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+5 WRITE !,"Entering a new surgical case for "_VADM(1)_".",!!
End DoDot:1
IF SRSOUT
DO ^SRSKILL
GOTO ^SROP
DATE KILL %DT
WRITE !
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."
+1 IF Y<0
DO CONT
IF "Yy"'[SRYN
GOTO END
GOTO DATE
+2 IF Y'>0
GOTO END
SET SRSDATE=Y
+3 SET SRSC1=1
KILL SRCTN
SET SRSDPT=DFN
SET SRSCC=""
DO CON
IF SRSCC="^"
GOTO END
OP DO ^SROPROC
IF SRSOUT
GOTO END
+1 SET SRPRIN=SRSOP
OPD ; Principal Preoperative Diagnosis
+1 KILL DIR
SET DIR(0)="130,32"
SET DIR("A")="Principal Preoperative Diagnosis"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO END
+2 IF Y=""!(X["^")
WRITE !!,"A Principal Preoperative Diagnosis must be entered",!,"when creating a new case. Enter '^' to exit.",!
GOTO OPD
+3 IF X[";"
WRITE !,"The Principal Preoperative Diagnosis cannot contain a semicolon (;).",!,"Please re-enter the Diagnosis, using commas in place of the semicolons."
GOTO OPD
+4 SET SRSOPD=Y
+5 WRITE !!,"The information entered into the Principal Preoperative Diagnosis field",!,"has been transferred into the Indications for Operation field.",!,"The Indications for Operation field can be updated later if necessary.",!
DOC WRITE !
SET DIC("A")="Select Surgeon: "
SET DIC=200
SET DIC(0)="QEAM"
SET SRSDOC=""
DO ^DIC
KILL DIC("A")
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO END
+1 IF Y<0!(X["^")
WRITE !!,"A Surgeon must be entered when creating a case. Enter '^' to exit.",!
GOTO DOC
+2 SET (DA,SRSDOC)=+Y
+3 SET RESTRICT="130,.14"
SET Y=SRSDOC
KILL SROK
DO KEY^SROXPR
IF '$DATA(SROK)
WRITE !!,"The person you selected does not have the appropriate keys necessary to be",!,"entered as a surgeon. Please make another selection.",!
KILL SRSDOC,DA,DIC
GOTO DOC
CASE ; create case in SURGERY file
+1 KILL DA,DIC,DD,DO,DINUM,SRTN
SET X=DFN
SET DIC="^SRF("
SET DIC(0)="L"
DO FILE^DICN
KILL DIC
SET SRTN=+Y
IF '$$LOCK^SROUTL(SRTN)
GOTO DEL
+2 SET ^SRF(SRTN,8)=SRSITE("DIV")
SET ^SRF(SRTN,"OP")=""
+3 KILL DIE,DR
SET DA=SRTN
SET DIE=130
SET DR=".09////"_SRSDATE_";26////"_SRPRIN_";68////"_SRPRIN_";.14////"_SRSDOC
DO ^DIE
KILL DR
ASURG ; attending surgeon
+1 KILL DIR
SET DIR(0)="130,.164"
SET DIR("A")="Attending Surgeon"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO DEL
+2 IF Y=""!(X["^")
WRITE !!,"An Attending Surgeon must be entered when creating a case. Enter '^' to exit.",!
GOTO ASURG
+3 SET SRATTND=+Y
SPEC WRITE !
KILL DIC
SET DIC=137.45
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Surgical Specialty: "
SET DIC("S")="I '$P(^(0),""^"",3)"
DO ^DIC
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO DEL
+1 IF Y<0!(X["^")
WRITE !!,"To create a surgical case, a Surgical Specialty MUST be selected. Enter '^'",!,"to exit.",!
GOTO SPEC
+2 SET SRSS=+Y
UPDATE ; update case in SURGERY file
+1 SET DA=SRTN
SET DIE=130
SET DR=".04////"_SRSS_";.164////"_SRATTND_";32////"_SRSOPD
DO ^DIE
KILL DR
+2 SET SRSOPD(1)=SRSOPD
DO WP^DIE(130,SRTN_",",55,"A","SRSOPD")
+3 ; Brief Clinical History
+4 KILL DR
SET DR="60T"
SET DA=SRTN
SET DIE=130
WRITE !
DO ^DIE
+5 KILL DR,DA
SET DR="[SRO-NOCOMP]"
SET DA=SRTN
SET DIE=130
DO ^DIE
KILL DR
+6 SET ^SRF(SRTN,8)=SRSITE("DIV")
DO ^SROXRET
DIE DO ^SROBLOD
KILL DR,DIE,DA
SET DR="38////"_BLOOD_";40////"_CROSSM
SET DA=SRTN
SET DIE=130
DO ^DIE
KILL DR,DA,DIE
+1 SET DR="[SRSRES1]"
SET DIE=130
SET DA=SRTN
DO ^DIE
DO RT
SET ST="NEW SURGERY"
DO EN2^SROVAR
+2 SET SPD=$$CHKS^SRSCOR(SRTN)
+3 KILL DR
SET DR="[SRSRES-ENTRY]"
SET DIE=130
SET DA=SRTN
DO ^SRCUSS
DO RISK^SROAUTL3
DO ^SROPCE1
+4 IF SPD'=$$CHKS^SRSCOR(SRTN)
SET ^TMP("CSLSUR1",$JOB)=""
+5 IF $DATA(SRCTN)
Begin DoDot:1
+6 SET SRCTN(.02)=$PIECE(^SRF(SRCTN,0),"^",2)
SET SRCTN(10)=$PIECE($GET(^SRF(SRCTN,31)),"^",4)
SET SRCTN(11)=$PIECE($GET(^SRF(SRCTN,31)),"^",5)
+7 SET DIE=130
SET DR=".02////"_SRCTN(.02)_";10////"_SRCTN(10)_";11////"_SRCTN(11)_";35////"_SRCTN
SET DA=SRTN
DO ^DIE
+8 SET DR="35////"_SRTN
SET DA=SRCTN
SET DIE=130
DO ^DIE
End DoDot:1
+9 DO UNLOCK^SROUTL(SRTN)
DO ^SROERR
+10 QUIT
DEL SET DA=SRTN
SET DIK="^SRF("
DO ^DIK
END KILL SRTN
DO ^SRSKILL
+1 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="SRONEW"
DO T0^%ZOSV
+2 QUIT
CON ; check for concurrent case
+1 SET SRSCON=0
SET SRDT=SRSDATE-.0001
FOR
SET SRDT=$ORDER(^SRF("AC",SRDT))
IF 'SRDT!($EXTRACT(SRDT,1,7)'=SRSDATE)!(SRSCON)
QUIT
SET (SRSCC,SRSCON)=0
FOR
SET SRSCC=$ORDER(^SRF("AC",SRDT,SRSCC))
IF 'SRSCC
QUIT
Begin DoDot:1
+2 IF ^(SRSCC)=SRSDPT
IF '$PIECE($GET(^SRF(SRSCC,"CON")),"^")
IF $PIECE($GET(^SRF(SRSCC,"NON")),"^")'="Y"
IF '$PIECE($GET(^SRF(SRSCC,30)),"^")
IF '$PIECE($GET(^SRF(SRSCC,.2)),"^",12)
IF '$PIECE($GET(^SRF(SRSCC,"LOCK")),"^")
SET SRSCON=1
+3 IF SRSCON
DO CC^SRSREQ
IF '$DATA(SRCTN)
SET SRSCON=0
End DoDot:1
IF SRSCON
QUIT
+4 QUIT
