SRSRQST ;BIR/MAM,ADM - MAKE OPERATION REQUESTS ;11/01/01 9:40 AM
;;3.0;Surgery;**3,58,67,88,103,105,100,144,175,177,182,184**;24 Jun 93;Build 35
MUST S SRLINE="" F I=1:1:80 S SRLINE=SRLINE_"="
W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?20,"OPERATION REQUEST: REQUIRED INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
SURG ; surgeon
K DIR S DIR(0)="130,.14",DIR("A")="Primary Surgeon" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G END
I Y=""!(X["^") W !!,"To make an operation request, a Surgeon MUST be selected. Enter '^' to exit.",! G SURG
S SRSDOC=+Y
CASE K DA,DIC,DD,DO,DINUM,SRTN S X=SRSDPT,DIC="^SRF(",DIC(0)="L",DLAYGO=130 D FILE^DICN K DD,DO,DIC,DLAYGO S SRTN=+Y
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN)
S ^SRF(SRTN,8)=SRSITE("DIV"),^SRF(SRTN,"OP")=""
D NOW^%DTC S SREQDAY=+$E(%,1,12),SRNOCON=1 K DR,DIE
S DA=SRTN,DIE=130,DR="36////1;Q;.09////"_SRSDATE_";.14////"_SRSDOC_";1.098////"_+SREQDAY_";1.099////"_DUZ_";Q"_";612////"_SRSDATE_";616////"_SRSDATE_";613////"_SREQDAY 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 !!,"To make an operation request, Attending Surgeon MUST be selected. Enter '^' to exit.",! G ASURG
S SRATTND=+Y
SPEC ; surgical specialty
I SRWL W !,"Surgical Specialty: "_$P(^SRO(137.45,SRSS,0),"^") G OP
K DIR S DIR(0)="130,.04",DIR("A")="Surgical Specialty" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
I Y=""!(X["^") W !!,"To make an operation request, a Surgical Specialty MUST be selected. Enter '^'",!,"to exit.",! G SPEC
S SRSS=+Y
OP ; principal operative procedure
I SRWL W !,"Principal Operative Procedure: "_SRSOP G OPD
K DIR S DIR(0)="130,26",DIR("A")="Principal Operative Procedure" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
I X["^" W !!,"Principal procedure must not contain an up-arrow (^).",! G OP
S SRSOP=Y
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 DEL
I Y=""!(X["^") W !,"Principal Preoperative Diagnosis MUST be entered",!,"before proceeding with this request. 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.",!
W !!,"Press RETURN to continue " R X:DTIME
;
LP ; LATERALITY OF PROCEDURE
K DIR W ! S DIR(0)="130,638",DIR("A")="Laterality Of Procedure" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
I Y=""!(X["^") W !!,"To make an operation request, Laterality Of Procedure MUST be entered. Enter '^' to exit.",! G LP
S SRLP=Y
PAS ; Planned Admission Status
K DIR S DIR(0)="130,.013",DIR("A")="Planned Admission Status" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
I Y=""!(X["^") W !!,"To make an operation request, Planned Admission Status field MUST be entered. Enter '^' to exit.",! G PAS
S SRPAS=Y
PCPT ; Planned Principal Procedure Code (CPT)
K DIR S DIR(0)="130,27",DIR("A")="Planned Principal Procedure Code" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
I Y=""!(X["^") W !!,"To make an operation request, Planned Principal Procedure Code field MUST be entered. Enter '^' to exit.",! G PCPT
S SRCPT=$P(Y,"^")
;
UPDATE S DA=SRTN,DIE=130,DR="26////"_SRSOP_";68////"_SRSOP_";.04////"_SRSS_";.164////"_SRATTND_";32////"_SRSOPD_";638////"_SRLP_";.013////"_SRPAS_";.011////"_SRPAS_";27////"_SRCPT D ^DIE
I SRWL K DA,DIE,DR S DA=SRTN,DIE=130,DR=".016////"_SRCL(16)_";.017////"_SRCL(17)_";.018////"_SRCL(18)_";.019////"_SRCL(19)_";.0155////"_SRCL(20)_";.022////"_SRCL(21)_";.023////"_SRCL(22) D ^DIE
D SPIN
K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR
S ^SRF(SRTN,8)=SRSITE("DIV") D ^SROXRET K SRNOCON
OTHER ; other required fields
S SRFLD=0 F S SRFLD=$O(^SRO(133,SRSITE,4,SRFLD)) Q:'SRFLD!(SRSOUT) D OTHDIR Q:SRSOUT
I SRSOUT G DEL
S SRSOPD(1)=SRSOPD D WP^DIE(130,SRTN_",",55,"A","SRSOPD")
I $D(SRCC),SRSCON=2 S DIE=130,DR="35////"_SRSCON(1),DA=SRTN D ^DIE K DR S DR="35////"_SRTN,DA=SRSCON(1),DIE=130 D ^DIE K DR,DA
D ^SROERR I $D(SRDUOUT) S SRSOUT=1 Q
I '$D(SRCC) D ^SRSRQST1
D:$G(SRLCK) UNLOCK^SROUTL(SRTN)
Q
DEL I SRSOUT S DA=SRTN,DIK="^SRF(" D ^DIK
END D:$G(SRLCK) UNLOCK^SROUTL(SRTN)
I SRSOUT W !!,"No request has been entered.",! S:'$D(SRCC) SRSOUT=0
Q
CON ; request concurrent case
D MUST Q:SRSOUT S SRSCON(SRSCON,"DOC")=$P(^VA(200,SRSDOC,0),"^"),SRSCON(SRSCON,"SS")=$P(^SRO(137.45,SRSS,0),"^"),SRSCON(SRSCON,"OP")=SRSOP,SRSCON(SRSCON)=SRTN K DA
Q
OTHDIR ; call to reader for site specific required fields
;JAS - 08/05/14 - SR*3*177 - Modified this section for ICD-10
K DIR,SREQ,SRY S FLD=$P(^SRO(133,SRSITE,4,SRFLD,0),"^") D FIELD^DID(130,FLD,"","TITLE","SRY") S DIR(0)="130,"_FLD,DIR("A")=SRY("TITLE") D DIRYN I $D(DTOUT)!($G(X)="^") S SRSOUT=1 Q
I "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^") I $G(X)="@"!($G(X)="") S X="^"
I $G(Y)=""!(X["^") W !!,"It is mandatory that you provide this information before proceeding with this",!,"request.",! D ASK Q:SRSOUT G OTHDIR
S SREQ(130,SRTN_",",FLD)=$P(Y,"^") D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
Q
DIRYN ; call ^DIR if not FILE 80 or ICD-9 FILE 80 (added for SR*3.0*177)
I "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^") D Q
. S SRPRMT=DIR("A")_" ",SRDEF=$$GET1^DIQ(130,SRTN,FLD)
. D ICDSRCH^SROICD
D ^DIR
Q
ASK K DIR S DIR(0)="Y",DIR("A")="Do you want to continue with this request ",DIR("B")="YES"
S DIR("?")="Enter RETURN to continue with this request, or 'NO' to discontinue this request." D ^DIR S:'Y SRSOUT=1
Q
SPIN ; spinal level free-text
I '$$SPIN^SRTOVRF(SRCPT) Q
N SL
K DIR S DIR(0)="130,136",DIR("A")="Spinal Level Comment" D ^DIR K DIR
S SL=$P(Y,"^") I Y=""!$D(DTOUT)!$D(DUOUT) S SL=""
S $P(^SRF(SRTN,1.1),"^",4)=SL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSRQST 6193 printed Apr 09, 2024@21:46:27 Page 2
SRSRQST ;BIR/MAM,ADM - MAKE OPERATION REQUESTS ;11/01/01 9:40 AM
+1 ;;3.0;Surgery;**3,58,67,88,103,105,100,144,175,177,182,184**;24 Jun 93;Build 35
MUST SET SRLINE=""
FOR I=1:1:80
SET SRLINE=SRLINE_"="
+1 WRITE @IOF
if $DATA(SRCC)
WRITE !,?29,$SELECT(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE"
WRITE !,?20,"OPERATION REQUEST: REQUIRED INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
SURG ; surgeon
+1 KILL DIR
SET DIR(0)="130,.14"
SET DIR("A")="Primary Surgeon"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO END
+2 IF Y=""!(X["^")
WRITE !!,"To make an operation request, a Surgeon MUST be selected. Enter '^' to exit.",!
GOTO SURG
+3 SET SRSDOC=+Y
CASE KILL DA,DIC,DD,DO,DINUM,SRTN
SET X=SRSDPT
SET DIC="^SRF("
SET DIC(0)="L"
SET DLAYGO=130
DO FILE^DICN
KILL DD,DO,DIC,DLAYGO
SET SRTN=+Y
+1 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
+2 SET ^SRF(SRTN,8)=SRSITE("DIV")
SET ^SRF(SRTN,"OP")=""
+3 DO NOW^%DTC
SET SREQDAY=+$EXTRACT(%,1,12)
SET SRNOCON=1
KILL DR,DIE
+4 SET DA=SRTN
SET DIE=130
SET DR="36////1;Q;.09////"_SRSDATE_";.14////"_SRSDOC_";1.098////"_+SREQDAY_";1.099////"_DUZ_";Q"_";612////"_SRSDATE_";616////"_SRSDATE_";613////"_SREQDAY
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 !!,"To make an operation request, Attending Surgeon MUST be selected. Enter '^' to exit.",!
GOTO ASURG
+3 SET SRATTND=+Y
SPEC ; surgical specialty
+1 IF SRWL
WRITE !,"Surgical Specialty: "_$PIECE(^SRO(137.45,SRSS,0),"^")
GOTO OP
+2 KILL DIR
SET DIR(0)="130,.04"
SET DIR("A")="Surgical Specialty"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO DEL
+3 IF Y=""!(X["^")
WRITE !!,"To make an operation request, a Surgical Specialty MUST be selected. Enter '^'",!,"to exit.",!
GOTO SPEC
+4 SET SRSS=+Y
OP ; principal operative procedure
+1 IF SRWL
WRITE !,"Principal Operative Procedure: "_SRSOP
GOTO OPD
+2 KILL DIR
SET DIR(0)="130,26"
SET DIR("A")="Principal Operative Procedure"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO DEL
+3 IF X["^"
WRITE !!,"Principal procedure must not contain an up-arrow (^).",!
GOTO OP
+4 SET SRSOP=Y
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 DEL
+2 IF Y=""!(X["^")
WRITE !,"Principal Preoperative Diagnosis MUST be entered",!,"before proceeding with this request. 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.",!
+6 WRITE !!,"Press RETURN to continue "
READ X:DTIME
+7 ;
LP ; LATERALITY OF PROCEDURE
+1 KILL DIR
WRITE !
SET DIR(0)="130,638"
SET DIR("A")="Laterality Of Procedure"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO DEL
+2 IF Y=""!(X["^")
WRITE !!,"To make an operation request, Laterality Of Procedure MUST be entered. Enter '^' to exit.",!
GOTO LP
+3 SET SRLP=Y
PAS ; Planned Admission Status
+1 KILL DIR
SET DIR(0)="130,.013"
SET DIR("A")="Planned Admission Status"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO DEL
+2 IF Y=""!(X["^")
WRITE !!,"To make an operation request, Planned Admission Status field MUST be entered. Enter '^' to exit.",!
GOTO PAS
+3 SET SRPAS=Y
PCPT ; Planned Principal Procedure Code (CPT)
+1 KILL DIR
SET DIR(0)="130,27"
SET DIR("A")="Planned Principal Procedure Code"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(X="^")
SET SRSOUT=1
GOTO DEL
+2 IF Y=""!(X["^")
WRITE !!,"To make an operation request, Planned Principal Procedure Code field MUST be entered. Enter '^' to exit.",!
GOTO PCPT
+3 SET SRCPT=$PIECE(Y,"^")
+4 ;
UPDATE SET DA=SRTN
SET DIE=130
SET DR="26////"_SRSOP_";68////"_SRSOP_";.04////"_SRSS_";.164////"_SRATTND_";32////"_SRSOPD_";638////"_SRLP_";.013////"_SRPAS_";.011////"_SRPAS_";27////"_SRCPT
DO ^DIE
+1 IF SRWL
KILL DA,DIE,DR
SET DA=SRTN
SET DIE=130
SET DR=".016////"_SRCL(16)_";.017////"_SRCL(17)_";.018////"_SRCL(18)_";.019////"_SRCL(19)_";.0155////"_SRCL(20)_";.022////"_SRCL(21)_";.023////"_SRCL(22)
DO ^DIE
+2 DO SPIN
+3 KILL DR,DA
SET DR="[SRO-NOCOMP]"
SET DA=SRTN
SET DIE=130
DO ^DIE
KILL DR
+4 SET ^SRF(SRTN,8)=SRSITE("DIV")
DO ^SROXRET
KILL SRNOCON
OTHER ; other required fields
+1 SET SRFLD=0
FOR
SET SRFLD=$ORDER(^SRO(133,SRSITE,4,SRFLD))
if 'SRFLD!(SRSOUT)
QUIT
DO OTHDIR
if SRSOUT
QUIT
+2 IF SRSOUT
GOTO DEL
+3 SET SRSOPD(1)=SRSOPD
DO WP^DIE(130,SRTN_",",55,"A","SRSOPD")
+4 IF $DATA(SRCC)
IF SRSCON=2
SET DIE=130
SET DR="35////"_SRSCON(1)
SET DA=SRTN
DO ^DIE
KILL DR
SET DR="35////"_SRTN
SET DA=SRSCON(1)
SET DIE=130
DO ^DIE
KILL DR,DA
+5 DO ^SROERR
IF $DATA(SRDUOUT)
SET SRSOUT=1
QUIT
+6 IF '$DATA(SRCC)
DO ^SRSRQST1
+7 if $GET(SRLCK)
DO UNLOCK^SROUTL(SRTN)
+8 QUIT
DEL IF SRSOUT
SET DA=SRTN
SET DIK="^SRF("
DO ^DIK
END if $GET(SRLCK)
DO UNLOCK^SROUTL(SRTN)
+1 IF SRSOUT
WRITE !!,"No request has been entered.",!
if '$DATA(SRCC)
SET SRSOUT=0
+2 QUIT
CON ; request concurrent case
+1 DO MUST
if SRSOUT
QUIT
SET SRSCON(SRSCON,"DOC")=$PIECE(^VA(200,SRSDOC,0),"^")
SET SRSCON(SRSCON,"SS")=$PIECE(^SRO(137.45,SRSS,0),"^")
SET SRSCON(SRSCON,"OP")=SRSOP
SET SRSCON(SRSCON)=SRTN
KILL DA
+2 QUIT
OTHDIR ; call to reader for site specific required fields
+1 ;JAS - 08/05/14 - SR*3*177 - Modified this section for ICD-10
+2 KILL DIR,SREQ,SRY
SET FLD=$PIECE(^SRO(133,SRSITE,4,SRFLD,0),"^")
DO FIELD^DID(130,FLD,"","TITLE","SRY")
SET DIR(0)="130,"_FLD
SET DIR("A")=SRY("TITLE")
DO DIRYN
IF $DATA(DTOUT)!($GET(X)="^")
SET SRSOUT=1
QUIT
+3 IF "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^")
IF $GET(X)="@"!($GET(X)="")
SET X="^"
+4 IF $GET(Y)=""!(X["^")
WRITE !!,"It is mandatory that you provide this information before proceeding with this",!,"request.",!
DO ASK
if SRSOUT
QUIT
GOTO OTHDIR
+5 SET SREQ(130,SRTN_",",FLD)=$PIECE(Y,"^")
DO FILE^DIE("","SREQ","^TMP(""SR"",$J)")
+6 QUIT
DIRYN ; call ^DIR if not FILE 80 or ICD-9 FILE 80 (added for SR*3.0*177)
+1 IF "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^")
Begin DoDot:1
+2 SET SRPRMT=DIR("A")_" "
SET SRDEF=$$GET1^DIQ(130,SRTN,FLD)
+3 DO ICDSRCH^SROICD
End DoDot:1
QUIT
+4 DO ^DIR
+5 QUIT
ASK KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue with this request "
SET DIR("B")="YES"
+1 SET DIR("?")="Enter RETURN to continue with this request, or 'NO' to discontinue this request."
DO ^DIR
if 'Y
SET SRSOUT=1
+2 QUIT
SPIN ; spinal level free-text
+1 IF '$$SPIN^SRTOVRF(SRCPT)
QUIT
+2 NEW SL
+3 KILL DIR
SET DIR(0)="130,136"
SET DIR("A")="Spinal Level Comment"
DO ^DIR
KILL DIR
+4 SET SL=$PIECE(Y,"^")
IF Y=""!$DATA(DTOUT)!$DATA(DUOUT)
SET SL=""
+5 SET $PIECE(^SRF(SRTN,1.1),"^",4)=SL
+6 QUIT
