- SROATT0 ;B'HAM ISC/MAM - ATTENDING SURGEON REPORT (1 SURGEON) ; [ 05/11/04 2:33 PM ]
- ;;3.0; Surgery ;**50,129**;24 Jun 93
- W !! K DIC S DIC=200,DIC(0)="QEAMZ",DIC("A")="Print the Report for which Attending Surgeon ? " D ^DIC I Y<0 S SRSOUT=1 G END
- S SRATT=+Y
- REPORT W !!,"Do you want to view the totals for attending codes only ? 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 RETURN to dispay individual case information and the total number of",!,"cases for each code. If you only want to display the totals for the attending",!,"codes, enter 'YES'." G REPORT
- S SRBOTH=1 I "Yy"[SRYN S SRBOTH=0
- W:SRBOTH !!,"This report is designed to use a 132 column format."
- W:'SRBOTH !!,"This report is designed to use an 80 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="Attending Surgeon Report",ZTRTN="EN^SROATT0",(ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SRATT"),ZTSAVE("SRBOTH"),ZTSAVE("SRSITE*"))="" D ^%ZTLOAD G END
- EN ; entry when queued
- U IO S SRSOUT=0,SRINST=SRSITE("SITE"),SRINSTP=SRSITE("DIV"),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
- K ^TMP("SR",$J),^TMP("SRTOT",$J)
- S ^TMP("SRTOT",$J)=0,^TMP("SRTOT",$J,"ZZ")=0
- S SRSDATE=SRSD-.0001,SREDT=SRED+.9999 F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>SREDT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D UTIL
- S SRATT="ATTENDING SURGEON: "_$P(^VA(200,SRATT,0),"^"),SRATT1="" F LINE=1:1:$L(SRATT) S SRATT1=SRATT1_"-"
- I SRBOTH D ^SROAT0P G:SRSOUT END
- D ^SROAT0T
- END I $E(IOST)'="P",'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
- W:$E(IOST)="P" @IOF K ^TMP("SRTOT",$J) I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
- D ^%ZISC K SRTN D ^SRSKILL W @IOF
- Q
- UTIL I '$D(^SRF(SRTN,.2))!'$D(^SRF(SRTN,.1)) Q
- I '$P(^SRF(SRTN,.2),"^",12) Q
- S X=$P(^SRF(SRTN,.1),"^",13) I X'=SRATT Q
- S SRCODE=$P(^SRF(SRTN,.1),"^",10) S:SRCODE="" SRCODE="ZZ"
- I '$D(^TMP("SRTOT",$J,SRCODE)) S ^TMP("SRTOT",$J,SRCODE)=0
- S ^TMP("SR",$J,SRSDATE,SRTN)="",^TMP("SRTOT",$J)=^TMP("SRTOT",$J)+1,^TMP("SRTOT",$J,SRCODE)=^TMP("SRTOT",$J,SRCODE)+1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROATT0 2366 printed Feb 19, 2025@00:08:46 Page 2
- SROATT0 ;B'HAM ISC/MAM - ATTENDING SURGEON REPORT (1 SURGEON) ; [ 05/11/04 2:33 PM ]
- +1 ;;3.0; Surgery ;**50,129**;24 Jun 93
- +2 WRITE !!
- KILL DIC
- SET DIC=200
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Print the Report for which Attending Surgeon ? "
- DO ^DIC
- IF Y<0
- SET SRSOUT=1
- GOTO END
- +3 SET SRATT=+Y
- REPORT WRITE !!,"Do you want to view the totals for attending codes only ? 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 RETURN to dispay individual case information and the total number of",!,"cases for each code. If you only want to display the totals for the attending",!,"codes, enter 'YES'."
- GOTO REPORT
- +3 SET SRBOTH=1
- IF "Yy"[SRYN
- SET SRBOTH=0
- +4 if SRBOTH
- WRITE !!,"This report is designed to use a 132 column format."
- +5 if 'SRBOTH
- WRITE !!,"This report is designed to use an 80 column format."
- +6 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
- +7 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTDESC="Attending Surgeon Report"
- SET ZTRTN="EN^SROATT0"
- SET (ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SRATT"),ZTSAVE("SRBOTH"),ZTSAVE("SRSITE*"))=""
- DO ^%ZTLOAD
- GOTO END
- EN ; entry when queued
- +1 USE IO
- SET SRSOUT=0
- SET SRINST=SRSITE("SITE")
- SET SRINSTP=SRSITE("DIV")
- 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 KILL ^TMP("SR",$JOB),^TMP("SRTOT",$JOB)
- +3 SET ^TMP("SRTOT",$JOB)=0
- SET ^TMP("SRTOT",$JOB,"ZZ")=0
- +4 SET SRSDATE=SRSD-.0001
- SET SREDT=SRED+.9999
- FOR
- SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
- if 'SRSDATE!(SRSDATE>SREDT)
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
- if 'SRTN
- QUIT
- IF $DATA(^SRF(SRTN,0))
- IF $$DIV^SROUTL0(SRTN)
- DO UTIL
- +5 SET SRATT="ATTENDING SURGEON: "_$PIECE(^VA(200,SRATT,0),"^")
- SET SRATT1=""
- FOR LINE=1:1:$LENGTH(SRATT)
- SET SRATT1=SRATT1_"-"
- +6 IF SRBOTH
- DO ^SROAT0P
- if SRSOUT
- GOTO END
- +7 DO ^SROAT0T
- END IF $EXTRACT(IOST)'="P"
- IF 'SRSOUT
- WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- +1 if $EXTRACT(IOST)="P"
- WRITE @IOF
- KILL ^TMP("SRTOT",$JOB)
- 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
- UTIL IF '$DATA(^SRF(SRTN,.2))!'$DATA(^SRF(SRTN,.1))
- QUIT
- +1 IF '$PIECE(^SRF(SRTN,.2),"^",12)
- QUIT
- +2 SET X=$PIECE(^SRF(SRTN,.1),"^",13)
- IF X'=SRATT
- QUIT
- +3 SET SRCODE=$PIECE(^SRF(SRTN,.1),"^",10)
- if SRCODE=""
- SET SRCODE="ZZ"
- +4 IF '$DATA(^TMP("SRTOT",$JOB,SRCODE))
- SET ^TMP("SRTOT",$JOB,SRCODE)=0
- +5 SET ^TMP("SR",$JOB,SRSDATE,SRTN)=""
- SET ^TMP("SRTOT",$JOB)=^TMP("SRTOT",$JOB)+1
- SET ^TMP("SRTOT",$JOB,SRCODE)=^TMP("SRTOT",$JOB,SRCODE)+1