- 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 Feb 19, 2025@00:06:23 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