- 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 Feb 19, 2025@00:08:21 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