- 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"
