SROARET ;BIR/MAM - UPDATE RETURNS ;07/07/04 12:27 PM
;;3.0; Surgery ;**16,19,38,46,88,100,125,142**;24 Jun 93
I '$D(SRTN) S SRTN1=1 D ^SROPS I '$D(SRTN) S SRSOUT=1 G END1
S SRSUPCPT=1 D ^SROAUTL S SRNAME=VADM(1),SRSOUT=0,SR(0)=^SRF(SRTN,0),SRLINE="" F I=1:1:79 S SRLINE=SRLINE_"-"
S SRT=$P($G(^SRF(SRTN,.2)),"^",10),(SRSDATE,X1)=$E($P(SR(0),"^",9),1,7),X2=30 D C^%DTC S SRENDT=X,END=SRENDT+.9999 K SRETURN
S SRCASE=0 F S SRCASE=$O(^SRF(SRTN,29,SRCASE)) Q:'SRCASE D
.S CASE=$P(^SRF(SRTN,29,SRCASE,0),"^"),SRCT=$P(^SRF(CASE,0),"^",9),SRT1=$P($G(^SRF(CASE,.2)),"^",10)
.I $E(SRCT,1,7)<SRSDATE!(SRCT=$P(SR(0),"^",9))!(SRCT>END)!$P($G(^SRF(CASE,30)),"^")!$P($G(^SRF(CASE,31)),"^",8)!$P($G(^SRF(CASE,37)),"^") D DEL Q
.I SRT,SRT1,SRT>SRT1 D DEL
S SRCASE=0 F S SRCASE=$O(^SRF("B",DFN,SRCASE)) Q:'SRCASE I SRCASE'=SRTN D CHECK
I '$O(^SRF(SRTN,29,0)) W !!,"There are no surgical cases entered for "_SRNAME_"",!,"within 30 days of this operation." G END
RETURN S SRPAGE="RETURNS TO SURGERY" D HDR^SROAUTL
S (SRCASE,CNT)=0 F S SRCASE=$O(^SRF(SRTN,29,SRCASE)) Q:'SRCASE D
.S CNT=CNT+1,X=$P(^SRF(SRTN,29,SRCASE,0),"^",3) I X="" S X="U",$P(^SRF(SRTN,29,SRCASE,0),"^",3)=X
.S SRELATE=$S(X="U":"UNRELATED",1:"RELATED"),SRETURN(CNT)=SRCASE_"^"_SRELATE D LIST
I '$D(SRETURN(2)) S X=1 D RELATED G END
W !,SRLINE,!
PICK W !!,"Select Number: " R X:DTIME I '$T!("^"[X) S SRSOUT=1 G END
I '$D(SRETURN(X)) W !!,"Select the number corresponding to the return which you want to update, or",!,"enter RETURN to quit this option.",!!,"Press RETURN to continue " R X:DTIME G RETURN
D RELATED G RETURN
DEL ; delete returns
S DA(1)=SRTN,DA=SRCASE,DIK="^SRF("_SRTN_",29," D ^DIK
Q
CHECK ; add to RETURNS if necessary
Q:$P($G(^SRF(SRCASE,"NON")),"^")="Y"!$P($G(^SRF(SRCASE,37)),"^") S CAN=$P($G(^SRF(SRCASE,30)),"^") I CAN Q
S CAN=$P($G(^SRF(SRCASE,31)),"^",8) I CAN'="" Q
S CON=$P($G(^SRF(SRTN,"CON")),"^") I CON=SRCASE Q
S DATE=$P(^SRF(SRCASE,0),"^",9),SRT1=$P($G(^SRF(SRCASE,.2)),"^",10) I $E(DATE,1,7)<SRSDATE!(DATE>END)!(DATE=$P(SR(0),"^",9)) Q
I SRT,SRT1,SRT>SRT1 Q
I $D(^SRF(SRTN,29,SRCASE,0)) Q
I '$D(^SRF(SRTN,29,0)) S ^SRF(SRTN,29,0)="^130.43PA^^"
K DA,DO,DD,DA,DINUM,DIC S DA(1)=SRTN,DIC="^SRF("_SRTN_",29,",X=SRCASE,DINUM=X,DIC(0)="L",DLAYGO=130.43 D FILE^DICN K DD,DO,DIC,DINUM,DLAYGO
S $P(^SRF(SRTN,29,SRCASE,0),"^",3)="U"
Q
LIST ; list returns
S SROPER=$P(^SRF(SRCASE,"OP"),"^")
S SROPER=SROPER_" - "_SRELATE
S DATE=$P(^SRF(SRCASE,0),"^",9),DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
K SROPS,MM,MMM S:$L(SROPER)<65 SROPS(1)=SROPER I $L(SROPER)>64 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
W !,CNT_".",?3,DATE,?15,SROPS(1) I $D(SROPS(2)) W !,?15,SROPS(2) I $D(SROPS(3)) W !,?15,SROPS(3)
W ! Q
LOOP ; break procedures
S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<65 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
UPDATE ; update single return
END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
END1 I $D(SRTN1) K SRTN,SRTN1
D ^SRSKILL W @IOF
Q
RELATED ; update RELATED/UNRELATED status
S RETURN=$P(SRETURN(X),"^"),SRELATE=$P(SRETURN(X),"^",2),OPPOSITE=$S(SRELATE["U":"RELATED",1:"UNRELATED")
I $D(SRETURN(2)) S SRPAGE="RETURNS TO SURGERY" D HDR^SROAUTL W ! S SRCASE=$P(SRETURN(X),"^"),CNT=X D LIST W !,SRLINE,!
CHANGE W !!,"This return to surgery is currently defined as "_SRELATE_" to the case selected.",!,"Do you want to change this status ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' to change the status of this return from "_SRELATE_" to "_OPPOSITE_".",!,"Enter 'NO' to leave the information unchanged.",! G CHANGE
S:SRYN="" SRYN="N" I "Yy"'[SRYN Q
S $P(^SRF(SRTN,29,RETURN,0),"^",3)=$E(OPPOSITE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROARET 3822 printed Dec 13, 2024@02:41:51 Page 2
SROARET ;BIR/MAM - UPDATE RETURNS ;07/07/04 12:27 PM
+1 ;;3.0; Surgery ;**16,19,38,46,88,100,125,142**;24 Jun 93
+2 IF '$DATA(SRTN)
SET SRTN1=1
DO ^SROPS
IF '$DATA(SRTN)
SET SRSOUT=1
GOTO END1
+3 SET SRSUPCPT=1
DO ^SROAUTL
SET SRNAME=VADM(1)
SET SRSOUT=0
SET SR(0)=^SRF(SRTN,0)
SET SRLINE=""
FOR I=1:1:79
SET SRLINE=SRLINE_"-"
+4 SET SRT=$PIECE($GET(^SRF(SRTN,.2)),"^",10)
SET (SRSDATE,X1)=$EXTRACT($PIECE(SR(0),"^",9),1,7)
SET X2=30
DO C^%DTC
SET SRENDT=X
SET END=SRENDT+.9999
KILL SRETURN
+5 SET SRCASE=0
FOR
SET SRCASE=$ORDER(^SRF(SRTN,29,SRCASE))
if 'SRCASE
QUIT
Begin DoDot:1
+6 SET CASE=$PIECE(^SRF(SRTN,29,SRCASE,0),"^")
SET SRCT=$PIECE(^SRF(CASE,0),"^",9)
SET SRT1=$PIECE($GET(^SRF(CASE,.2)),"^",10)
+7 IF $EXTRACT(SRCT,1,7)<SRSDATE!(SRCT=$PIECE(SR(0),"^",9))!(SRCT>END)!$PIECE($GET(^SRF(CASE,30)),"^")!$PIECE($GET(^SRF(CASE,31)),"^",8)!$PIECE($GET(^SRF(CASE,37)),"^")
DO DEL
QUIT
+8 IF SRT
IF SRT1
IF SRT>SRT1
DO DEL
End DoDot:1
+9 SET SRCASE=0
FOR
SET SRCASE=$ORDER(^SRF("B",DFN,SRCASE))
if 'SRCASE
QUIT
IF SRCASE'=SRTN
DO CHECK
+10 IF '$ORDER(^SRF(SRTN,29,0))
WRITE !!,"There are no surgical cases entered for "_SRNAME_"",!,"within 30 days of this operation."
GOTO END
RETURN SET SRPAGE="RETURNS TO SURGERY"
DO HDR^SROAUTL
+1 SET (SRCASE,CNT)=0
FOR
SET SRCASE=$ORDER(^SRF(SRTN,29,SRCASE))
if 'SRCASE
QUIT
Begin DoDot:1
+2 SET CNT=CNT+1
SET X=$PIECE(^SRF(SRTN,29,SRCASE,0),"^",3)
IF X=""
SET X="U"
SET $PIECE(^SRF(SRTN,29,SRCASE,0),"^",3)=X
+3 SET SRELATE=$SELECT(X="U":"UNRELATED",1:"RELATED")
SET SRETURN(CNT)=SRCASE_"^"_SRELATE
DO LIST
End DoDot:1
+4 IF '$DATA(SRETURN(2))
SET X=1
DO RELATED
GOTO END
+5 WRITE !,SRLINE,!
PICK WRITE !!,"Select Number: "
READ X:DTIME
IF '$TEST!("^"[X)
SET SRSOUT=1
GOTO END
+1 IF '$DATA(SRETURN(X))
WRITE !!,"Select the number corresponding to the return which you want to update, or",!,"enter RETURN to quit this option.",!!,"Press RETURN to continue "
READ X:DTIME
GOTO RETURN
+2 DO RELATED
GOTO RETURN
DEL ; delete returns
+1 SET DA(1)=SRTN
SET DA=SRCASE
SET DIK="^SRF("_SRTN_",29,"
DO ^DIK
+2 QUIT
CHECK ; add to RETURNS if necessary
+1 if $PIECE($GET(^SRF(SRCASE,"NON")),"^")="Y"!$PIECE($GET(^SRF(SRCASE,37)),"^")
QUIT
SET CAN=$PIECE($GET(^SRF(SRCASE,30)),"^")
IF CAN
QUIT
+2 SET CAN=$PIECE($GET(^SRF(SRCASE,31)),"^",8)
IF CAN'=""
QUIT
+3 SET CON=$PIECE($GET(^SRF(SRTN,"CON")),"^")
IF CON=SRCASE
QUIT
+4 SET DATE=$PIECE(^SRF(SRCASE,0),"^",9)
SET SRT1=$PIECE($GET(^SRF(SRCASE,.2)),"^",10)
IF $EXTRACT(DATE,1,7)<SRSDATE!(DATE>END)!(DATE=$PIECE(SR(0),"^",9))
QUIT
+5 IF SRT
IF SRT1
IF SRT>SRT1
QUIT
+6 IF $DATA(^SRF(SRTN,29,SRCASE,0))
QUIT
+7 IF '$DATA(^SRF(SRTN,29,0))
SET ^SRF(SRTN,29,0)="^130.43PA^^"
+8 KILL DA,DO,DD,DA,DINUM,DIC
SET DA(1)=SRTN
SET DIC="^SRF("_SRTN_",29,"
SET X=SRCASE
SET DINUM=X
SET DIC(0)="L"
SET DLAYGO=130.43
DO FILE^DICN
KILL DD,DO,DIC,DINUM,DLAYGO
+9 SET $PIECE(^SRF(SRTN,29,SRCASE,0),"^",3)="U"
+10 QUIT
LIST ; list returns
+1 SET SROPER=$PIECE(^SRF(SRCASE,"OP"),"^")
+2 SET SROPER=SROPER_" - "_SRELATE
+3 SET DATE=$PIECE(^SRF(SRCASE,0),"^",9)
SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
+4 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<65
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>64
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+5 WRITE !,CNT_".",?3,DATE,?15,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?15,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?15,SROPS(3)
+6 WRITE !
QUIT
LOOP ; break procedures
+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)'<65
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
UPDATE ; update single return
END IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
END1 IF $DATA(SRTN1)
KILL SRTN,SRTN1
+1 DO ^SRSKILL
WRITE @IOF
+2 QUIT
RELATED ; update RELATED/UNRELATED status
+1 SET RETURN=$PIECE(SRETURN(X),"^")
SET SRELATE=$PIECE(SRETURN(X),"^",2)
SET OPPOSITE=$SELECT(SRELATE["U":"RELATED",1:"UNRELATED")
+2 IF $DATA(SRETURN(2))
SET SRPAGE="RETURNS TO SURGERY"
DO HDR^SROAUTL
WRITE !
SET SRCASE=$PIECE(SRETURN(X),"^")
SET CNT=X
DO LIST
WRITE !,SRLINE,!
CHANGE WRITE !!,"This return to surgery is currently defined as "_SRELATE_" to the case selected.",!,"Do you want to change this status ? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+1 SET SRYN=$EXTRACT(SRYN)
IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' to change the status of this return from "_SRELATE_" to "_OPPOSITE_".",!,"Enter 'NO' to leave the information unchanged.",!
GOTO CHANGE
+2 if SRYN=""
SET SRYN="N"
IF "Yy"'[SRYN
QUIT
+3 SET $PIECE(^SRF(SRTN,29,RETURN,0),"^",3)=$EXTRACT(OPPOSITE)
+4 QUIT
