- 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 Feb 19, 2025@00:14:15 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