SROABCH ;BIR/MAM - BATCH PRINT ASSESSMENTS ;11/28/07
;;3.0; Surgery ;**77,166**;24 Jun 93;Build 6
DATE ; get dates
S (SRSOUT,SRSP)=0 W @IOF,!!,"This report will print all completed or transmitted assessments that have a",!,"date of operation within the date range selected.",!
D DATE^SROUTL(.SRASTDT,.SRAENDT,.SRSOUT) G:SRSOUT END
D SPEC
W !!,"Depending on the date range entered, this report may be very long. You should",!,"QUEUE this report to the selected printer.",!
K %ZIS,IOP,POP,IO("Q") S %ZIS="Q",%ZIS("A")="Print on which Device: " D ^%ZIS S:POP SRSOUT=1 G:POP END
I $D(IO("Q")) K IO("Q") S ZTRTN="EN^SROABCH",(ZTSAVE("SRSITE*"),ZTSAVE("SRASTDT"),ZTSAVE("SRAENDT"),ZTSAVE("SRSP"))="",ZTDESC="Batch Print Risk Assessments" D ^%ZTLOAD S SRSOUT=1 G END
EN ; entry when queued
S SRSOUT=0,SRABATCH=1
U IO S SRAENDT=SRAENDT+.9999,SDATE=SRASTDT-.0001 F S SDATE=$O(^SRF("AC",SDATE)) Q:'SDATE!(SDATE>SRAENDT)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SDATE,SRTN)) Q:'SRTN!SRSOUT D STUFF
END I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
D ^%ZISC K SRTN W @IOF D ^SRSKILL
Q
STUFF ;
I SRSP,$P(^SRF(SRTN,0),"^",4)'=SRSP Q
S DATE=$P(^SRF(SRTN,0),"^",9)
S SR("RA")=$G(^SRF(SRTN,"RA")),X=$P(SR("RA"),"^") I X'="T",X'="C" Q
I $P(SR("RA"),"^",6)'="Y" Q
K SRA D ^SROAPAS
Q
SPEC ; select specialty
W ! K DIR S DIR(0)="YA",DIR("A")="Print report for ALL surgical specialties ? ",DIR("B")="YES"
S DIR("?",1)="Enter YES to print the report for all surgical specialties, or NO to",DIR("?")="print the report for a specific surgical specialty."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
I 'Y W ! K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC("A")="Print the Report for which Surgical Specialty: ",DIC=137.45,DIC(0)="QEAMZ" D ^DIC K DIC S:Y<0 SRSOUT=1 Q:Y<0 S SRSP=+Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROABCH 1808 printed Dec 13, 2024@02:39:53 Page 2
SROABCH ;BIR/MAM - BATCH PRINT ASSESSMENTS ;11/28/07
+1 ;;3.0; Surgery ;**77,166**;24 Jun 93;Build 6
DATE ; get dates
+1 SET (SRSOUT,SRSP)=0
WRITE @IOF,!!,"This report will print all completed or transmitted assessments that have a",!,"date of operation within the date range selected.",!
+2 DO DATE^SROUTL(.SRASTDT,.SRAENDT,.SRSOUT)
if SRSOUT
GOTO END
+3 DO SPEC
+4 WRITE !!,"Depending on the date range entered, this report may be very long. You should",!,"QUEUE this report to the selected printer.",!
+5 KILL %ZIS,IOP,POP,IO("Q")
SET %ZIS="Q"
SET %ZIS("A")="Print on which Device: "
DO ^%ZIS
if POP
SET SRSOUT=1
if POP
GOTO END
+6 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="EN^SROABCH"
SET (ZTSAVE("SRSITE*"),ZTSAVE("SRASTDT"),ZTSAVE("SRAENDT"),ZTSAVE("SRSP"))=""
SET ZTDESC="Batch Print Risk Assessments"
DO ^%ZTLOAD
SET SRSOUT=1
GOTO END
EN ; entry when queued
+1 SET SRSOUT=0
SET SRABATCH=1
+2 USE IO
SET SRAENDT=SRAENDT+.9999
SET SDATE=SRASTDT-.0001
FOR
SET SDATE=$ORDER(^SRF("AC",SDATE))
if 'SDATE!(SDATE>SRAENDT)!SRSOUT
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SDATE,SRTN))
if 'SRTN!SRSOUT
QUIT
DO STUFF
END IF $DATA(ZTQUEUED)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+1 DO ^%ZISC
KILL SRTN
WRITE @IOF
DO ^SRSKILL
+2 QUIT
STUFF ;
+1 IF SRSP
IF $PIECE(^SRF(SRTN,0),"^",4)'=SRSP
QUIT
+2 SET DATE=$PIECE(^SRF(SRTN,0),"^",9)
+3 SET SR("RA")=$GET(^SRF(SRTN,"RA"))
SET X=$PIECE(SR("RA"),"^")
IF X'="T"
IF X'="C"
QUIT
+4 IF $PIECE(SR("RA"),"^",6)'="Y"
QUIT
+5 KILL SRA
DO ^SROAPAS
+6 QUIT
SPEC ; select specialty
+1 WRITE !
KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Print report for ALL surgical specialties ? "
SET DIR("B")="YES"
+2 SET DIR("?",1)="Enter YES to print the report for all surgical specialties, or NO to"
SET DIR("?")="print the report for a specific surgical specialty."
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+4 IF 'Y
WRITE !
KILL DIC
SET DIC("S")="I '$P(^(0),""^"",3)"
SET DIC("A")="Print the Report for which Surgical Specialty: "
SET DIC=137.45
SET DIC(0)="QEAMZ"
DO ^DIC
KILL DIC
if Y<0
SET SRSOUT=1
if Y<0
QUIT
SET SRSP=+Y
+5 QUIT
