SRSTCH ;B'HAM ISC/SJA - SCHEDULE REQUESTED CASES ; [ 04/18/03 4:51 PM ]
;;3.0; Surgery ;**114**;24 Jun 93
I '$G(SRTN) Q
N SRFL,SRFLD,SRM,SRP,SRT,SRTNO,SRTNC,SRX,SRY,SRZ,Y
S SRFL=0,SRTNO=SRTN W @IOF D CASE
I $D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" S (SRTN,SRTNC)=$G(^SRF(SRTN,"CON")) D CASE S SRTN=SRTNO
I 'SRFL Q
W ! K DIR S DIR("A")="OK to delete",DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR,SRX
I $D(DTOUT)!$D(DUOUT)!('Y) S SRSOUT=1 Q
DEL W !,"Deleting information..." H 2
F SRM=.21,.22,.23,.24,.205,.232 K SRY S SRY(130,SRTN_",",SRM)="@" D FILE^DIE("","SRY")
I $G(SRTNC) F SRM=.21,.22,.23,.24,.205,.232 K SRY S SRY(130,SRTNC_",",SRM)="@" D FILE^DIE("","SRY")
Q
CASE ; display list of entered items
K SRX,SRY
S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I",DR=".21;.22;.23;.24;.205;.232" D EN^DIQ1 K DA,DIC,DIQ,DR
S SRZ=0 F S SRZ=$O(SRY(130,SRTN,SRZ)) Q:'SRZ I SRY(130,SRTN,SRZ,"I")'="" D TR S SRT=$T(@SRP),SRFLD=$P(SRT,";;",2),SRX(SRZ)=$P(SRFLD,"^",2)
Q:'$D(SRX)
W !!,"The following information for case #"_SRTN_" and must be removed before continuing:",!
F SRZ=.21,.22,.23,.24,.205,.232 I $G(SRX(SRZ))'="" S SRFL=1 W !,?5,SRX(SRZ)
Q
TR S SRP=SRZ,SRP=$TR(SRP,"1234567890.,","ABCDEFGHIJPK")
Q
PBA ;;.21^ANES CARE START TIME
PBB ;;.22^TIME OPERATION BEGAN
PBC ;;.23^TIME OPERATION ENDS
PBD ;;.24^ANES CARE END TIME
PBJE ;;.205^TIME PAT IN OR
PBCB ;;.232^TIME PAT OUT OR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSTCH 1413 printed Oct 16, 2024@18:48:24 Page 2
SRSTCH ;B'HAM ISC/SJA - SCHEDULE REQUESTED CASES ; [ 04/18/03 4:51 PM ]
+1 ;;3.0; Surgery ;**114**;24 Jun 93
+2 IF '$GET(SRTN)
QUIT
+3 NEW SRFL,SRFLD,SRM,SRP,SRT,SRTNO,SRTNC,SRX,SRY,SRZ,Y
+4 SET SRFL=0
SET SRTNO=SRTN
WRITE @IOF
DO CASE
+5 IF $DATA(^SRF(SRTN,"CON"))
IF $PIECE(^("CON"),"^")'=""
SET (SRTN,SRTNC)=$GET(^SRF(SRTN,"CON"))
DO CASE
SET SRTN=SRTNO
+6 IF 'SRFL
QUIT
+7 WRITE !
KILL DIR
SET DIR("A")="OK to delete"
SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
KILL DIR,SRX
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!('Y)
SET SRSOUT=1
QUIT
DEL WRITE !,"Deleting information..."
HANG 2
+1 FOR SRM=.21,.22,.23,.24,.205,.232
KILL SRY
SET SRY(130,SRTN_",",SRM)="@"
DO FILE^DIE("","SRY")
+2 IF $GET(SRTNC)
FOR SRM=.21,.22,.23,.24,.205,.232
KILL SRY
SET SRY(130,SRTNC_",",SRM)="@"
DO FILE^DIE("","SRY")
+3 QUIT
CASE ; display list of entered items
+1 KILL SRX,SRY
+2 SET DIC="^SRF("
SET DA=SRTN
SET DIQ="SRY"
SET DIQ(0)="I"
SET DR=".21;.22;.23;.24;.205;.232"
DO EN^DIQ1
KILL DA,DIC,DIQ,DR
+3 SET SRZ=0
FOR
SET SRZ=$ORDER(SRY(130,SRTN,SRZ))
if 'SRZ
QUIT
IF SRY(130,SRTN,SRZ,"I")'=""
DO TR
SET SRT=$TEXT(@SRP)
SET SRFLD=$PIECE(SRT,";;",2)
SET SRX(SRZ)=$PIECE(SRFLD,"^",2)
+4 if '$DATA(SRX)
QUIT
+5 WRITE !!,"The following information for case #"_SRTN_" and must be removed before continuing:",!
+6 FOR SRZ=.21,.22,.23,.24,.205,.232
IF $GET(SRX(SRZ))'=""
SET SRFL=1
WRITE !,?5,SRX(SRZ)
+7 QUIT
TR SET SRP=SRZ
SET SRP=$TRANSLATE(SRP,"1234567890.,","ABCDEFGHIJPK")
+1 QUIT
PBA ;;.21^ANES CARE START TIME
PBB ;;.22^TIME OPERATION BEGAN
PBC ;;.23^TIME OPERATION ENDS
PBD ;;.24^ANES CARE END TIME
PBJE ;;.205^TIME PAT IN OR
PBCB ;;.232^TIME PAT OUT OR
