SDAMOWP ;ALB/CAW - Appointment Waiting Time Print Routine ; 12/1/91
;;5.3;Scheduling;**12,1015**;Aug 13, 1993;Build 21
;
PRINT ; -- print arrays
; var defined:
; SDSUB2 := top level sort after Division (clinic,stop cd,patient)
; SDSUB3 := next level sort
;
U IO N SDQUIT,SDDIV,SDROU,SDCLN,SDPAT,SDSTP,SDNO,LEVEL1
S (SDQUIT,SDDIV,SDCLN,SDPAT,SDATE,SDSTP)=""
I $O(^TMP("SDWAIT",$J,SDDIV))="" S LEVEL1=0,SDNO=1 D HDR^SDAMOWP1 D G PRINTQ
.W !!?5,"No appointments to report."
.D:$E(IOST,1,2)="C-" PAUSE^VALM1
;
F S SDDIV=$O(^TMP("SDWAIT",$J,SDDIV)) Q:SDDIV=""!(SDQUIT) D SORT(SDDIV,SDSORT) G:SDQUIT PRINTQ
D PAUSE G:SDQUIT PRINTQ
S SDDIV=0 D HDRD^SDAMOWP1 W !,SDASH D HDRT^SDAMOWP1() D
.F S SDDIV=$O(^TMP("SDWTTOTD",$J,SDDIV)) Q:SDDIV=""!(SDQUIT) D TOT^SDAMOWP1("DIV",$P($G(^DG(40.8,SDDIV,0)),U),SDDIV) W !,SDASH
.D TOT^SDAMOWP1("GRAND","TOTAL"),LEGEND^SDAMOWP1
PRINTQ Q
;
SORT(DIV,SORT) ; sort
;
Q:SDSEL=2&(SORT=5)
S (LEVEL1,LEVEL2,LEVEL3,LEVEL4)=0
I SDSEL=2 D TOTP^SDAMOWP1(SORT,DIV,LEVEL1) G SORTQ
I SORT=5 S LEVEL1=$O(^TMP("SDWAIT",$J,DIV,LEVEL1)) D HDR^SDAMOWP1 S LEVEL1=""
F S LEVEL1=$O(^TMP("SDWAIT",$J,DIV,LEVEL1)) Q:LEVEL1=""!(SDQUIT) D:SORT'=5 HDR^SDAMOWP1 D
.F S LEVEL2=$O(^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2)) Q:LEVEL2=""!(SDQUIT) D
..F S LEVEL3=$O(^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2,LEVEL3)) Q:LEVEL3=""!(SDQUIT) D
...I SORT=3!(SORT=4) F S LEVEL4=$O(^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2,LEVEL3,LEVEL4)) Q:LEVEL4=""!(SDQUIT) D SET(SORT,LEVEL1,LEVEL2,LEVEL3,LEVEL4),CHECK S SDATA=^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2,LEVEL3,LEVEL4) Q:'$$PRT
...Q:SORT=3!(SORT=4)
...S SDATA=^(LEVEL3) D SET(SORT,LEVEL1,LEVEL2,LEVEL3,LEVEL4),CHECK Q:SDQUIT Q:'$$PRT
.Q:SDQUIT
.I SORT'=5 N TOTAL,TOTAL1,TOTAL2,TOTAL3,TOTAL4 D
..S TOTAL=$G(^TMP("SDWTTOT",$J,DIV,LEVEL1,"PRIM")),TOTAL1=$P(TOTAL,U,1),TOTAL2=$P(TOTAL,U,2),TOTAL3=$P(TOTAL,U,3),TOTAL4=$P(TOTAL,U,4)
..D TOT
.I SORT'=5 D PAUSE Q:SDQUIT
I SDSORT=5&(SDSEL=1) N TOTAL,TOTAL1,TOTAL2,TOTAL3,TOTAL4 D
.S TOTAL=$G(^TMP("SDWTTOTD",$J,SDDIV,"DIV")),TOTAL1=$P(TOTAL,U,1),TOTAL2=$P(TOTAL,U,2),TOTAL3=$P(TOTAL,U,3),TOTAL4=$P(TOTAL,U,4)
.D TOT
SORTQ Q
PRT() ; -- print appt
; return: continue processing [ 1|yes 0|no ]
; ^TMP("SDWAIT") nodes setup:
;SDCLIN^SDSTOP^SDDAY^SDDIV^DFN^SDCHKIN^SDCHKOUT^SDWTTIME^SDOTTIME^SDTTTIME
; 1 2 3 4 5 6 7 8 9 10
;
N Y,VA,SDREQ,SDVAR,SDTIME
S DFN=$P(SDATA,U,5) D PID^VADPT6
W !,$E($P($G(^DPT(DFN,0)),U,1),1,17),?20,VA("BID"),?26,$S("^3^4^5^"[(U_SDSORT_U):$E(SDCLN,1,20),1:"")
W ?46,$E($$FDTTM^VALM1($P(SDATA,U,6)),1,14),?62,$E($$FDTTM^VALM1(SDATE),1,14),?78,$$HRS($P(SDATA,U,8))
W ?92,$E($$FDTTM^VALM1($P(SDATA,U,7)),1,14),?109,$$HRS($P(SDATA,U,9)),?120,$$HRS($P(SDATA,U,10))
S Y=1
PRTQ Q Y
;
CHECK ; check to see if header should be printed
I 'SDPAGE D HDR^SDAMOWP1 Q
I $E(IOST,1,2)="C-",($Y+6)>IOSL D PAUSE^VALM1 D:Y HDR^SDAMOWP1 I 'Y S SDQUIT=1 Q
I ($Y+6)>IOSL D HDR^SDAMOWP1
Q
;
PAUSE ; pause for CRT
;
I $E(IOST,1,2)="C-" D PAUSE^VALM1 I 'Y S SDQUIT=1
Q
;
SET(SORT,LEVEL1,LEVEL2,LEVEL3,LEVEL4) ;
I SORT=1 S SDCLN=LEVEL1,SDPAT=LEVEL2,SDATE=LEVEL3
I SORT=2 S SDCLN=LEVEL1,SDATE=LEVEL2,SDPAT=LEVEL3
I SORT=3 S SDSTP=LEVEL1,SDCLN=LEVEL2,SDPAT=LEVEL3,SDATE=LEVEL4
I SORT=4 S SDSTP=LEVEL1,SDPAT=LEVEL2,SDCLN=LEVEL3,SDATE=LEVEL4
I SORT=5 S SDPAT=LEVEL1,SDATE=LEVEL2,SDCLN=LEVEL3
Q
;
TOT ; Totals Print
;
W !,SDASH1,!,?62,"Total:",?78,$$HRS(TOTAL2),?109,$$HRS(TOTAL3),?120,$$HRS(TOTAL4),!,?60,"Average:",?78,$$HRS($P((TOTAL2/TOTAL1),".")),?109,$$HRS($P((TOTAL3/TOTAL1),".")),?120,$$HRS($P((TOTAL4/TOTAL1),".")) D LEGEND^SDAMOWP1
TOTQ Q
;
HRS(MIN) ;Convert minutes to hours
;
N HRS,HRS1
S HRS=MIN/60,HRS1=$P(HRS,"."),MIN=MIN-(HRS1*60)
Q $S(HRS1:HRS1_"hr ",1:"")_MIN_"min"
SDAMOWP ;ALB/CAW - Appointment Waiting Time Print Routine ; 12/1/91
+1 ;;5.3;Scheduling;**12,1015**;Aug 13, 1993;Build 21
+2 ;
PRINT ; -- print arrays
+1 ; var defined:
+2 ; SDSUB2 := top level sort after Division (clinic,stop cd,patient)
+3 ; SDSUB3 := next level sort
+4 ;
+5 USE IO
NEW SDQUIT,SDDIV,SDROU,SDCLN,SDPAT,SDSTP,SDNO,LEVEL1
+6 SET (SDQUIT,SDDIV,SDCLN,SDPAT,SDATE,SDSTP)=""
+7 IF $ORDER(^TMP("SDWAIT",$JOB,SDDIV))=""
SET LEVEL1=0
SET SDNO=1
DO HDR^SDAMOWP1
Begin DoDot:1
+8 WRITE !!?5,"No appointments to report."
+9 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
End DoDot:1
GOTO PRINTQ
+10 ;
+11 FOR
SET SDDIV=$ORDER(^TMP("SDWAIT",$JOB,SDDIV))
IF SDDIV=""!(SDQUIT)
QUIT
DO SORT(SDDIV,SDSORT)
IF SDQUIT
GOTO PRINTQ
+12 DO PAUSE
IF SDQUIT
GOTO PRINTQ
+13 SET SDDIV=0
DO HDRD^SDAMOWP1
WRITE !,SDASH
DO HDRT^SDAMOWP1()
Begin DoDot:1
+14 FOR
SET SDDIV=$ORDER(^TMP("SDWTTOTD",$JOB,SDDIV))
IF SDDIV=""!(SDQUIT)
QUIT
DO TOT^SDAMOWP1("DIV",$PIECE($GET(^DG(40.8,SDDIV,0)),U),SDDIV)
WRITE !,SDASH
+15 DO TOT^SDAMOWP1("GRAND","TOTAL")
DO LEGEND^SDAMOWP1
End DoDot:1
PRINTQ QUIT
+1 ;
SORT(DIV,SORT) ; sort
+1 ;
+2 IF SDSEL=2&(SORT=5)
QUIT
+3 SET (LEVEL1,LEVEL2,LEVEL3,LEVEL4)=0
+4 IF SDSEL=2
DO TOTP^SDAMOWP1(SORT,DIV,LEVEL1)
GOTO SORTQ
+5 IF SORT=5
SET LEVEL1=$ORDER(^TMP("SDWAIT",$JOB,DIV,LEVEL1))
DO HDR^SDAMOWP1
SET LEVEL1=""
+6 FOR
SET LEVEL1=$ORDER(^TMP("SDWAIT",$JOB,DIV,LEVEL1))
IF LEVEL1=""!(SDQUIT)
QUIT
IF SORT'=5
DO HDR^SDAMOWP1
Begin DoDot:1
+7 FOR
SET LEVEL2=$ORDER(^TMP("SDWAIT",$JOB,DIV,LEVEL1,LEVEL2))
IF LEVEL2=""!(SDQUIT)
QUIT
Begin DoDot:2
+8 FOR
SET LEVEL3=$ORDER(^TMP("SDWAIT",$JOB,DIV,LEVEL1,LEVEL2,LEVEL3))
IF LEVEL3=""!(SDQUIT)
QUIT
Begin DoDot:3
+9 IF SORT=3!(SORT=4)
FOR
SET LEVEL4=$ORDER(^TMP("SDWAIT",$JOB,DIV,LEVEL1,LEVEL2,LEVEL3,LEVEL4))
IF LEVEL4=""!(SDQUIT)
QUIT
DO SET(SORT,LEVEL1,LEVEL2,LEVEL3,LEVEL4)
DO CHECK
SET SDATA=^TMP("SDWAIT",$JOB,DIV,LEVEL1,LEVEL2,LEVEL3,LEVEL4)
IF '$$PRT
QUIT
+10 IF SORT=3!(SORT=4)
QUIT
+11 SET SDATA=^(LEVEL3)
DO SET(SORT,LEVEL1,LEVEL2,LEVEL3,LEVEL4)
DO CHECK
IF SDQUIT
QUIT
IF '$$PRT
QUIT
End DoDot:3
End DoDot:2
+12 IF SDQUIT
QUIT
+13 IF SORT'=5
NEW TOTAL,TOTAL1,TOTAL2,TOTAL3,TOTAL4
Begin DoDot:2
+14 SET TOTAL=$GET(^TMP("SDWTTOT",$JOB,DIV,LEVEL1,"PRIM"))
SET TOTAL1=$PIECE(TOTAL,U,1)
SET TOTAL2=$PIECE(TOTAL,U,2)
SET TOTAL3=$PIECE(TOTAL,U,3)
SET TOTAL4=$PIECE(TOTAL,U,4)
+15 DO TOT
End DoDot:2
+16 IF SORT'=5
DO PAUSE
IF SDQUIT
QUIT
End DoDot:1
+17 IF SDSORT=5&(SDSEL=1)
NEW TOTAL,TOTAL1,TOTAL2,TOTAL3,TOTAL4
Begin DoDot:1
+18 SET TOTAL=$GET(^TMP("SDWTTOTD",$JOB,SDDIV,"DIV"))
SET TOTAL1=$PIECE(TOTAL,U,1)
SET TOTAL2=$PIECE(TOTAL,U,2)
SET TOTAL3=$PIECE(TOTAL,U,3)
SET TOTAL4=$PIECE(TOTAL,U,4)
+19 DO TOT
End DoDot:1
SORTQ QUIT
PRT() ; -- print appt
+1 ; return: continue processing [ 1|yes 0|no ]
+2 ; ^TMP("SDWAIT") nodes setup:
+3 ;SDCLIN^SDSTOP^SDDAY^SDDIV^DFN^SDCHKIN^SDCHKOUT^SDWTTIME^SDOTTIME^SDTTTIME
+4 ; 1 2 3 4 5 6 7 8 9 10
+5 ;
+6 NEW Y,VA,SDREQ,SDVAR,SDTIME
+7 SET DFN=$PIECE(SDATA,U,5)
DO PID^VADPT6
+8 WRITE !,$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,1),1,17),?20,VA("BID"),?26,$SELECT("^3^4^5^"[(U_SDSORT_U):$EXTRACT(SDCLN,1,20),1:"")
+9 WRITE ?46,$EXTRACT($$FDTTM^VALM1($PIECE(SDATA,U,6)),1,14),?62,$EXTRACT($$FDTTM^VALM1(SDATE),1,14),?78,$$HRS($PIECE(SDATA,U,8))
+10 WRITE ?92,$EXTRACT($$FDTTM^VALM1($PIECE(SDATA,U,7)),1,14),?109,$$HRS($PIECE(SDATA,U,9)),?120,$$HRS($PIECE(SDATA,U,10))
+11 SET Y=1
PRTQ QUIT Y
+1 ;
CHECK ; check to see if header should be printed
+1 IF 'SDPAGE
DO HDR^SDAMOWP1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF ($Y+6)>IOSL
DO PAUSE^VALM1
IF Y
DO HDR^SDAMOWP1
IF 'Y
SET SDQUIT=1
QUIT
+3 IF ($Y+6)>IOSL
DO HDR^SDAMOWP1
+4 QUIT
+5 ;
PAUSE ; pause for CRT
+1 ;
+2 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
IF 'Y
SET SDQUIT=1
+3 QUIT
+4 ;
SET(SORT,LEVEL1,LEVEL2,LEVEL3,LEVEL4) ;
+1 IF SORT=1
SET SDCLN=LEVEL1
SET SDPAT=LEVEL2
SET SDATE=LEVEL3
+2 IF SORT=2
SET SDCLN=LEVEL1
SET SDATE=LEVEL2
SET SDPAT=LEVEL3
+3 IF SORT=3
SET SDSTP=LEVEL1
SET SDCLN=LEVEL2
SET SDPAT=LEVEL3
SET SDATE=LEVEL4
+4 IF SORT=4
SET SDSTP=LEVEL1
SET SDPAT=LEVEL2
SET SDCLN=LEVEL3
SET SDATE=LEVEL4
+5 IF SORT=5
SET SDPAT=LEVEL1
SET SDATE=LEVEL2
SET SDCLN=LEVEL3
+6 QUIT
+7 ;
TOT ; Totals Print
+1 ;
+2 WRITE !,SDASH1,!,?62,"Total:",?78,$$HRS(TOTAL2),?109,$$HRS(TOTAL3),?120,$$HRS(TOTAL4),!,?60,"Average:",?78,$$HRS($PIECE((TOTAL2/TOTAL1),".")),?109,$$HRS($PIECE((TOTAL3/TOTAL1),".")),?120,$$HRS($PIECE((TOTAL4/TOTAL1),"."))
DO LEGEND^SDAMOWP1
TOTQ QUIT
+1 ;
HRS(MIN) ;Convert minutes to hours
+1 ;
+2 NEW HRS,HRS1
+3 SET HRS=MIN/60
SET HRS1=$PIECE(HRS,".")
SET MIN=MIN-(HRS1*60)
+4 QUIT $SELECT(HRS1:HRS1_"hr ",1:"")_MIN_"min"
