SROXRET ;B'HAM ISC/MAM - UNEXPECTED RETURNS ; 17 JAN 1991 9:00 AM
;;3.0; Surgery ;**16,34,46**;24 Jun 93
N SRSDATE S SRSDATE=$P(^SRF(SRTN,0),"^",9),X1=SRSDATE,X2=-30 D C^%DTC S SRDATES=X-.0001 I $P(SRSDATE,".",2)="" S SRSDATE=SRSDATE+.9999
S CNT=0,DFN=$P(^SRF(SRTN,0),"^") F S SRDATES=$O(^SRF("AC",SRDATES)) Q:'SRDATES!(SRDATES>SRSDATE) S SRETURN=0 F S SRETURN=$O(^SRF("AC",SRDATES,SRETURN)) Q:'SRETURN I ^(SRETURN)=DFN,DA'=SRETURN D SET
I '$O(SRETURN(0)) Q
I '$D(SRETURN(2)) D ONE Q:X="" S SRELATE="R" G STUFF
ASK W !!,"Is this a return to surgery related to one of the cases listed",!,"above ? NO// " R SRYN:DTIME I '$T!(SRYN["^") W @IOF Q
S SRYN=$E(SRYN) S:SRYN="" SRYN="N" I "Nn"[SRYN W @IOF Q
I "Yy"'[SRYN D HELP G ASK
SEL W !!,"Select the number corresponding to the appropriate case: " R X:DTIME I '$T!("^"[X) W @IOF Q
I '$D(SRETURN(X)) W !!,"Enter the number corresponding to the operative procedure associated with",!,"this unexpected return to surgery." G SEL
S SRELATE="R"
STUFF S SRETURN=$P(SRETURN(X),"^") I '$D(^SRF(SRETURN,29,0)) S ^(0)="^130.43PA^^0"
K DA,D0,DD,DINUM,DIC S DA(1)=SRETURN,DIC="^SRF("_SRETURN_",29,",(DINUM,X)=SRTN,DIC(0)="L",DLAYGO=130.43 D FILE^DICN K DIC,DINUM,DLAYGO
S $P(^SRF(SRETURN,29,SRTN,0),"^",3)=SRELATE,DA=SRTN
W:SRELATE="R" @IOF Q
ONE S X="" W !!,"Is this a return to surgery related to the case listed ",!,"above ? NO// " R SRYN:DTIME I '$T!(SRYN["^") W @IOF Q
S SRYN=$E(SRYN) S:SRYN="" SRYN="N" I "Nn"[SRYN S X="" W @IOF Q
I "Yy"'[SRYN D HELP G ONE
S X=1
Q
SET I $D(^SRF(SRETURN,29,SRTN,0))!'$D(^SRF(SRETURN,.2)) Q
I '$P(^SRF(SRETURN,.2),"^",12) Q
S CNT=CNT+1,SRETURN(CNT)=SRETURN_"^"_SRDATES_"^"_$P(^SRF(SRETURN,"OP"),"^")
S Y=SRDATES D D^DIQ S OPDATE=$P(Y,"@")
S SROPER=$P(^SRF(SRETURN,"OP"),"^") K SROP,MM,MMM
S:$L(SROPER)<50 SROP(1)=SROPER I $L(SROPER)>49 F MAM=1:1 D LOOP Q:'MMM
I CNT=1 D DEM^VADPT W @IOF,!,"Completed cases for "_VADM(1)_" within the past 30 days:",!!
W !,CNT_".",?5,OPDATE,?25,SROP(1) I $D(SROP(2)) W !,?25,SROP(2) I $D(SROP(3)) W !,?25,SROP(3) I $D(SROP(4)) W !,?25,SROP(4)
S X=CNT,SRELATE="U" D STUFF
Q
HELP W !!,"If this surgical case is related to a previous case, enter 'YES'. Otherwise, ",!,"press RETURN to continue entering information for this operative procedure."
Q
LOOP ; break procedure if greater than 50 characters
S SROP(MAM)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROP(MAM))+$L(MM)'<50 S SROP(MAM)=SROP(MAM)_MM_" ",SROPER=MMM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROXRET 2525 printed Dec 13, 2024@02:46:49 Page 2
SROXRET ;B'HAM ISC/MAM - UNEXPECTED RETURNS ; 17 JAN 1991 9:00 AM
+1 ;;3.0; Surgery ;**16,34,46**;24 Jun 93
+2 NEW SRSDATE
SET SRSDATE=$PIECE(^SRF(SRTN,0),"^",9)
SET X1=SRSDATE
SET X2=-30
DO C^%DTC
SET SRDATES=X-.0001
IF $PIECE(SRSDATE,".",2)=""
SET SRSDATE=SRSDATE+.9999
+3 SET CNT=0
SET DFN=$PIECE(^SRF(SRTN,0),"^")
FOR
SET SRDATES=$ORDER(^SRF("AC",SRDATES))
if 'SRDATES!(SRDATES>SRSDATE)
QUIT
SET SRETURN=0
FOR
SET SRETURN=$ORDER(^SRF("AC",SRDATES,SRETURN))
if 'SRETURN
QUIT
IF ^(SRETURN)=DFN
IF DA'=SRETURN
DO SET
+4 IF '$ORDER(SRETURN(0))
QUIT
+5 IF '$DATA(SRETURN(2))
DO ONE
if X=""
QUIT
SET SRELATE="R"
GOTO STUFF
ASK WRITE !!,"Is this a return to surgery related to one of the cases listed",!,"above ? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
WRITE @IOF
QUIT
+1 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="N"
IF "Nn"[SRYN
WRITE @IOF
QUIT
+2 IF "Yy"'[SRYN
DO HELP
GOTO ASK
SEL WRITE !!,"Select the number corresponding to the appropriate case: "
READ X:DTIME
IF '$TEST!("^"[X)
WRITE @IOF
QUIT
+1 IF '$DATA(SRETURN(X))
WRITE !!,"Enter the number corresponding to the operative procedure associated with",!,"this unexpected return to surgery."
GOTO SEL
+2 SET SRELATE="R"
STUFF SET SRETURN=$PIECE(SRETURN(X),"^")
IF '$DATA(^SRF(SRETURN,29,0))
SET ^(0)="^130.43PA^^0"
+1 KILL DA,D0,DD,DINUM,DIC
SET DA(1)=SRETURN
SET DIC="^SRF("_SRETURN_",29,"
SET (DINUM,X)=SRTN
SET DIC(0)="L"
SET DLAYGO=130.43
DO FILE^DICN
KILL DIC,DINUM,DLAYGO
+2 SET $PIECE(^SRF(SRETURN,29,SRTN,0),"^",3)=SRELATE
SET DA=SRTN
+3 if SRELATE="R"
WRITE @IOF
QUIT
ONE SET X=""
WRITE !!,"Is this a return to surgery related to the case listed ",!,"above ? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
WRITE @IOF
QUIT
+1 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="N"
IF "Nn"[SRYN
SET X=""
WRITE @IOF
QUIT
+2 IF "Yy"'[SRYN
DO HELP
GOTO ONE
+3 SET X=1
+4 QUIT
SET IF $DATA(^SRF(SRETURN,29,SRTN,0))!'$DATA(^SRF(SRETURN,.2))
QUIT
+1 IF '$PIECE(^SRF(SRETURN,.2),"^",12)
QUIT
+2 SET CNT=CNT+1
SET SRETURN(CNT)=SRETURN_"^"_SRDATES_"^"_$PIECE(^SRF(SRETURN,"OP"),"^")
+3 SET Y=SRDATES
DO D^DIQ
SET OPDATE=$PIECE(Y,"@")
+4 SET SROPER=$PIECE(^SRF(SRETURN,"OP"),"^")
KILL SROP,MM,MMM
+5 if $LENGTH(SROPER)<50
SET SROP(1)=SROPER
IF $LENGTH(SROPER)>49
FOR MAM=1:1
DO LOOP
if 'MMM
QUIT
+6 IF CNT=1
DO DEM^VADPT
WRITE @IOF,!,"Completed cases for "_VADM(1)_" within the past 30 days:",!!
+7 WRITE !,CNT_".",?5,OPDATE,?25,SROP(1)
IF $DATA(SROP(2))
WRITE !,?25,SROP(2)
IF $DATA(SROP(3))
WRITE !,?25,SROP(3)
IF $DATA(SROP(4))
WRITE !,?25,SROP(4)
+8 SET X=CNT
SET SRELATE="U"
DO STUFF
+9 QUIT
HELP WRITE !!,"If this surgical case is related to a previous case, enter 'YES'. Otherwise, ",!,"press RETURN to continue entering information for this operative procedure."
+1 QUIT
LOOP ; break procedure if greater than 50 characters
+1 SET SROP(MAM)=""
FOR LOOP=1:1
SET MM=$PIECE(SROPER," ")
SET MMM=$PIECE(SROPER," ",2,200)
if MMM=""
QUIT
if $LENGTH(SROP(MAM))+$LENGTH(MM)'<50
QUIT
SET SROP(MAM)=SROP(MAM)_MM_" "
SET SROPER=MMM
+2 QUIT
