| [613] | 1 | SRONEW ;B'HAM ISC/MAM - ENTER A NEW CASE ;01/29/01 1:09 PM
|
|---|
| 2 | ;;3.0; Surgery ;**3,23,26,30,47,58,48,67,107,100,144**;24 Jun 93
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
|
|---|
| 5 | ;
|
|---|
| 6 | DEAD S SRSOUT=0,X=$P($G(VADM(6)),"^") I X D I SRSOUT D ^SRSKILL G ^SROP
|
|---|
| 7 | .S SRDEATH=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) W @IOF,!,?1,VADM(1)_" "_VA("PID")_" * Died "_SRDEATH_" *"
|
|---|
| 8 | .W !!,$C(7) K DIR S DIR("A",1)=">>> The patient you have selected died on "_SRDEATH_"."
|
|---|
| 9 | .S DIR("A")=" Are you sure this is the correct patient ? ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
|
|---|
| 10 | .W @IOF I 'Y!$D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
|
|---|
| 11 | .W !,"Entering a new surgical case for "_VADM(1)_".",!!
|
|---|
| 12 | 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."
|
|---|
| 13 | I Y<0 D CONT G:"Yy"'[SRYN END G DATE
|
|---|
| 14 | G:Y'>0 END S SRSDATE=Y
|
|---|
| 15 | S SRSC1=1 K SRCTN S SRSDPT=DFN,SRSCC="" D CON G:SRSCC="^" END
|
|---|
| 16 | OP D ^SROPROC I SRSOUT G END
|
|---|
| 17 | S SRPRIN=SRSOP
|
|---|
| 18 | OPD ; Principal Preoperative Diagnosis
|
|---|
| 19 | 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
|
|---|
| 20 | I Y=""!(X["^") W !!,"A Principal Preoperative Diagnosis must be entered",!,"when creating a new case. Enter '^' to exit.",! G OPD
|
|---|
| 21 | 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
|
|---|
| 22 | S SRSOPD=Y
|
|---|
| 23 | 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.",!
|
|---|
| 24 | 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
|
|---|
| 25 | I Y<0!(X["^") W !!,"A Surgeon must be entered when creating a case. Enter '^' to exit.",! G DOC
|
|---|
| 26 | S (DA,SRSDOC)=+Y
|
|---|
| 27 | 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
|
|---|
| 28 | CASE ; create case in SURGERY file
|
|---|
| 29 | 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
|
|---|
| 30 | S ^SRF(SRTN,8)=SRSITE("DIV"),^SRF(SRTN,"OP")=""
|
|---|
| 31 | K DIE,DR S DA=SRTN,DIE=130,DR=".09////"_SRSDATE_";26////"_SRPRIN_";68////"_SRPRIN_";.14////"_SRSDOC D ^DIE K DR
|
|---|
| 32 | ASURG ; attending surgeon
|
|---|
| 33 | K DIR S DIR(0)="130,.164",DIR("A")="Attending Surgeon" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
|
|---|
| 34 | I Y=""!(X["^") W !!,"An Attending Surgeon must be entered when creating a case. Enter '^' to exit.",! G ASURG
|
|---|
| 35 | S SRATTND=+Y
|
|---|
| 36 | 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
|
|---|
| 37 | I Y<0!(X["^") W !!,"To create a surgical case, a Surgical Specialty MUST be selected. Enter '^'",!,"to exit.",! G SPEC
|
|---|
| 38 | S SRSS=+Y
|
|---|
| 39 | UPDATE ; update case in SURGERY file
|
|---|
| 40 | S DA=SRTN,DIE=130,DR=".04////"_SRSS_";.164////"_SRATTND_";32////"_SRSOPD D ^DIE K DR
|
|---|
| 41 | S SRSOPD(1)=SRSOPD D WP^DIE(130,SRTN_",",55,"A","SRSOPD")
|
|---|
| 42 | ; Brief Clinical History
|
|---|
| 43 | K DR S DR="60T",DA=SRTN,DIE=130 W ! D ^DIE
|
|---|
| 44 | K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR
|
|---|
| 45 | S ^SRF(SRTN,8)=SRSITE("DIV") D ^SROXRET
|
|---|
| 46 | DIE D ^SROBLOD K DR,DIE,DA S DR="38////"_BLOOD_";40////"_CROSSM,DA=SRTN,DIE=130 D ^DIE K DR,DA,DIE
|
|---|
| 47 | S DR="[SRSRES1]",DIE=130,DA=SRTN D ^DIE,RT S ST="NEW SURGERY" D EN2^SROVAR
|
|---|
| 48 | S SPD=$$CHKS^SRSCOR(SRTN)
|
|---|
| 49 | K DR S DR="[SRSRES-ENTRY]",DIE=130,DA=SRTN D ^SRCUSS,RISK^SROAUTL3,^SROPCE1
|
|---|
| 50 | I SPD'=$$CHKS^SRSCOR(SRTN) S ^TMP("CSLSUR1",$J)=""
|
|---|
| 51 | I $D(SRCTN) D
|
|---|
| 52 | .S SRCTN(.02)=$P(^SRF(SRCTN,0),"^",2),SRCTN(10)=$P($G(^SRF(SRCTN,31)),"^",4),SRCTN(11)=$P($G(^SRF(SRCTN,31)),"^",5)
|
|---|
| 53 | .S DIE=130,DR=".02////"_SRCTN(.02)_";10////"_SRCTN(10)_";11////"_SRCTN(11)_";35////"_SRCTN,DA=SRTN D ^DIE
|
|---|
| 54 | .S DR="35////"_SRTN,DA=SRCTN,DIE=130 D ^DIE
|
|---|
| 55 | D UNLOCK^SROUTL(SRTN),^SROERR
|
|---|
| 56 | Q
|
|---|
| 57 | DEL S DA=SRTN,DIK="^SRF(" D ^DIK
|
|---|
| 58 | END K SRTN D ^SRSKILL
|
|---|
| 59 | Q
|
|---|
| 60 | CONT ; continue new entry ?
|
|---|
| 61 | W !!,"Do you want to continue ? YES// " R SRYN:DTIME I '$T S SRYN="N" Q
|
|---|
| 62 | 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
|
|---|
| 63 | Q
|
|---|
| 64 | RT ;start RT logging
|
|---|
| 65 | I $D(XRTL) S XRTN="SRONEW" D T0^%ZOSV
|
|---|
| 66 | Q
|
|---|
| 67 | CON ; check for concurrent case
|
|---|
| 68 | 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
|
|---|
| 69 | .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
|
|---|
| 70 | .I SRSCON D CC^SRSREQ I '$D(SRCTN) S SRSCON=0
|
|---|
| 71 | Q
|
|---|
