- SROSPEC ;B'HAM ISC/MAM - CASES WITHOUT SPECIMENS ; [ 09/22/98 11:36 AM ]
- ;;3.0; Surgery ;**77,50**;24 Jun 93
- S (SRSOUT,SRSP)=0,SRORD=1 W @IOF,!,"Report of Cases Without Specimens",!
- DATE D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END
- N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))
- SORT G:SRSOUT END W @IOF,!,"Do you want the report sorted by Surgical Specialty ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
- S SRYN=$E(SRYN) S:SRYN="" SRYN="N"
- I "YyNn"'[SRYN W !!,"Enter 'YES' to print this report sorted by surgical specialty or enter RETURN",!,"to not sort by surgical specialty.",!!,"Press RETURN to continue, or '^' to quit: " R X:DTIME S:'$T!(X["^") SRSOUT=1 G SORT
- I "Nn"[SRYN S SRORD=0 G DEV
- SPEC W !!,"Do you want the report for a specific Surgical Specialty ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
- S SRYN=$E(SRYN) I SRYN="" S SRYN="N"
- I "YyNn"'[SRYN W !!,"Enter 'YES' to print this report for a specific surgical specialty, or RETURN",!,"to print the report, sorted by the date of operation, for all specialties.",!!,"Press RETURN to continue " R X:DTIME G SPEC
- I "Yy"[SRYN D SP I SRSOUT G END
- DEV W !!,"This report is designed to use a 132 column format."
- W ! K IOP,POP,IO("Q"),%ZIS S %ZIS="QM",%ZIS("A")="Print the Report on which Device ? " D ^%ZIS I POP S SRSOUT=1 G END
- I $D(IO("Q")) K IO("Q") S ZTDESC="Cases Without Specimens",ZTRTN="EN^SROSPEC",(ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SRORD"),ZTSAVE("SRSP*"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"))="" D ^%ZTLOAD G END
- EN ; entry when queued
- U IO N SRFRTO S Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y S Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y
- I SRORD D ^SROSPSS G END
- D ^SROSPC1
- END I $E(IOST)'="P",'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
- W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
- D ^%ZISC K SRTN D ^SRSKILL W @IOF
- Q
- SP ; select specialty
- W ! S SRSP=1 K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Print the Report of Cases Without Specimens for which Specialty ? " D ^DIC I Y<0 S SRSOUT=1 Q
- S SRSP(+Y)=+Y
- MORE ; more specialties?
- K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select An Additional Specialty: " D ^DIC I Y>0 S SRSP(+Y)=+Y G MORE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROSPEC 2435 printed Mar 13, 2025@21:51:17 Page 2
- SROSPEC ;B'HAM ISC/MAM - CASES WITHOUT SPECIMENS ; [ 09/22/98 11:36 AM ]
- +1 ;;3.0; Surgery ;**77,50**;24 Jun 93
- +2 SET (SRSOUT,SRSP)=0
- SET SRORD=1
- WRITE @IOF,!,"Report of Cases Without Specimens",!
- DATE DO DATE^SROUTL(.SRSD,.SRED,.SRSOUT)
- if SRSOUT
- GOTO END
- +1 NEW SRINSTP
- SET SRINST=$$INST^SROUTL0()
- if SRINST="^"
- GOTO END
- SET SRINSTP=$PIECE(SRINST,U)
- SET SRINST=$SELECT(SRINST["ALL DIVISIONS":SRINST,1:$PIECE(SRINST,U,2))
- SORT if SRSOUT
- GOTO END
- WRITE @IOF,!,"Do you want the report sorted by Surgical Specialty ? NO// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRSOUT=1
- GOTO END
- +1 SET SRYN=$EXTRACT(SRYN)
- if SRYN=""
- SET SRYN="N"
- +2 IF "YyNn"'[SRYN
- WRITE !!,"Enter 'YES' to print this report sorted by surgical specialty or enter RETURN",!,"to not sort by surgical specialty.",!!,"Press RETURN to continue, or '^' to quit: "
- READ X:DTIME
- if '$TEST!(X["^")
- SET SRSOUT=1
- GOTO SORT
- +3 IF "Nn"[SRYN
- SET SRORD=0
- GOTO DEV
- SPEC WRITE !!,"Do you want the report for a specific Surgical Specialty ? NO// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRSOUT=1
- GOTO END
- +1 SET SRYN=$EXTRACT(SRYN)
- IF SRYN=""
- SET SRYN="N"
- +2 IF "YyNn"'[SRYN
- WRITE !!,"Enter 'YES' to print this report for a specific surgical specialty, or RETURN",!,"to print the report, sorted by the date of operation, for all specialties.",!!,"Press RETURN to continue "
- READ X:DTIME
- GOTO SPEC
- +3 IF "Yy"[SRYN
- DO SP
- IF SRSOUT
- GOTO END
- DEV WRITE !!,"This report is designed to use a 132 column format."
- +1 WRITE !
- KILL IOP,POP,IO("Q"),%ZIS
- SET %ZIS="QM"
- SET %ZIS("A")="Print the Report on which Device ? "
- DO ^%ZIS
- IF POP
- SET SRSOUT=1
- GOTO END
- +2 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTDESC="Cases Without Specimens"
- SET ZTRTN="EN^SROSPEC"
- SET (ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SRORD"),ZTSAVE("SRSP*"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"))=""
- DO ^%ZTLOAD
- GOTO END
- EN ; entry when queued
- +1 USE IO
- NEW SRFRTO
- SET Y=DT
- XECUTE ^DD("DD")
- SET SRPRINT="DATE PRINTED: "_Y
- SET Y=SRSD
- XECUTE ^DD("DD")
- SET SRFRTO="FROM: "_Y_" TO: "
- SET Y=SRED
- XECUTE ^DD("DD")
- SET SRFRTO=SRFRTO_Y
- +2 IF SRORD
- DO ^SROSPSS
- GOTO END
- +3 DO ^SROSPC1
- END IF $EXTRACT(IOST)'="P"
- IF 'SRSOUT
- WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- +1 if $EXTRACT(IOST)="P"
- WRITE @IOF
- IF $DATA(ZTQUEUED)
- KILL ^TMP("SR",$JOB)
- if $GET(ZTSTOP)
- QUIT
- SET ZTREQ="@"
- QUIT
- +2 DO ^%ZISC
- KILL SRTN
- DO ^SRSKILL
- WRITE @IOF
- +3 QUIT
- SP ; select specialty
- +1 WRITE !
- SET SRSP=1
- KILL DIC
- SET DIC("S")="I '$P(^(0),""^"",3)"
- SET DIC=137.45
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Print the Report of Cases Without Specimens for which Specialty ? "
- DO ^DIC
- IF Y<0
- SET SRSOUT=1
- QUIT
- +2 SET SRSP(+Y)=+Y
- MORE ; more specialties?
- +1 KILL DIC
- SET DIC("S")="I '$P(^(0),""^"",3)"
- SET DIC=137.45
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Select An Additional Specialty: "
- DO ^DIC
- IF Y>0
- SET SRSP(+Y)=+Y
- GOTO MORE
- +2 QUIT
