SRSCHC1 ;B'HAM ISC/MAM - SCHEDULE CONCURRENT CASES ; [ 04/26/97 3:03 PM ]
;;3.0; Surgery ;**3,67**;24 Jun 93
W @IOF,!,"Enter information related to the "_$S(SRSCON=1:"first",1:"second")_" concurrent case.",!
OPER D ^SROPROC I SRSOUT Q
S SRSCON(SRSCON,"OP")=SRSOP
CPT W ! K SRSCPT,DIC S DIC=81,DIC(0)="QEAM",DIC("A")="Select the Principal Operation Code (CPT): " D ^DIC K DIC I Y>0 S SRSCPT=+Y I $P(^ICPT(+Y,0),"^",4) W !!,"This is an inactive code. Please make another selection.",! G CPT
SPEC W ! K DIC S DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select the Surgical Specialty: ",DIC("S")="I '$P(^(0),""^"",3)" D ^DIC I Y<0 D HELP I SRSOUT Q
S SRSS=+Y,SRSCON(SRSCON,"SS")=$P(Y(0),"^"),(SRSDOC,SRSCON(SRSCON,"DOC"))=""
DOC W ! K DIC S DIC=200,DIC(0)="QEAMZ",DIC("A")="Enter the Surgeon's Name: " D ^DIC I $D(DUOUT) S SRSOUT=1 Q
I Y<0 S SRSOUT=1 Q
S SRSDOC=+Y,SRSCON(SRSCON,"DOC")=$P(Y(0),"^")
K DA,DIC,DIE,DO,DD,DINUM,SRTN S X=SRSDFN,DIC="^SRF(",DIC(0)="L",DLAYGO=130 D FILE^DICN K DIC,DLAYGO S (SRTN,SRSCON(SRSCON))=+Y
K DIE,DR,DIC S DA=SRTN,DIE=130,DR=".09////"_SRSDATE_";.04////"_SRSS_";.14////"_SRSDOC D ^DIE K DR
S DIE=130,DA=SRTN,DR="26////"_SRSOP_";68////"_SRSOP D ^DIE K DR
K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR
IND W ! S DIE=130,DR="55T" D ^DIE I '$O(^SRF(SRTN,40,0)) D ^SRSIND S:'$D(SRTN) SRSOUT=1 Q:SRSOUT G IND
W ! K DR S DR="60T",DIE=130,DA=SRTN D ^DIE
W ! K DR,Y S DA=SRTN,DIE=130,DR=".42T",DR(2,130.16)=".01T;1T;3T" W !!,"Other Operative Procedures by the same Surgical Specialty: ",! D ^DIE K DR I $D(Y) S SRSAVG="",SRDUOUT=1 Q
I $D(SRSCPT) K DR S DR="27////"_SRSCPT,DIE=130,DA=SRTN D ^DIE K DR
S ^SRF(SRTN,8)=SRSITE("DIV") D ^SROXRET
I SRSCON=2 S DA=SRTN,DIE=130,DR="35////"_SRSCON(1) D ^DIE S DA=SRSCON(1),DIE=130,DR="35////"_SRSCON(2) D ^DIE K DR
D ^SROERR
Q
HELP ; surgical specialty help message
W !!,"The Surgical Specialty must be entered when scheduling a surgery case."
I SRSCON=1 W !,"If you do not know the surgical specialty, this entry cannot be completed."
I SRSCON=2 W !,"Without entering a specialty, this case cannot be scheduled."
SP W !!,"Do you want to re-enter a Surgical specialty for this procedure ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N"
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
I "YyNn"'[SRYN W !!,"Enter RETURN if you want to enter a specialty and continue entering information,",!,"or 'NO' to delete this case." G SP
I "Yy"'[SRYN S SRSOUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHC1 2464 printed Oct 16, 2024@18:47:48 Page 2
SRSCHC1 ;B'HAM ISC/MAM - SCHEDULE CONCURRENT CASES ; [ 04/26/97 3:03 PM ]
+1 ;;3.0; Surgery ;**3,67**;24 Jun 93
+2 WRITE @IOF,!,"Enter information related to the "_$SELECT(SRSCON=1:"first",1:"second")_" concurrent case.",!
OPER DO ^SROPROC
IF SRSOUT
QUIT
+1 SET SRSCON(SRSCON,"OP")=SRSOP
CPT WRITE !
KILL SRSCPT,DIC
SET DIC=81
SET DIC(0)="QEAM"
SET DIC("A")="Select the Principal Operation Code (CPT): "
DO ^DIC
KILL DIC
IF Y>0
SET SRSCPT=+Y
IF $PIECE(^ICPT(+Y,0),"^",4)
WRITE !!,"This is an inactive code. Please make another selection.",!
GOTO CPT
SPEC WRITE !
KILL DIC
SET DIC=137.45
SET DIC(0)="QEAMZ"
SET DIC("A")="Select the Surgical Specialty: "
SET DIC("S")="I '$P(^(0),""^"",3)"
DO ^DIC
IF Y<0
DO HELP
IF SRSOUT
QUIT
+1 SET SRSS=+Y
SET SRSCON(SRSCON,"SS")=$PIECE(Y(0),"^")
SET (SRSDOC,SRSCON(SRSCON,"DOC"))=""
DOC WRITE !
KILL DIC
SET DIC=200
SET DIC(0)="QEAMZ"
SET DIC("A")="Enter the Surgeon's Name: "
DO ^DIC
IF $DATA(DUOUT)
SET SRSOUT=1
QUIT
+1 IF Y<0
SET SRSOUT=1
QUIT
+2 SET SRSDOC=+Y
SET SRSCON(SRSCON,"DOC")=$PIECE(Y(0),"^")
+3 KILL DA,DIC,DIE,DO,DD,DINUM,SRTN
SET X=SRSDFN
SET DIC="^SRF("
SET DIC(0)="L"
SET DLAYGO=130
DO FILE^DICN
KILL DIC,DLAYGO
SET (SRTN,SRSCON(SRSCON))=+Y
+4 KILL DIE,DR,DIC
SET DA=SRTN
SET DIE=130
SET DR=".09////"_SRSDATE_";.04////"_SRSS_";.14////"_SRSDOC
DO ^DIE
KILL DR
+5 SET DIE=130
SET DA=SRTN
SET DR="26////"_SRSOP_";68////"_SRSOP
DO ^DIE
KILL DR
+6 KILL DR,DA
SET DR="[SRO-NOCOMP]"
SET DA=SRTN
SET DIE=130
DO ^DIE
KILL DR
IND WRITE !
SET DIE=130
SET DR="55T"
DO ^DIE
IF '$ORDER(^SRF(SRTN,40,0))
DO ^SRSIND
if '$DATA(SRTN)
SET SRSOUT=1
if SRSOUT
QUIT
GOTO IND
+1 WRITE !
KILL DR
SET DR="60T"
SET DIE=130
SET DA=SRTN
DO ^DIE
+2 WRITE !
KILL DR,Y
SET DA=SRTN
SET DIE=130
SET DR=".42T"
SET DR(2,130.16)=".01T;1T;3T"
WRITE !!,"Other Operative Procedures by the same Surgical Specialty: ",!
DO ^DIE
KILL DR
IF $DATA(Y)
SET SRSAVG=""
SET SRDUOUT=1
QUIT
+3 IF $DATA(SRSCPT)
KILL DR
SET DR="27////"_SRSCPT
SET DIE=130
SET DA=SRTN
DO ^DIE
KILL DR
+4 SET ^SRF(SRTN,8)=SRSITE("DIV")
DO ^SROXRET
+5 IF SRSCON=2
SET DA=SRTN
SET DIE=130
SET DR="35////"_SRSCON(1)
DO ^DIE
SET DA=SRSCON(1)
SET DIE=130
SET DR="35////"_SRSCON(2)
DO ^DIE
KILL DR
+6 DO ^SROERR
+7 QUIT
HELP ; surgical specialty help message
+1 WRITE !!,"The Surgical Specialty must be entered when scheduling a surgery case."
+2 IF SRSCON=1
WRITE !,"If you do not know the surgical specialty, this entry cannot be completed."
+3 IF SRSCON=2
WRITE !,"Without entering a specialty, this case cannot be scheduled."
SP WRITE !!,"Do you want to re-enter a Surgical specialty for this procedure ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRYN="N"
+1 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
+2 IF "YyNn"'[SRYN
WRITE !!,"Enter RETURN if you want to enter a specialty and continue entering information,",!,"or 'NO' to delete this case."
GOTO SP
+3 IF "Yy"'[SRYN
SET SRSOUT=1
+4 QUIT
