Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SRSRQST

SRSRQST.m

Go to the documentation of this file.
  1. 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
  1. MUST S SRLINE="" F I=1:1:80 S SRLINE=SRLINE_"="
  1. 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,!
  1. SURG ; surgeon
  1. K DIR S DIR(0)="130,.14",DIR("A")="Primary Surgeon" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G END
  1. I Y=""!(X["^") W !!,"To make an operation request, a Surgeon MUST be selected. Enter '^' to exit.",! G SURG
  1. S SRSDOC=+Y
  1. 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
  1. N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN)
  1. S ^SRF(SRTN,8)=SRSITE("DIV"),^SRF(SRTN,"OP")=""
  1. D NOW^%DTC S SREQDAY=+$E(%,1,12),SRNOCON=1 K DR,DIE
  1. 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
  1. ASURG ; attending surgeon
  1. K DIR S DIR(0)="130,.164",DIR("A")="Attending Surgeon" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
  1. I Y=""!(X["^") W !!,"To make an operation request, Attending Surgeon MUST be selected. Enter '^' to exit.",! G ASURG
  1. S SRATTND=+Y
  1. SPEC ; surgical specialty
  1. I SRWL W !,"Surgical Specialty: "_$P(^SRO(137.45,SRSS,0),"^") G OP
  1. K DIR S DIR(0)="130,.04",DIR("A")="Surgical Specialty" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
  1. I Y=""!(X["^") W !!,"To make an operation request, a Surgical Specialty MUST be selected. Enter '^'",!,"to exit.",! G SPEC
  1. S SRSS=+Y
  1. OP ; principal operative procedure
  1. I SRWL W !,"Principal Operative Procedure: "_SRSOP G OPD
  1. 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
  1. I X["^" W !!,"Principal procedure must not contain an up-arrow (^).",! G OP
  1. S SRSOP=Y
  1. OPD ; Principal Preoperative Diagnosis
  1. 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
  1. I Y=""!(X["^") W !,"Principal Preoperative Diagnosis MUST be entered",!,"before proceeding with this request. Enter '^' to exit.",! G OPD
  1. 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
  1. S SRSOPD=Y
  1. 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.",!
  1. W !!,"Press RETURN to continue " R X:DTIME
  1. ;
  1. LP ; LATERALITY OF PROCEDURE
  1. 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
  1. I Y=""!(X["^") W !!,"To make an operation request, Laterality Of Procedure MUST be entered. Enter '^' to exit.",! G LP
  1. S SRLP=Y
  1. PAS ; Planned Admission Status
  1. 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
  1. I Y=""!(X["^") W !!,"To make an operation request, Planned Admission Status field MUST be entered. Enter '^' to exit.",! G PAS
  1. S SRPAS=Y
  1. PCPT ; Planned Principal Procedure Code (CPT)
  1. 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
  1. I Y=""!(X["^") W !!,"To make an operation request, Planned Principal Procedure Code field MUST be entered. Enter '^' to exit.",! G PCPT
  1. S SRCPT=$P(Y,"^")
  1. ;
  1. 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
  1. 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
  1. D SPIN
  1. K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR
  1. S ^SRF(SRTN,8)=SRSITE("DIV") D ^SROXRET K SRNOCON
  1. OTHER ; other required fields
  1. S SRFLD=0 F S SRFLD=$O(^SRO(133,SRSITE,4,SRFLD)) Q:'SRFLD!(SRSOUT) D OTHDIR Q:SRSOUT
  1. I SRSOUT G DEL
  1. S SRSOPD(1)=SRSOPD D WP^DIE(130,SRTN_",",55,"A","SRSOPD")
  1. 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
  1. D ^SROERR I $D(SRDUOUT) S SRSOUT=1 Q
  1. I '$D(SRCC) D ^SRSRQST1
  1. D:$G(SRLCK) UNLOCK^SROUTL(SRTN)
  1. Q
  1. DEL I SRSOUT S DA=SRTN,DIK="^SRF(" D ^DIK
  1. END D:$G(SRLCK) UNLOCK^SROUTL(SRTN)
  1. I SRSOUT W !!,"No request has been entered.",! S:'$D(SRCC) SRSOUT=0
  1. Q
  1. CON ; request concurrent case
  1. 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
  1. Q
  1. OTHDIR ; call to reader for site specific required fields
  1. ;JAS - 08/05/14 - SR*3*177 - Modified this section for ICD-10
  1. 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
  1. I "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^") I $G(X)="@"!($G(X)="") S X="^"
  1. I $G(Y)=""!(X["^") W !!,"It is mandatory that you provide this information before proceeding with this",!,"request.",! D ASK Q:SRSOUT G OTHDIR
  1. S SREQ(130,SRTN_",",FLD)=$P(Y,"^") D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
  1. Q
  1. DIRYN ; call ^DIR if not FILE 80 or ICD-9 FILE 80 (added for SR*3.0*177)
  1. I "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^") D Q
  1. . S SRPRMT=DIR("A")_" ",SRDEF=$$GET1^DIQ(130,SRTN,FLD)
  1. . D ICDSRCH^SROICD
  1. D ^DIR
  1. Q
  1. ASK K DIR S DIR(0)="Y",DIR("A")="Do you want to continue with this request ",DIR("B")="YES"
  1. S DIR("?")="Enter RETURN to continue with this request, or 'NO' to discontinue this request." D ^DIR S:'Y SRSOUT=1
  1. Q
  1. SPIN ; spinal level free-text
  1. I '$$SPIN^SRTOVRF(SRCPT) Q
  1. N SL
  1. K DIR S DIR(0)="130,136",DIR("A")="Spinal Level Comment" D ^DIR K DIR
  1. S SL=$P(Y,"^") I Y=""!$D(DTOUT)!$D(DUOUT) S SL=""
  1. S $P(^SRF(SRTN,1.1),"^",4)=SL
  1. Q