SRSCHUP ;B'HAM ISC/MAM - UPDATE SCHEDULED OPERATION ; 6 Jan 1989 10:56 AM
;;3.0; Surgery ;**7**;24 Jun 93
W ! K DIC S SRSOUT=0,DIC=2,DIC(0)="AEQM",DIC("A")="Select Patient: " D ^DIC K DIC I Y<0 S SRSOUT=1 G END
S (DFN,SRSDPT)=+Y K Y D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID"),SRNAME=VADM(1)_" ("_VA("PID")_")"
LOOK W @IOF,!,SRNAME,!! S (SRTN,CNT)=0 F I=0:0 S SRTN=$O(^SRF("B",DFN,SRTN)) Q:SRTN="" S CNT=CNT+1,SROP1(CNT)=SRTN D LIST
I '$D(SROP1(1)) D DEM^VADPT W !!,"There are no procedures scheduled for "_VADM(1)_".",!! W !!,"Press RETURN to continue " R X:DTIME G END
ASK R !!,"Select Number: ",SRNUM:DTIME I '$T!("^"[SRNUM) G END
I SRNUM["?" W !!,"Enter the number which corresponds to the case that you want to update." G ASK
I '$D(SROP1(SRNUM)) W !!,"You have entered an invalid number, please select again. " G ASK
S SRTN=SROP1(SRNUM) I $P(^SRF(SRTN,0),"^",4)="" D SS I SRSOUT G END
G ^SRSUP1
END D ^SRSKILL K SRTN
W @IOF
Q
OTHER ; other operations
S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>235 S SRLONG=0,OPER=999,SROPERS=" ..."
I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
Q
LIST ; list cases
S SRSDATE=$P(^SRF(SRTN,0),"^",9),SRSDATE=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)
OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F I=0:0 S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
S SROP=SRTN D ^SROP1
I SROPER'["SCHEDULED" K SROP1(CNT) S CNT=CNT-1 Q
K SROPS,MM,MMM S:$L(SROPER)<60 SROPS(1)=SROPER I $L(SROPER)>59 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
W !,CNT_". "_SRSDATE,?15,SROPS(1) I $D(SROPS(2)) W !,?15,SROPS(2) I $D(SROPS(3)) W !,?15,SROPS(3) I $D(SROPS(4)) W !,?15,SROPS(4) I $D(SROPS(5)) W !,?15,SROPS(5)
Q
LOOP ; break procedure if greater than 60 characters
S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<60 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
SS ; enter missing specialty
W !!,"To continue, a Surgical Specialty MUST be defined for this case.",! K DA,DIE,DR S DIE=130,DA=SRTN,DR=".04T" D ^DIE I $D(Y)!$D(DTOUT) S SRSOUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHUP 2159 printed Oct 16, 2024@18:47:59 Page 2
SRSCHUP ;B'HAM ISC/MAM - UPDATE SCHEDULED OPERATION ; 6 Jan 1989 10:56 AM
+1 ;;3.0; Surgery ;**7**;24 Jun 93
+2 WRITE !
KILL DIC
SET SRSOUT=0
SET DIC=2
SET DIC(0)="AEQM"
SET DIC("A")="Select Patient: "
DO ^DIC
KILL DIC
IF Y<0
SET SRSOUT=1
GOTO END
+3 SET (DFN,SRSDPT)=+Y
KILL Y
DO DEM^VADPT
SET SRNM=VADM(1)
SET SRSSN=VA("PID")
SET SRNAME=VADM(1)_" ("_VA("PID")_")"
LOOK WRITE @IOF,!,SRNAME,!!
SET (SRTN,CNT)=0
FOR I=0:0
SET SRTN=$ORDER(^SRF("B",DFN,SRTN))
if SRTN=""
QUIT
SET CNT=CNT+1
SET SROP1(CNT)=SRTN
DO LIST
+1 IF '$DATA(SROP1(1))
DO DEM^VADPT
WRITE !!,"There are no procedures scheduled for "_VADM(1)_".",!!
WRITE !!,"Press RETURN to continue "
READ X:DTIME
GOTO END
ASK READ !!,"Select Number: ",SRNUM:DTIME
IF '$TEST!("^"[SRNUM)
GOTO END
+1 IF SRNUM["?"
WRITE !!,"Enter the number which corresponds to the case that you want to update."
GOTO ASK
+2 IF '$DATA(SROP1(SRNUM))
WRITE !!,"You have entered an invalid number, please select again. "
GOTO ASK
+3 SET SRTN=SROP1(SRNUM)
IF $PIECE(^SRF(SRTN,0),"^",4)=""
DO SS
IF SRSOUT
GOTO END
+4 GOTO ^SRSUP1
END DO ^SRSKILL
KILL SRTN
+1 WRITE @IOF
+2 QUIT
OTHER ; other operations
+1 SET SRLONG=1
IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRTN,13,OPER,0),"^"))>235
SET SRLONG=0
SET OPER=999
SET SROPERS=" ..."
+2 IF SRLONG
SET SROPERS=$PIECE(^SRF(SRTN,13,OPER,0),"^")
+3 SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)
+4 QUIT
LIST ; list cases
+1 SET SRSDATE=$PIECE(^SRF(SRTN,0),"^",9)
SET SRSDATE=$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3)
OPS SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
SET OPER=0
FOR I=0:0
SET OPER=$ORDER(^SRF(SRTN,13,OPER))
if OPER=""
QUIT
DO OTHER
+1 SET SROP=SRTN
DO ^SROP1
+2 IF SROPER'["SCHEDULED"
KILL SROP1(CNT)
SET CNT=CNT-1
QUIT
+3 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<60
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>59
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+4 WRITE !,CNT_". "_SRSDATE,?15,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?15,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?15,SROPS(3)
IF $DATA(SROPS(4))
WRITE !,?15,SROPS(4)
IF $DATA(SROPS(5))
WRITE !,?15,SROPS(5)
+5 QUIT
LOOP ; break procedure if greater than 60 characters
+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)'<60
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
SS ; enter missing specialty
+1 WRITE !!,"To continue, a Surgical Specialty MUST be defined for this case.",!
KILL DA,DIE,DR
SET DIE=130
SET DA=SRTN
SET DR=".04T"
DO ^DIE
IF $DATA(Y)!$DATA(DTOUT)
SET SRSOUT=1
+2 QUIT
