- SRONEW ;BIR/MAM - ENTER A NEW CASE; NOVEMBER 1, 2011
- ;;3.0;Surgery;**3,23,26,30,47,58,48,67,107,100,144,175,176,177,182,184,214**;24 Jun 93;Build 3
- ;
- ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
- ;
- DEAD S SRSOUT=0,X=$P($G(VADM(6)),"^") I X D I SRSOUT D ^SRSKILL G ^SROP
- .S SRDEATH=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) W @IOF,!,?1,VADM(1)_" "_VA("PID")_" * Died "_SRDEATH_" *"
- .W !!,$C(7) K DIR S DIR("A",1)=">>> The patient you have selected died on "_SRDEATH_"."
- .S DIR("A")=" Are you sure this is the correct patient ? ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
- .W @IOF I 'Y!$D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
- .W !,"Entering a new surgical case for "_VADM(1)_".",!!
- 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."
- I Y<0 D CONT G:"Yy"'[SRYN END G DATE
- G:Y'>0 END S SRSDATE=Y
- ODP N SRSODP
- K DIR S DIR(0)="130,616",DIR("A")="Desired Procedure Date" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G END
- I Y=""!(X["^")!(Y<SRSDATE) W !!,"The Desired Procedure Date MUST be entered and should be greater than or equal to date of operation. Enter '^' to exit.",! G ODP
- S SRSODP=+Y
- S SRSC1=1 K SRCTN S SRSDPT=DFN,SRSCC="" D CON G:SRSCC="^" END
- OP D ^SROPROC I SRSOUT G END
- S SRPRIN=SRSOP
- 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 END
- I Y=""!(X["^") W !!,"A Principal Preoperative Diagnosis must be entered",!,"when creating a new case. 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.",!
- DOC W ! S DIC("A")="Select Primary Surgeon: ",DIC=200,DIC(0)="QEAM",SRSDOC="" D ^DIC K DIC("A") I $D(DTOUT)!(X="^") S SRSOUT=1 G END
- I Y<0!(X["^") W !!,"A Surgeon must be entered when creating a case. Enter '^' to exit.",! G DOC
- S (DA,SRSDOC)=+Y
- 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
- CASE ; create case in SURGERY file
- K DA,DIC,DD,DO,DINUM,SRTN S X=DFN,DIC="^SRF(",DIC(0)="L" D FILE^DICN K DIC,DO,DINUM S SRTN=+Y G:'$$LOCK^SROUTL(SRTN) DEL
- S ^SRF(SRTN,8)=SRSITE("DIV"),^SRF(SRTN,"OP")=""
- S ^SRF(SRTN,52)="0^0^0^0^0^0" ; default flash sterilization fields to zero
- K DIE,DR S DA=SRTN,DIE=130,DR=".09////"_SRSDATE_";26////"_SRPRIN_";68////"_SRPRIN_";.14////"_SRSDOC_";616////"_SRSODP_";612////"_SRSODP_";613////"_$$DSMP^SRSDT 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 !!,"An Attending Surgeon must be entered when creating a case. Enter '^' to exit.",! G ASURG
- S SRATTND=+Y
- ;SR*3.0*214 - add KILL of DIC("A") on following line
- SPEC W ! K DIC S DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select Surgical Specialty: ",DIC("S")="I '$P(^(0),""^"",3)" D ^DIC K DIC("A") I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
- I Y<0!(X["^") W !!,"To create a surgical case, a Surgical Specialty MUST be selected. Enter '^'",!,"to exit.",! G SPEC
- S SRSS=+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 ; update case in SURGERY file
- S DA=SRTN,DIE=130,DR=".04////"_SRSS_";.164////"_SRATTND_";32////"_SRSOPD_";27////"_SRCPT D ^DIE K DR
- D SPIN
- S SRSOPD(1)=SRSOPD D WP^DIE(130,SRTN_",",55,"A","SRSOPD")
- ; Brief Clinical History
- K DR S DR="60T",DA=SRTN,DIE=130 W ! D ^DIE
- K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR
- S ^SRF(SRTN,8)=SRSITE("DIV") D ^SROXRET
- DIE D ^SROBLOD K DR,DIE,DA S DR="38////"_BLOOD_";40////"_CROSSM,DA=SRTN,DIE=130 D ^DIE K DR,DA,DIE
- N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
- S DR="[SRSRES1]",DIE=130,DA=SRTN D ^DIE,RT S ST="NEW SURGERY" D EN2^SROVAR
- S SPD=$$CHKS^SRSCOR(SRTN)
- K DR S DR=$S($$SPIN^SRTOVRF():"[SRSRES-ENTRY1]",1:"[SRSRES-ENTRY]"),DIE=130,DA=SRTN D ^SRCUSS,RISK^SROAUTL3,^SROPCE1
- I SPD'=$$CHKS^SRSCOR(SRTN) S ^TMP("CSLSUR1",$J)=""
- I $D(SRCTN) D
- .S SRCTN(.02)=$P(^SRF(SRCTN,0),"^",2),SRCTN(10)=$P($G(^SRF(SRCTN,31)),"^",4),SRCTN(11)=$P($G(^SRF(SRCTN,31)),"^",5)
- .S DIE=130,DR=".02////"_SRCTN(.02)_";10////"_SRCTN(10)_";11////"_SRCTN(11)_";35////"_SRCTN_";614////"_$P(SRCTN(10),"."),DA=SRTN D ^DIE
- .S DR="35////"_SRTN,DA=SRCTN,DIE=130 D ^DIE
- D UNLOCK^SROUTL(SRTN),^SROERR
- Q
- DEL S DA=SRTN,DIK="^SRF(" D ^DIK
- END K SRTN D ^SRSKILL
- Q
- CONT ; continue new entry ?
- W !!,"Do you want to continue ? YES// " R SRYN:DTIME I '$T S SRYN="N" Q
- 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
- Q
- RT ;start RT logging
- I $D(XRTL) S XRTN="SRONEW" D T0^%ZOSV
- Q
- CON ; check for concurrent case
- 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
- .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
- .I SRSCON D CC^SRSREQ I '$D(SRCTN) S SRSCON=0
- 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[HSRONEW 6264 printed Jan 18, 2025@03:45:25 Page 2
- SRONEW ;BIR/MAM - ENTER A NEW CASE; NOVEMBER 1, 2011
- +1 ;;3.0;Surgery;**3,23,26,30,47,58,48,67,107,100,144,175,176,177,182,184,214**;24 Jun 93;Build 3
- +2 ;
- +3 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
- +4 ;
- DEAD SET SRSOUT=0
- SET X=$PIECE($GET(VADM(6)),"^")
- IF X
- Begin DoDot:1
- +1 SET SRDEATH=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
- WRITE @IOF,!,?1,VADM(1)_" "_VA("PID")_" * Died "_SRDEATH_" *"
- +2 WRITE !!,$CHAR(7)
- KILL DIR
- SET DIR("A",1)=">>> The patient you have selected died on "_SRDEATH_"."
- +3 SET DIR("A")=" Are you sure this is the correct patient ? "
- SET DIR("B")="NO"
- SET DIR(0)="YA"
- DO ^DIR
- KILL DIR
- +4 WRITE @IOF
- IF 'Y!$DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- QUIT
- +5 WRITE !,"Entering a new surgical case for "_VADM(1)_".",!!
- End DoDot:1
- IF SRSOUT
- DO ^SRSKILL
- GOTO ^SROP
- DATE KILL %DT
- WRITE !
- SET %DT("A")="Select the Date of Operation: "
- SET %DT="AEX"
- DO ^%DT
- IF Y<0
- WRITE !!,"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."
- +1 IF Y<0
- DO CONT
- if "Yy"'[SRYN
- GOTO END
- GOTO DATE
- +2 if Y'>0
- GOTO END
- SET SRSDATE=Y
- ODP NEW SRSODP
- +1 KILL DIR
- SET DIR(0)="130,616"
- SET DIR("A")="Desired Procedure Date"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO END
- +2 IF Y=""!(X["^")!(Y<SRSDATE)
- WRITE !!,"The Desired Procedure Date MUST be entered and should be greater than or equal to date of operation. Enter '^' to exit.",!
- GOTO ODP
- +3 SET SRSODP=+Y
- +4 SET SRSC1=1
- KILL SRCTN
- SET SRSDPT=DFN
- SET SRSCC=""
- DO CON
- if SRSCC="^"
- GOTO END
- OP DO ^SROPROC
- IF SRSOUT
- GOTO END
- +1 SET SRPRIN=SRSOP
- 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 END
- +2 IF Y=""!(X["^")
- WRITE !!,"A Principal Preoperative Diagnosis must be entered",!,"when creating a new case. 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.",!
- DOC WRITE !
- SET DIC("A")="Select Primary Surgeon: "
- SET DIC=200
- SET DIC(0)="QEAM"
- SET SRSDOC=""
- DO ^DIC
- KILL DIC("A")
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO END
- +1 IF Y<0!(X["^")
- WRITE !!,"A Surgeon must be entered when creating a case. Enter '^' to exit.",!
- GOTO DOC
- +2 SET (DA,SRSDOC)=+Y
- +3 SET RESTRICT="130,.14"
- SET Y=SRSDOC
- KILL SROK
- DO KEY^SROXPR
- IF '$DATA(SROK)
- WRITE !!,"The person you selected does not have the appropriate keys necessary to be",!,"entered as a surgeon. Please make another selection.",!
- KILL SRSDOC,DA,DIC
- GOTO DOC
- CASE ; create case in SURGERY file
- +1 KILL DA,DIC,DD,DO,DINUM,SRTN
- SET X=DFN
- SET DIC="^SRF("
- SET DIC(0)="L"
- DO FILE^DICN
- KILL DIC,DO,DINUM
- SET SRTN=+Y
- if '$$LOCK^SROUTL(SRTN)
- GOTO DEL
- +2 SET ^SRF(SRTN,8)=SRSITE("DIV")
- SET ^SRF(SRTN,"OP")=""
- +3 ; default flash sterilization fields to zero
- SET ^SRF(SRTN,52)="0^0^0^0^0^0"
- +4 KILL DIE,DR
- SET DA=SRTN
- SET DIE=130
- SET DR=".09////"_SRSDATE_";26////"_SRPRIN_";68////"_SRPRIN_";.14////"_SRSDOC_";616////"_SRSODP_";612////"_SRSODP_";613////"_$$DSMP^SRSDT
- 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 !!,"An Attending Surgeon must be entered when creating a case. Enter '^' to exit.",!
- GOTO ASURG
- +3 SET SRATTND=+Y
- +4 ;SR*3.0*214 - add KILL of DIC("A") on following line
- SPEC WRITE !
- KILL DIC
- SET DIC=137.45
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Select Surgical Specialty: "
- SET DIC("S")="I '$P(^(0),""^"",3)"
- DO ^DIC
- KILL DIC("A")
- IF $DATA(DTOUT)!(X="^")
- SET SRSOUT=1
- GOTO DEL
- +1 IF Y<0!(X["^")
- WRITE !!,"To create a surgical case, a Surgical Specialty MUST be selected. Enter '^'",!,"to exit.",!
- GOTO SPEC
- +2 SET SRSS=+Y
- +3 ;
- 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 ; update case in SURGERY file
- +1 SET DA=SRTN
- SET DIE=130
- SET DR=".04////"_SRSS_";.164////"_SRATTND_";32////"_SRSOPD_";27////"_SRCPT
- DO ^DIE
- KILL DR
- +2 DO SPIN
- +3 SET SRSOPD(1)=SRSOPD
- DO WP^DIE(130,SRTN_",",55,"A","SRSOPD")
- +4 ; Brief Clinical History
- +5 KILL DR
- SET DR="60T"
- SET DA=SRTN
- SET DIE=130
- WRITE !
- DO ^DIE
- +6 KILL DR,DA
- SET DR="[SRO-NOCOMP]"
- SET DA=SRTN
- SET DIE=130
- DO ^DIE
- KILL DR
- +7 SET ^SRF(SRTN,8)=SRSITE("DIV")
- DO ^SROXRET
- DIE DO ^SROBLOD
- KILL DR,DIE,DA
- SET DR="38////"_BLOOD_";40////"_CROSSM
- SET DA=SRTN
- SET DIE=130
- DO ^DIE
- KILL DR,DA,DIE
- +1 NEW SRICDV
- SET SRICDV=$$ICDSTR^SROICD(SRTN)
- +2 SET DR="[SRSRES1]"
- SET DIE=130
- SET DA=SRTN
- DO ^DIE
- DO RT
- SET ST="NEW SURGERY"
- DO EN2^SROVAR
- +3 SET SPD=$$CHKS^SRSCOR(SRTN)
- +4 KILL DR
- SET DR=$SELECT($$SPIN^SRTOVRF():"[SRSRES-ENTRY1]",1:"[SRSRES-ENTRY]")
- SET DIE=130
- SET DA=SRTN
- DO ^SRCUSS
- DO RISK^SROAUTL3
- DO ^SROPCE1
- +5 IF SPD'=$$CHKS^SRSCOR(SRTN)
- SET ^TMP("CSLSUR1",$JOB)=""
- +6 IF $DATA(SRCTN)
- Begin DoDot:1
- +7 SET SRCTN(.02)=$PIECE(^SRF(SRCTN,0),"^",2)
- SET SRCTN(10)=$PIECE($GET(^SRF(SRCTN,31)),"^",4)
- SET SRCTN(11)=$PIECE($GET(^SRF(SRCTN,31)),"^",5)
- +8 SET DIE=130
- SET DR=".02////"_SRCTN(.02)_";10////"_SRCTN(10)_";11////"_SRCTN(11)_";35////"_SRCTN_";614////"_$PIECE(SRCTN(10),".")
- SET DA=SRTN
- DO ^DIE
- +9 SET DR="35////"_SRTN
- SET DA=SRCTN
- SET DIE=130
- DO ^DIE
- End DoDot:1
- +10 DO UNLOCK^SROUTL(SRTN)
- DO ^SROERR
- +11 QUIT
- DEL SET DA=SRTN
- SET DIK="^SRF("
- DO ^DIK
- END KILL SRTN
- DO ^SRSKILL
- +1 QUIT
- CONT ; continue new entry ?
- +1 WRITE !!,"Do you want to continue ? YES// "
- READ SRYN:DTIME
- IF '$TEST
- SET SRYN="N"
- QUIT
- +2 SET SRYN=$EXTRACT(SRYN)
- if SRYN=""
- SET SRYN="Y"
- IF "YyNn"'[SRYN
- WRITE !!,"Enter RETURN if you want to re-enter a date and continue creating a new",!,"case, or 'NO' to leave this option."
- GOTO CONT
- +3 QUIT
- RT ;start RT logging
- +1 IF $DATA(XRTL)
- SET XRTN="SRONEW"
- DO T0^%ZOSV
- +2 QUIT
- CON ; check for concurrent case
- +1 SET SRSCON=0
- SET SRDT=SRSDATE-.0001
- FOR
- SET SRDT=$ORDER(^SRF("AC",SRDT))
- if 'SRDT!($EXTRACT(SRDT,1,7)'=SRSDATE)!(SRSCON)
- QUIT
- SET (SRSCC,SRSCON)=0
- FOR
- SET SRSCC=$ORDER(^SRF("AC",SRDT,SRSCC))
- if 'SRSCC
- QUIT
- Begin DoDot:1
- +2 IF ^(SRSCC)=SRSDPT
- IF '$PIECE($GET(^SRF(SRSCC,"CON")),"^")
- IF $PIECE($GET(^SRF(SRSCC,"NON")),"^")'="Y"
- IF '$PIECE($GET(^SRF(SRSCC,30)),"^")
- IF '$PIECE($GET(^SRF(SRSCC,.2)),"^",12)
- IF '$PIECE($GET(^SRF(SRSCC,"LOCK")),"^")
- SET SRSCON=1
- +3 IF SRSCON
- DO CC^SRSREQ
- IF '$DATA(SRCTN)
- SET SRSCON=0
- End DoDot:1
- if SRSCON
- QUIT
- +4 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