SRSCHUN1 ;B'HAM ISC/MAM - MAKE UNREQUESTED OPERATION (optional fields); [ 04/26/97 3:15 PM ]
;;3.0;Surgery;**34,47,58,67,107,177,184**;24 Jun 93;Build 35
;
; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
;
ANES W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?14,"SCHEDULE UNREQUESTED OPERATION: ANESTHESIA PERSONNEL",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE
K DA,DIE,DR S DIE=130,DA=SRTN,DR=".31T;.34T" D ^DIE K DA,DIE,DR Q:$D(DTOUT) G:$D(Y) SS
PROC W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?14,"SCHEDULE UNREQUESTED OPERATION: PROCEDURE INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE
S SROPER=$P(^SRF(SRTN,"OP"),"^") K SROPS,MM,MMM S:$L(SROPER)<55 SROPS(1)=SROPER I $L(SROPER)>54 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
W !,"Principal Procedure: ",?26,SROPS(1) I $D(SROPS(2)) W !,?26,SROPS(2) I $D(SROPS(3)) W !,?26,SROPS(3)
I $D(SREQ(27)) W !,"Principal Procedure Code (CPT): "_$P(SREQ(27),"^",2)
K DR S DR="" I '$D(SREQ(27)) S DR="27T;"
S DR=DR_".42T;60T",DR(2,130.16)=".01T;3T;1.5T",DA=SRTN,DIE=130 D ^DIE K DR,DA Q:$D(DTOUT) G:$D(Y) SS
BLOOD W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?20,"SCHEDULE UNREQUESTED OPERATION: BLOOD INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
D ^SROBLOD Q:$D(SRT) G:$D(SRDUOUT) SS
OTH S SRICDV=$$ICDSTR^SROICD(SRTN)
W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?20,"SCHEDULE UNREQUESTED OPERATION: OTHER INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
;JAS - 03/25/14 - PATCH 177 - Changes for ICD-10
K DR I SRICDV["9" S DR="[SRSCHED-UNREQUESTED]"
E S DR="[SRSCHED-UNREQUESTED-ICD10]"
S DIE=130,DA=SRTN D ^DIE K DR S:$D(DTOUT) SRDUOUT=1 I $D(SRODR) D ^SROCON1
;End of 177
Q:$D(SRDUOUT)
;
SS S SRICDV=$$ICDSTR^SROICD(SRTN)
D RT K DA,DR,DIC,DIE S DR=$S($$SPIN^SRTOVRF():"[SRSRES-SCHED1]",1:"[SRSRES-SCHED]"),DIE=130,DA=SRTN D EN2^SROVAR K Q3("VIEW") S SPD=$$CHKS^SRSCOR(SRTN) D ^SRCUSS
I SPD'=$$CHKS^SRSCOR(SRTN) S ^TMP("CSLSUR1",$J)=""
K DR S SRSOUT=1 D:$D(SRODR) ^SROCON1 D RISK^SROAUTL3,^SROPCE1
S SROERR=SRTN K SRTX D ^SROERR0
Q
LOOP ; break procedure if greater than 54 charcaters
S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<55 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
RT ; start RT logging
I $D(XRTL) S XRTN="SRSCHUN1" D T0^%ZOSV
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHUN1 2484 printed Oct 16, 2024@18:47:58 Page 2
SRSCHUN1 ;B'HAM ISC/MAM - MAKE UNREQUESTED OPERATION (optional fields); [ 04/26/97 3:15 PM ]
+1 ;;3.0;Surgery;**34,47,58,67,107,177,184**;24 Jun 93;Build 35
+2 ;
+3 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
+4 ;
ANES WRITE @IOF
if $DATA(SRCC)
WRITE !,?29,$SELECT(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE"
WRITE !,?14,"SCHEDULE UNREQUESTED OPERATION: ANESTHESIA PERSONNEL",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE
+1 KILL DA,DIE,DR
SET DIE=130
SET DA=SRTN
SET DR=".31T;.34T"
DO ^DIE
KILL DA,DIE,DR
if $DATA(DTOUT)
QUIT
if $DATA(Y)
GOTO SS
PROC WRITE @IOF
if $DATA(SRCC)
WRITE !,?29,$SELECT(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE"
WRITE !,?14,"SCHEDULE UNREQUESTED OPERATION: PROCEDURE INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE
+1 SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
KILL SROPS,MM,MMM
if $LENGTH(SROPER)<55
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>54
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+2 WRITE !,"Principal Procedure: ",?26,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?26,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?26,SROPS(3)
+3 IF $DATA(SREQ(27))
WRITE !,"Principal Procedure Code (CPT): "_$PIECE(SREQ(27),"^",2)
+4 KILL DR
SET DR=""
IF '$DATA(SREQ(27))
SET DR="27T;"
+5 SET DR=DR_".42T;60T"
SET DR(2,130.16)=".01T;3T;1.5T"
SET DA=SRTN
SET DIE=130
DO ^DIE
KILL DR,DA
if $DATA(DTOUT)
QUIT
if $DATA(Y)
GOTO SS
BLOOD WRITE @IOF
if $DATA(SRCC)
WRITE !,?29,$SELECT(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE"
WRITE !,?20,"SCHEDULE UNREQUESTED OPERATION: BLOOD INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
+1 DO ^SROBLOD
if $DATA(SRT)
QUIT
if $DATA(SRDUOUT)
GOTO SS
OTH SET SRICDV=$$ICDSTR^SROICD(SRTN)
+1 WRITE @IOF
if $DATA(SRCC)
WRITE !,?29,$SELECT(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE"
WRITE !,?20,"SCHEDULE UNREQUESTED OPERATION: OTHER INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
+2 ;JAS - 03/25/14 - PATCH 177 - Changes for ICD-10
+3 KILL DR
IF SRICDV["9"
SET DR="[SRSCHED-UNREQUESTED]"
+4 IF '$TEST
SET DR="[SRSCHED-UNREQUESTED-ICD10]"
+5 SET DIE=130
SET DA=SRTN
DO ^DIE
KILL DR
if $DATA(DTOUT)
SET SRDUOUT=1
IF $DATA(SRODR)
DO ^SROCON1
+6 ;End of 177
+7 if $DATA(SRDUOUT)
QUIT
+8 ;
SS SET SRICDV=$$ICDSTR^SROICD(SRTN)
+1 DO RT
KILL DA,DR,DIC,DIE
SET DR=$SELECT($$SPIN^SRTOVRF():"[SRSRES-SCHED1]",1:"[SRSRES-SCHED]")
SET DIE=130
SET DA=SRTN
DO EN2^SROVAR
KILL Q3("VIEW")
SET SPD=$$CHKS^SRSCOR(SRTN)
DO ^SRCUSS
+2 IF SPD'=$$CHKS^SRSCOR(SRTN)
SET ^TMP("CSLSUR1",$JOB)=""
+3 KILL DR
SET SRSOUT=1
if $DATA(SRODR)
DO ^SROCON1
DO RISK^SROAUTL3
DO ^SROPCE1
+4 SET SROERR=SRTN
KILL SRTX
DO ^SROERR0
+5 QUIT
LOOP ; break procedure if greater than 54 charcaters
+1 SET SROPS(M)=""
FOR LOOP=1:1
SET MM=$PIECE(SROPER," ")
SET MMM=$PIECE(SROPER," ",2,200)
if MMM=""
QUIT
if $LENGTH(SROPS(M))+$LENGTH(MM)'<55
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
RT ; start RT logging
+1 IF $DATA(XRTL)
SET XRTN="SRSCHUN1"
DO T0^%ZOSV
+2 QUIT
