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
|
---|