Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROARET

SROARET.m

Go to the documentation of this file.
  1. 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
  1. I '$D(SRTN) S SRTN1=1 D ^SROPS I '$D(SRTN) S SRSOUT=1 G END1
  1. 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_"-"
  1. 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
  1. S SRCASE=0 F S SRCASE=$O(^SRF(SRTN,29,SRCASE)) Q:'SRCASE D
  1. .S CASE=$P(^SRF(SRTN,29,SRCASE,0),"^"),SRCT=$P(^SRF(CASE,0),"^",9),SRT1=$P($G(^SRF(CASE,.2)),"^",10)
  1. .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
  1. .I SRT,SRT1,SRT>SRT1 D DEL
  1. S SRCASE=0 F S SRCASE=$O(^SRF("B",DFN,SRCASE)) Q:'SRCASE I SRCASE'=SRTN D CHECK
  1. I '$O(^SRF(SRTN,29,0)) W !!,"There are no surgical cases entered for "_SRNAME_"",!,"within 30 days of this operation." G END
  1. RETURN S SRPAGE="RETURNS TO SURGERY" D HDR^SROAUTL
  1. S (SRCASE,CNT)=0 F S SRCASE=$O(^SRF(SRTN,29,SRCASE)) Q:'SRCASE D
  1. .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
  1. .S SRELATE=$S(X="U":"UNRELATED",1:"RELATED"),SRETURN(CNT)=SRCASE_"^"_SRELATE D LIST
  1. I '$D(SRETURN(2)) S X=1 D RELATED G END
  1. W !,SRLINE,!
  1. PICK W !!,"Select Number: " R X:DTIME I '$T!("^"[X) S SRSOUT=1 G END
  1. 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
  1. D RELATED G RETURN
  1. DEL ; delete returns
  1. S DA(1)=SRTN,DA=SRCASE,DIK="^SRF("_SRTN_",29," D ^DIK
  1. Q
  1. CHECK ; add to RETURNS if necessary
  1. Q:$P($G(^SRF(SRCASE,"NON")),"^")="Y"!$P($G(^SRF(SRCASE,37)),"^") S CAN=$P($G(^SRF(SRCASE,30)),"^") I CAN Q
  1. S CAN=$P($G(^SRF(SRCASE,31)),"^",8) I CAN'="" Q
  1. S CON=$P($G(^SRF(SRTN,"CON")),"^") I CON=SRCASE Q
  1. 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
  1. I SRT,SRT1,SRT>SRT1 Q
  1. I $D(^SRF(SRTN,29,SRCASE,0)) Q
  1. I '$D(^SRF(SRTN,29,0)) S ^SRF(SRTN,29,0)="^130.43PA^^"
  1. 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
  1. S $P(^SRF(SRTN,29,SRCASE,0),"^",3)="U"
  1. Q
  1. LIST ; list returns
  1. S SROPER=$P(^SRF(SRCASE,"OP"),"^")
  1. S SROPER=SROPER_" - "_SRELATE
  1. S DATE=$P(^SRF(SRCASE,0),"^",9),DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
  1. 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=""
  1. W !,CNT_".",?3,DATE,?15,SROPS(1) I $D(SROPS(2)) W !,?15,SROPS(2) I $D(SROPS(3)) W !,?15,SROPS(3)
  1. W ! Q
  1. LOOP ; break procedures
  1. 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
  1. Q
  1. UPDATE ; update single return
  1. END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
  1. END1 I $D(SRTN1) K SRTN,SRTN1
  1. D ^SRSKILL W @IOF
  1. Q
  1. S RETURN=$P(SRETURN(X),"^"),SRELATE=$P(SRETURN(X),"^",2),OPPOSITE=$S(SRELATE["U":"RELATED",1:"UNRELATED")
  1. I $D(SRETURN(2)) S SRPAGE="RETURNS TO SURGERY" D HDR^SROAUTL W ! S SRCASE=$P(SRETURN(X),"^"),CNT=X D LIST W !,SRLINE,!
  1. 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
  1. 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
  1. S:SRYN="" SRYN="N" I "Yy"'[SRYN Q
  1. S $P(^SRF(SRTN,29,RETURN,0),"^",3)=$E(OPPOSITE)
  1. Q