SDAMOS1 ;ALB/SCK - AM MGT REPORTS STATISTICS OUTPUT ; 5/14/93
;;5.3;Scheduling;;Aug 13, 1993
;
BLD ; build report from data stored in TMP global
N I,SDFIN,STATUS
S (TC,TA,TI,SDCO,SDAR,SDIP,SDTOT,SDFIN,TCOCNT,TARCNT,TIPCNT)=0,PAGE=1
S SDLST="",SDLST=$O(^TMP("SDAMS",$J,SDLST)),SDFIN=$$HDR(SDLST)
S SDNXT="" F S SDNXT=$O(^TMP("SDAMS",$J,SDNXT)) Q:SDNXT="" D G:SDFIN BLDQ
. I SDNXT'=SDLST S SDFIN=$$HDR(SDNXT) Q:SDFIN S SDLST=SDNXT,(TC,TI,TA)=0
. S NXTSC="" F S NXTSC=$O(^TMP("SDAMS",$J,SDNXT,NXTSC)) Q:NXTSC="" D Q:SDFIN
.. S STATUS=0 F S STATUS=$O(^TMP("SDAMS",$J,SDNXT,NXTSC,STATUS)) Q:'STATUS D Q:SDFIN
... S SDFIN=$$STCNT(STATUS,+^(STATUS)) ; ref to tmp(sdams,$j,div,stocode,status)
.. S SDFIN=$$SUBTOT(NXTSC)
. D TOTALS
D TDIV
BLDQ K SDCO,SDAR,SDIP,SDTOT,TCOCNT,TARCNT,TIPCNT,SDLST,LSTSC,SDNXT,NXTSC,ACTION,QFLAG,TC,TI,TA,TOT,PAGE,SDFIN,%
Q
;
STCNT(STAT,COUNT) ; increment action count for stopcode
; sdar = action req by stop code
; sdco = checked out by stop code
; sdip = in-pat by stop code
;
N Y S Y=0
S:STAT=14 SDAR=SDAR+COUNT
S:STAT=2 SDCO=SDCO+COUNT
S:STAT=8 SDIP=SDIP+COUNT
Q (Y)
;
SUBTOT(SDCODE) ; totals by stopcode
; tcocnt = checked out total by division (per page)
; tarcnt = action req tot by div/page
; tipcnt = In-pat tot by div/page
;
N Y,SDFIN
S Y=0
I $Y+5>IOSL D G:SDFIN SUBTOTQ
. D TOTALS
. S SDFIN=$$HDR(SDNXT) Q:SDFIN
I SDSEL=5 W !,SDCODE,?34,SDCO,?53,SDAR,?64,SDIP,?77,SDCO+SDAR+SDIP
S TCOCNT=TCOCNT+SDCO,TARCNT=TARCNT+SDAR,TIPCNT=TIPCNT+SDIP
S (SDCO,SDAR,SDIP)=0
SUBTOTQ Q (Y)
;
TOTALS ; total of actions by stopcode for division
; tc = check out total for division
; ta = action required tot for div.
; ti = in-pat tot for div.
;
N SDIV
I SDSEL=5 W !,SDTDASH,!,"TOTAL",?34,TCOCNT,?53,TARCNT,?64,TIPCNT,?77,TCOCNT+TARCNT+TIPCNT
S TC=TC+TCOCNT,TA=TA+TARCNT,TI=TI+TIPCNT
S TOT(SDNXT)=TC_U_TA_U_TI
S (TCOCNT,TARCNT,TIPCNT)=0
Q
;
HDR(SDIV) ; page header
N Y
S Y=0
G:SDSEL'=5 HDRQ
D PAUSE
W !!,"Statistics Report by Stop Code"
W !,"Division: ",SDIV,?40,"Date Range ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)
D NOW^%DTC W ?95,"Run Date: ",$E($$FDTTM^VALM1(%),1,14),?125,"Page: ",PAGE S PAGE=PAGE+1
W !," Stop Code",?25,"Checked-Out",?40,"Action Required",?58,"Inpatient",?75,"Total",!,SDASH
HDRQ Q (Y)
;
TDIV ; final totals by division for med center
; reuse tc for check out total by med ctr
; ta for action req tot
; ti for in-pat tot
; tcd = check out totals by div
; tad = action req totals by div
; tip = in-pat totals by div
;
N SDIV,TC,TA,TI,TCD,TAD,TID
S (TC,TA,TI,TCD,TAD,TID)=0
D PAUSE
W !!,"Statistics Report Totals by Division"
W !,"MEDICAL CENTER",?40,"Date Range ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)
D NOW^%DTC W ?95,"Run Date: ",$E($$FDTTM^VALM1(%),1,14),?125,"Page: ",PAGE S PAGE=PAGE+1
W !," Division",?25,"Checked-Out",?40,"Action Required",?58,"Inpatient",?75,"Total"
S SDIV="" F S SDIV=$O(TOT(SDIV)) Q:SDIV="" D
. W !,SDASH
. S TCD=$P(TOT(SDIV),U),TAD=$P(TOT(SDIV),U,2),TID=$P(TOT(SDIV),U,3)
. W !,SDIV,?34,TCD,?54,TAD,?65,TID,?75,TCD+TAD+TID
. S TC=TC+TCD,TA=TA+TAD,TI=TI+TID
W !,SDTDASH
W !,"TOTAL",?34,TC,?54,TA,?65,TI,?75,TC+TA+TI
K TCD,TAD,TID
TDIVQ Q
;
PAUSE ;
I $E(IOST,1,2)="C-" D
. S DIR(0)="FO",DIR("A")="Press RETURN to continue or '^' to exit"
. D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) Q
. W @IOF
E W @IOF
PAUSEQ Q
;
NOREP ; report if no data in TMP global
W !!,"Statistics Report by Stop Code"
W !,"Date Range ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)
D NOW^%DTC W ?95,"Run Date: ",$E($$FDTTM^VALM1(%),1,14),?125,"Page: 1"
W !,SDASH
W !!?10,"No data found matching sort parameters"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMOS1 3854 printed Apr 09, 2024@21:58:35 Page 2
SDAMOS1 ;ALB/SCK - AM MGT REPORTS STATISTICS OUTPUT ; 5/14/93
+1 ;;5.3;Scheduling;;Aug 13, 1993
+2 ;
BLD ; build report from data stored in TMP global
+1 NEW I,SDFIN,STATUS
+2 SET (TC,TA,TI,SDCO,SDAR,SDIP,SDTOT,SDFIN,TCOCNT,TARCNT,TIPCNT)=0
SET PAGE=1
+3 SET SDLST=""
SET SDLST=$ORDER(^TMP("SDAMS",$JOB,SDLST))
SET SDFIN=$$HDR(SDLST)
+4 SET SDNXT=""
FOR
SET SDNXT=$ORDER(^TMP("SDAMS",$JOB,SDNXT))
if SDNXT=""
QUIT
Begin DoDot:1
+5 IF SDNXT'=SDLST
SET SDFIN=$$HDR(SDNXT)
if SDFIN
QUIT
SET SDLST=SDNXT
SET (TC,TI,TA)=0
+6 SET NXTSC=""
FOR
SET NXTSC=$ORDER(^TMP("SDAMS",$JOB,SDNXT,NXTSC))
if NXTSC=""
QUIT
Begin DoDot:2
+7 SET STATUS=0
FOR
SET STATUS=$ORDER(^TMP("SDAMS",$JOB,SDNXT,NXTSC,STATUS))
if 'STATUS
QUIT
Begin DoDot:3
+8 ; ref to tmp(sdams,$j,div,stocode,status)
SET SDFIN=$$STCNT(STATUS,+^(STATUS))
End DoDot:3
if SDFIN
QUIT
+9 SET SDFIN=$$SUBTOT(NXTSC)
End DoDot:2
if SDFIN
QUIT
+10 DO TOTALS
End DoDot:1
if SDFIN
GOTO BLDQ
+11 DO TDIV
BLDQ KILL SDCO,SDAR,SDIP,SDTOT,TCOCNT,TARCNT,TIPCNT,SDLST,LSTSC,SDNXT,NXTSC,ACTION,QFLAG,TC,TI,TA,TOT,PAGE,SDFIN,%
+1 QUIT
+2 ;
STCNT(STAT,COUNT) ; increment action count for stopcode
+1 ; sdar = action req by stop code
+2 ; sdco = checked out by stop code
+3 ; sdip = in-pat by stop code
+4 ;
+5 NEW Y
SET Y=0
+6 if STAT=14
SET SDAR=SDAR+COUNT
+7 if STAT=2
SET SDCO=SDCO+COUNT
+8 if STAT=8
SET SDIP=SDIP+COUNT
+9 QUIT (Y)
+10 ;
SUBTOT(SDCODE) ; totals by stopcode
+1 ; tcocnt = checked out total by division (per page)
+2 ; tarcnt = action req tot by div/page
+3 ; tipcnt = In-pat tot by div/page
+4 ;
+5 NEW Y,SDFIN
+6 SET Y=0
+7 IF $Y+5>IOSL
Begin DoDot:1
+8 DO TOTALS
+9 SET SDFIN=$$HDR(SDNXT)
if SDFIN
QUIT
End DoDot:1
if SDFIN
GOTO SUBTOTQ
+10 IF SDSEL=5
WRITE !,SDCODE,?34,SDCO,?53,SDAR,?64,SDIP,?77,SDCO+SDAR+SDIP
+11 SET TCOCNT=TCOCNT+SDCO
SET TARCNT=TARCNT+SDAR
SET TIPCNT=TIPCNT+SDIP
+12 SET (SDCO,SDAR,SDIP)=0
SUBTOTQ QUIT (Y)
+1 ;
TOTALS ; total of actions by stopcode for division
+1 ; tc = check out total for division
+2 ; ta = action required tot for div.
+3 ; ti = in-pat tot for div.
+4 ;
+5 NEW SDIV
+6 IF SDSEL=5
WRITE !,SDTDASH,!,"TOTAL",?34,TCOCNT,?53,TARCNT,?64,TIPCNT,?77,TCOCNT+TARCNT+TIPCNT
+7 SET TC=TC+TCOCNT
SET TA=TA+TARCNT
SET TI=TI+TIPCNT
+8 SET TOT(SDNXT)=TC_U_TA_U_TI
+9 SET (TCOCNT,TARCNT,TIPCNT)=0
+10 QUIT
+11 ;
HDR(SDIV) ; page header
+1 NEW Y
+2 SET Y=0
+3 if SDSEL'=5
GOTO HDRQ
+4 DO PAUSE
+5 WRITE !!,"Statistics Report by Stop Code"
+6 WRITE !,"Division: ",SDIV,?40,"Date Range ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)
+7 DO NOW^%DTC
WRITE ?95,"Run Date: ",$EXTRACT($$FDTTM^VALM1(%),1,14),?125,"Page: ",PAGE
SET PAGE=PAGE+1
+8 WRITE !," Stop Code",?25,"Checked-Out",?40,"Action Required",?58,"Inpatient",?75,"Total",!,SDASH
HDRQ QUIT (Y)
+1 ;
TDIV ; final totals by division for med center
+1 ; reuse tc for check out total by med ctr
+2 ; ta for action req tot
+3 ; ti for in-pat tot
+4 ; tcd = check out totals by div
+5 ; tad = action req totals by div
+6 ; tip = in-pat totals by div
+7 ;
+8 NEW SDIV,TC,TA,TI,TCD,TAD,TID
+9 SET (TC,TA,TI,TCD,TAD,TID)=0
+10 DO PAUSE
+11 WRITE !!,"Statistics Report Totals by Division"
+12 WRITE !,"MEDICAL CENTER",?40,"Date Range ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)
+13 DO NOW^%DTC
WRITE ?95,"Run Date: ",$EXTRACT($$FDTTM^VALM1(%),1,14),?125,"Page: ",PAGE
SET PAGE=PAGE+1
+14 WRITE !," Division",?25,"Checked-Out",?40,"Action Required",?58,"Inpatient",?75,"Total"
+15 SET SDIV=""
FOR
SET SDIV=$ORDER(TOT(SDIV))
if SDIV=""
QUIT
Begin DoDot:1
+16 WRITE !,SDASH
+17 SET TCD=$PIECE(TOT(SDIV),U)
SET TAD=$PIECE(TOT(SDIV),U,2)
SET TID=$PIECE(TOT(SDIV),U,3)
+18 WRITE !,SDIV,?34,TCD,?54,TAD,?65,TID,?75,TCD+TAD+TID
+19 SET TC=TC+TCD
SET TA=TA+TAD
SET TI=TI+TID
End DoDot:1
+20 WRITE !,SDTDASH
+21 WRITE !,"TOTAL",?34,TC,?54,TA,?65,TI,?75,TC+TA+TI
+22 KILL TCD,TAD,TID
TDIVQ QUIT
+1 ;
PAUSE ;
+1 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+2 SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue or '^' to exit"
+3 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+4 WRITE @IOF
End DoDot:1
+5 IF '$TEST
WRITE @IOF
PAUSEQ QUIT
+1 ;
NOREP ; report if no data in TMP global
+1 WRITE !!,"Statistics Report by Stop Code"
+2 WRITE !,"Date Range ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)
+3 DO NOW^%DTC
WRITE ?95,"Run Date: ",$EXTRACT($$FDTTM^VALM1(%),1,14),?125,"Page: 1"
+4 WRITE !,SDASH
+5 WRITE !!?10,"No data found matching sort parameters"
+6 QUIT
