SROADOC ;B'HAM ISC/MAM - ANESTHESIA PROVIDER REPORT; [ 09/22/98 11:23 AM ]
;;3.0; Surgery ;**77,50**;24 Jun 93
SETUTL ; set up ^TMP("SR",$J
Q:'$D(^SRF(SRTN,.3)) Q:$P(^(.3),"^")="" I SRPROV,$P(^(.3),"^")'=SRPROV Q
S SRPRIN=$P(^VA(200,$P(^SRF(SRTN,.3),"^"),0),"^"),SRSDT=$P(^SRF(SRTN,0),"^",9) S ^TMP("SR",$J,SRPRIN,SRSDT,SRTN)=""
Q
END W ! D ^SRSKILL K SRTN D ^%ZISC W @IOF
Q
CODES ; print technique code at bottom of page
W ! F LINE=1:1:IOM W "-"
W !,"SUPERVISOR CODES: 1-STAFF CASE, 2-STAFF ASSISTED BY RESIDENT OR C.R.N.A., 3-STAFF ASSISTING C.R.N.A., 4-STAFF ASSISTING RESIDENT"
W !,?18,"5-STAFF CONSULTING IN OR, 6-STAFF AVAILABLE IN OR SUITE, 7-STAFF AVAILABLE IN HOSP./UNIV. COMPLEX",!,?18,"8-STAFF CALLED FOR EMERGENCY, 9-C.R.N.A. INDEPENDENT DUTY MD/DDS SUP.",!
Q
EN ;
W @IOF,!,"Anesthesia Provider Report"
D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END
SORT W !!!,"Do you want to print the report for all Anesthesia Providers ? YES// " R SRYN:DTIME I '$T!(SRYN["^") G END
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
I "Yy"[SRYN S SRPROV="" G DEVICE
I "Nn"'[SRYN W !!,"Enter RETURN to print the report for all anesthesia providers, or 'NO'",!,"to select a specific anesthesia provider." G SORT
W !! K DIC S DIC=200,DIC(0)="QEAMZ",DIC("A")="Print the report for which Anesthesia Provider ? " D ^DIC K DIC I Y<0 G END
S SRPROV=+Y,SRPRO=$P(Y(0),"^")
DEVICE K IOP,%ZIS,POP S %ZIS("A")="Print the Report on which Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS G:POP END
I $D(IO("Q")) K IO("Q") S ZTDESC="ANESTHESIA PROVIDER REPORT",ZTRTN="BEG^SROADOC",ZTSAVE("SRSD")=SRSD,ZTSAVE("SRED")=SRED,(ZTSAVE("SRPRO*"),ZTSAVE("SRSITE*"))="" D ^%ZTLOAD G END
BEG ;
U IO K ^TMP("SR",$J) S SRF=0,PAGE=1,DATE=SRSD-.0001,EDATE=SRED+.9999,SRINST=SRSITE("SITE"),Y=DT X ^DD("DD") S SRPRINT=Y
N SRFRTO S Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: " S Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y
F S DATE=$O(^SRF("AC",DATE)) Q:DATE>EDATE!(DATE="")!SRF S SRTN=0 F S SRTN=$O(^SRF("AC",DATE,SRTN)) Q:SRTN="" I $D(^SRF(SRTN,0)),$P($G(^SRF(SRTN,.2)),"^",12)'=""!($P($G(^SRF(SRTN,"NON")),"^")="Y"),$$DIV^SROUTL0(SRTN) D SETUTL
G PR^SROADOC1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROADOC 2209 printed Apr 09, 2024@21:41:48 Page 2
SROADOC ;B'HAM ISC/MAM - ANESTHESIA PROVIDER REPORT; [ 09/22/98 11:23 AM ]
+1 ;;3.0; Surgery ;**77,50**;24 Jun 93
SETUTL ; set up ^TMP("SR",$J
+1 if '$DATA(^SRF(SRTN,.3))
QUIT
if $PIECE(^(.3),"^")=""
QUIT
IF SRPROV
IF $PIECE(^(.3),"^")'=SRPROV
QUIT
+2 SET SRPRIN=$PIECE(^VA(200,$PIECE(^SRF(SRTN,.3),"^"),0),"^")
SET SRSDT=$PIECE(^SRF(SRTN,0),"^",9)
SET ^TMP("SR",$JOB,SRPRIN,SRSDT,SRTN)=""
+3 QUIT
END WRITE !
DO ^SRSKILL
KILL SRTN
DO ^%ZISC
WRITE @IOF
+1 QUIT
CODES ; print technique code at bottom of page
+1 WRITE !
FOR LINE=1:1:IOM
WRITE "-"
+2 WRITE !,"SUPERVISOR CODES: 1-STAFF CASE, 2-STAFF ASSISTED BY RESIDENT OR C.R.N.A., 3-STAFF ASSISTING C.R.N.A., 4-STAFF ASSISTING RESIDENT"
+3 WRITE !,?18,"5-STAFF CONSULTING IN OR, 6-STAFF AVAILABLE IN OR SUITE, 7-STAFF AVAILABLE IN HOSP./UNIV. COMPLEX",!,?18,"8-STAFF CALLED FOR EMERGENCY, 9-C.R.N.A. INDEPENDENT DUTY MD/DDS SUP.",!
+4 QUIT
EN ;
+1 WRITE @IOF,!,"Anesthesia Provider Report"
+2 DO DATE^SROUTL(.SRSD,.SRED,.SRSOUT)
if SRSOUT
GOTO END
SORT WRITE !!!,"Do you want to print the report for all Anesthesia Providers ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
GOTO END
+1 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
+2 IF "Yy"[SRYN
SET SRPROV=""
GOTO DEVICE
+3 IF "Nn"'[SRYN
WRITE !!,"Enter RETURN to print the report for all anesthesia providers, or 'NO'",!,"to select a specific anesthesia provider."
GOTO SORT
+4 WRITE !!
KILL DIC
SET DIC=200
SET DIC(0)="QEAMZ"
SET DIC("A")="Print the report for which Anesthesia Provider ? "
DO ^DIC
KILL DIC
IF Y<0
GOTO END
+5 SET SRPROV=+Y
SET SRPRO=$PIECE(Y(0),"^")
DEVICE KILL IOP,%ZIS,POP
SET %ZIS("A")="Print the Report on which Device: "
SET %ZIS="QM"
WRITE !!,"This report is designed to use a 132 column format.",!
DO ^%ZIS
if POP
GOTO END
+1 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="ANESTHESIA PROVIDER REPORT"
SET ZTRTN="BEG^SROADOC"
SET ZTSAVE("SRSD")=SRSD
SET ZTSAVE("SRED")=SRED
SET (ZTSAVE("SRPRO*"),ZTSAVE("SRSITE*"))=""
DO ^%ZTLOAD
GOTO END
BEG ;
+1 USE IO
KILL ^TMP("SR",$JOB)
SET SRF=0
SET PAGE=1
SET DATE=SRSD-.0001
SET EDATE=SRED+.9999
SET SRINST=SRSITE("SITE")
SET Y=DT
XECUTE ^DD("DD")
SET SRPRINT=Y
+2 NEW SRFRTO
SET Y=SRSD
XECUTE ^DD("DD")
SET SRFRTO="FROM: "_Y_" TO: "
SET Y=SRED
XECUTE ^DD("DD")
SET SRFRTO=SRFRTO_Y
+3 FOR
SET DATE=$ORDER(^SRF("AC",DATE))
if DATE>EDATE!(DATE="")!SRF
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",DATE,SRTN))
if SRTN=""
QUIT
IF $DATA(^SRF(SRTN,0))
IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)'=""!($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y")
IF $$DIV^SROUTL0(SRTN)
DO SETUTL
+4 GOTO PR^SROADOC1
