- 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 Jan 18, 2025@03:47:59 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