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 Apr 09, 2024@21:49:26 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
