SDAMOCP1.m

SDAMOCP1 ;IOFO BAY PINES/TEH - Detail Print for Cancelled Statistics;4/15/92  ; Compiled January 25, 2007 12:00:46

 ;;5.3;Scheduling;**487,496,1015**;Aug 13, 1993;Build 21

 ;

HDR ;Report Header

 ;

 N SDSTOP

 I SDPAGE>1,$E(IOST,1,2)="C-" D PAUSE^VALM1 I 'Y S SDSTOP=1 Q

HDR1 W @IOF

 W !,?50,"Cancelled Clinic Report - Detail"

 W !,?50,"Date Range: ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)

 D NOW^%DTC

 W !,?54,"Run Date: ",$E($$FDTTM^VALM1(%),1,14)

 W !,?62,"Page: ",SDPAGE S SDPAGE=SDPAGE+1

 W !,"Division"

 W !,SDASH,!

 W "Status",?8,"Patient",?30,"SSN",?39,"Appt Date",?61,"Clinic",?81,"Cancel Date",?106,"User",!

 W SDASH

 Q

 ;

BLD ;Build output from ^TMP global

 ;

 N SDTOT,SDTOTT,SDCL,SDDATE,SDUSER,SDCDT

 D HDR

 I IOST["P-" K DIRUT

 S (SDSTOP,SDTOTT,SDFLG)=0,SDDV="" F  S SDDV=$O(^TMP("SDAMCD",$J,SDDV)) Q:SDDV=""!(SDSTOP)  D CHK D

 .S SDDVNM=$P($G(^DG(40.8,SDDV,0)),U) W !,SDDVNM

 .S SDCR="" F  S SDCR=$O(^TMP("SDAMCD",$J,SDDV,SDCR)) Q:SDCR=""!($D(DIRUT))  S SDTOT(SDCR)=0 D  W !!,"SUBTOTAL:",$J(SDTOT(SDCR),4),!

 ..S SDCL="" F  S SDCL=$O(^TMP("SDAMCD",$J,SDDV,SDCR,SDCL)) Q:SDCL=""!($D(DIRUT))  D 

 ...S SDDATE="" F  S SDDATE=$O(^TMP("SDAMCD",$J,SDDV,SDCR,SDCL,SDDATE)) Q:SDDATE=""!($D(DIRUT))  D

 ....S SDDFN="" F  S SDDFN=$O(^TMP("SDAMCD",$J,SDDV,SDCR,SDCL,SDDATE,SDDFN)) Q:SDDFN=""!($D(DIRUT))  D

 .....S SDDATA=$G(^TMP("SDAMCD",$J,SDDV,SDCR,SDCL,SDDATE,SDDFN))

 .....S Y=$P(SDDATA,";",2) D DD^%DT S SDAPDT=Y

 .....D GETS^DIQ(2,SDDFN_",",".01;.09",,"SDRES","SDMES") S SDNM=$E($G(SDRES(2,SDDFN_",",.01)),1,20),SDSSN=$E($G(SDRES(2,SDDFN_",",.09)),6,9)

 .....S Y=$P(SDDATA,U,14) D DD^%DT S SDCDT=Y S SDUSER=$P(SDDATA,U,12)

 .....S SDUSERNM=$$GET1^DIQ(200,SDUSER_",",.01,,"SDRES","SDMES")

 .....S SDCLNM=$$GET1^DIQ(44,SDCL_",",.01,,"SDRES","SDMES")

 .....W !,SDCR,?8,$E(SDNM,1,22),?30,SDSSN,?39,SDAPDT,?61,$E(SDCLNM,1,18),?81,SDCDT,?106,$E(SDUSERNM,1,26)

 .....K SDRES,SDMES ;SD/496

 .....D CHK I $D(DIRUT) Q 

 .....S SDTOT(SDCR)=$G(SDTOT(SDCR))+1,SDTOTT=SDTOTT+1

 W !!,"TOTAL CANCELLATIONS:",$J(SDTOTT,14)

 W !!,"End of Report!"

 K SDUSERNM,SDSSN,SDAPDT,SDCLNM,SDRES,SDNM,SDCR,SDDDATE,SDDFN,SDDATA,SDDVNM,SDCLNM

 I IOST["P-" S DIRUT=1

BLDQ Q

 ;

MCTOT ;

 N SDFLG,SDDV,SDNXT

 S SDFLG=1,SDDV="" D HDR F  S SDDV=$O(^TMP("SDAMS",$J,SDDV)) Q:SDDV=""  D  Q:SDSTOP

 .W !,$P($G(^DG(40.8,SDDV,0)),U)

 .K SDTOT,SDCNT D TOTAL

 .W ?124,$J(SDTOT,8)

 .D CHK Q:SDSTOP

 .S SDNXT=$O(^TMP("SDAMS",$J,SDDV)) W:SDNXT'="" !,SDASH

 .K SDTOT,SDCNT

 W !,SDTDASH,!,"TOTAL" F SDI=1:1:11 S SDCNT(SDI)=+$G(SDAT("SDAMS",$J,SDI)),SDTOT=$G(SDTOT)+$G(SDCNT(SDI))

 D CNT

 W ?124,$J(SDTOT,8) K SDTOT,SDCNT D CHK I SDSTOP G MCTOTQ

 W !! D LEGEND

MCTOTQ Q

CNT ;Place no-show/no-show auto rebook & cancel/cancel auto-rebook together

 S SDCNT(4)=+$G(SDCNT(4))+(+$G(SDCNT(6))),SDCNT(13)=+$G(SDCI(+SDCL,4))+(+$G(SDCI(+SDCL,6)))

 S SDCNT(5)=+$G(SDCNT(5))+(+$G(SDCNT(7))),SDCNT(14)=+$G(SDCI(+SDCL,5))+(+$G(SDCI(+SDCL,7)))

 F SDI=1,2,3,4,13,6,5,14,7,8 D

 .W ?$$COL(SDI),$J($S($D(SDCNT(SDI)):SDCNT(SDI),1:0),$$LEN(SDI))

 Q

 ;

CHK ;Check to pause on screen

 N SDY

 I $E(IOST,1,2)="C-",($Y+8)>IOSL D PAUSE^VALM1 S SDY=Y D:SDY HDR1 I 'SDY S SDSTOP=1 Q

 I ($Y+8)>IOSL D HDR1

 Q

TOTAL ;Totals

 F SDI=1:1:11 S SDCNT(SDI)=+$G(SDCL("SDAMS",$J,SDDV,SDI)),SDTOT=$G(SDTOT)+$G(SDCNT(SDI))

 D CNT

 K SDCNT

 Q

 ;

LEGEND ;Legend on bottom of output

 ;

 W !,?5,"o CI=Checked In ; RB=Rebooked"

 W !,?5,"o 'Cancelled' appointments only reflect appointments cancelled using 'Cancel Clinic Availability'."

 W !,?5,"o 'Checked-In' does not include no-shows or cancelled appointments that have been checked in."

 Q

 ;

COL(SDI) ;Column placement of appt. status

 ;

 ;input - SDI (appt. type)

 ;output - column placement

 Q $S(SDI=1:34,SDI=2:48,SDI=3:63,SDI=4:81,SDI=5:97,SDI=6:92,SDI=7:108,SDI=8:114,SDI=13:87,SDI=14:103)

 ;

LEN(SDI) ;Length of column

 ;

 ;input - SDI (appt. type)

 ;output - length of column

 Q $S(SDI=1:10,SDI=2:11,SDI=3:15,SDI=4:5,SDI=6:4,SDI=5:5,SDI=7:4,SDI=8:9,SDI=13:4,SDI=14:4)

 ;

SDAMOCP1  ;IOFO BAY PINES/TEH - Detail Print for Cancelled Statistics;4/15/92  ; Compiled January 25, 2007 12:00:46

 +1       ;;5.3;Scheduling;**487,496,1015**;Aug 13, 1993;Build 21

 +2       ;

HDR       ;Report Header

 +1       ;

 +2        NEW SDSTOP

 +3        IF SDPAGE>1

               IF $EXTRACT(IOST,1,2)="C-"

                   DO PAUSE^VALM1

                   IF 'Y

                       SET SDSTOP=1

                       QUIT 

HDR1       WRITE @IOF

 +1        WRITE !,?50,"Cancelled Clinic Report - Detail"

 +2        WRITE !,?50,"Date Range: ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)

 +3        DO NOW^%DTC

 +4        WRITE !,?54,"Run Date: ",$EXTRACT($$FDTTM^VALM1(%),1,14)

 +5        WRITE !,?62,"Page: ",SDPAGE

           SET SDPAGE=SDPAGE+1

 +6        WRITE !,"Division"

 +7        WRITE !,SDASH,!

 +8        WRITE "Status",?8,"Patient",?30,"SSN",?39,"Appt Date",?61,"Clinic",?81,"Cancel Date",?106,"User",!

 +9        WRITE SDASH

 +10       QUIT 

 +11      ;

BLD       ;Build output from ^TMP global

 +1       ;

 +2        NEW SDTOT,SDTOTT,SDCL,SDDATE,SDUSER,SDCDT

 +3        DO HDR

 +4        IF IOST["P-"

               KILL DIRUT

 +5        SET (SDSTOP,SDTOTT,SDFLG)=0

           SET SDDV=""

           FOR 

               SET SDDV=$ORDER(^TMP("SDAMCD",$JOB,SDDV))

               IF SDDV=""!(SDSTOP)

                   QUIT 

               DO CHK

               Begin DoDot:1

 +6                SET SDDVNM=$PIECE($GET(^DG(40.8,SDDV,0)),U)

                   WRITE !,SDDVNM

 +7                SET SDCR=""

                   FOR 

                       SET SDCR=$ORDER(^TMP("SDAMCD",$JOB,SDDV,SDCR))

                       IF SDCR=""!($DATA(DIRUT))

                           QUIT 

                       SET SDTOT(SDCR)=0

                       Begin DoDot:2

 +8                        SET SDCL=""

                           FOR 

                               SET SDCL=$ORDER(^TMP("SDAMCD",$JOB,SDDV,SDCR,SDCL))

                               IF SDCL=""!($DATA(DIRUT))

                                   QUIT 

                               Begin DoDot:3

 +9                                SET SDDATE=""

                                   FOR 

                                       SET SDDATE=$ORDER(^TMP("SDAMCD",$JOB,SDDV,SDCR,SDCL,SDDATE))

                                       IF SDDATE=""!($DATA(DIRUT))

                                           QUIT 

                                       Begin DoDot:4

 +10                                       SET SDDFN=""

                                           FOR 

                                               SET SDDFN=$ORDER(^TMP("SDAMCD",$JOB,SDDV,SDCR,SDCL,SDDATE,SDDFN))

                                               IF SDDFN=""!($DATA(DIRUT))

                                                   QUIT 

                                               Begin DoDot:5

 +11                                               SET SDDATA=$GET(^TMP("SDAMCD",$JOB,SDDV,SDCR,SDCL,SDDATE,SDDFN))

 +12                                               SET Y=$PIECE(SDDATA,";",2)

                                                   DO DD^%DT

                                                   SET SDAPDT=Y

 +13                                               DO GETS^DIQ(2,SDDFN_",",".01;.09",,"SDRES","SDMES")

                                                   SET SDNM=$EXTRACT($GET(SDRES(2,SDDFN_",",.01)),1,20)

                                                   SET SDSSN=$EXTRACT($GET(SDRES(2,SDDFN_",",.09)),6,9)

 +14                                               SET Y=$PIECE(SDDATA,U,14)

                                                   DO DD^%DT

                                                   SET SDCDT=Y

                                                   SET SDUSER=$PIECE(SDDATA,U,12)

 +15                                               SET SDUSERNM=$$GET1^DIQ(200,SDUSER_",",.01,,"SDRES","SDMES")

 +16                                               SET SDCLNM=$$GET1^DIQ(44,SDCL_",",.01,,"SDRES","SDMES")

 +17                                               WRITE !,SDCR,?8,$EXTRACT(SDNM,1,22),?30,SDSSN,?39,SDAPDT,?61,$EXTRACT(SDCLNM,1,18),?81,SDCDT,?106,$EXTRACT(SDUSERNM,1,26)

 +18      ;SD/496

                                                   KILL SDRES,SDMES

 +19                                               DO CHK

                                                   IF $DATA(DIRUT)

                                                       QUIT 

 +20                                               SET SDTOT(SDCR)=$GET(SDTOT(SDCR))+1

                                                   SET SDTOTT=SDTOTT+1

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

                       WRITE !!,"SUBTOTAL:",$JUSTIFY(SDTOT(SDCR),4),!

               End DoDot:1

 +21       WRITE !!,"TOTAL CANCELLATIONS:",$JUSTIFY(SDTOTT,14)

 +22       WRITE !!,"End of Report!"

 +23       KILL SDUSERNM,SDSSN,SDAPDT,SDCLNM,SDRES,SDNM,SDCR,SDDDATE,SDDFN,SDDATA,SDDVNM,SDCLNM

 +24       IF IOST["P-"

               SET DIRUT=1

BLDQ       QUIT 

 +1       ;

MCTOT     ;

 +1        NEW SDFLG,SDDV,SDNXT

 +2        SET SDFLG=1

           SET SDDV=""

           DO HDR

           FOR 

               SET SDDV=$ORDER(^TMP("SDAMS",$JOB,SDDV))

               IF SDDV=""

                   QUIT 

               Begin DoDot:1

 +3                WRITE !,$PIECE($GET(^DG(40.8,SDDV,0)),U)

 +4                KILL SDTOT,SDCNT

                   DO TOTAL

 +5                WRITE ?124,$JUSTIFY(SDTOT,8)

 +6                DO CHK

                   IF SDSTOP

                       QUIT 

 +7                SET SDNXT=$ORDER(^TMP("SDAMS",$JOB,SDDV))

                   IF SDNXT'=""

                       WRITE !,SDASH

 +8                KILL SDTOT,SDCNT

               End DoDot:1

               IF SDSTOP

                   QUIT 

 +9        WRITE !,SDTDASH,!,"TOTAL"

           FOR SDI=1:1:11

               SET SDCNT(SDI)=+$GET(SDAT("SDAMS",$JOB,SDI))

               SET SDTOT=$GET(SDTOT)+$GET(SDCNT(SDI))

 +10       DO CNT

 +11       WRITE ?124,$JUSTIFY(SDTOT,8)

           KILL SDTOT,SDCNT

           DO CHK

           IF SDSTOP

               GOTO MCTOTQ

 +12       WRITE !!

           DO LEGEND

MCTOTQ     QUIT 

CNT       ;Place no-show/no-show auto rebook & cancel/cancel auto-rebook together

 +1        SET SDCNT(4)=+$GET(SDCNT(4))+(+$GET(SDCNT(6)))

           SET SDCNT(13)=+$GET(SDCI(+SDCL,4))+(+$GET(SDCI(+SDCL,6)))

 +2        SET SDCNT(5)=+$GET(SDCNT(5))+(+$GET(SDCNT(7)))

           SET SDCNT(14)=+$GET(SDCI(+SDCL,5))+(+$GET(SDCI(+SDCL,7)))

 +3        FOR SDI=1,2,3,4,13,6,5,14,7,8

               Begin DoDot:1

 +4                WRITE ?$$COL(SDI),$JUSTIFY($SELECT($DATA(SDCNT(SDI)):SDCNT(SDI),1:0),$$LEN(SDI))

               End DoDot:1

 +5        QUIT 

 +6       ;

CHK       ;Check to pause on screen

 +1        NEW SDY

 +2        IF $EXTRACT(IOST,1,2)="C-"

               IF ($Y+8)>IOSL

                   DO PAUSE^VALM1

                   SET SDY=Y

                   IF SDY

                       DO HDR1

                   IF 'SDY

                       SET SDSTOP=1

                       QUIT 

 +3        IF ($Y+8)>IOSL

               DO HDR1

 +4        QUIT 

TOTAL     ;Totals

 +1        FOR SDI=1:1:11

               SET SDCNT(SDI)=+$GET(SDCL("SDAMS",$JOB,SDDV,SDI))

               SET SDTOT=$GET(SDTOT)+$GET(SDCNT(SDI))

 +2        DO CNT

 +3        KILL SDCNT

 +4        QUIT 

 +5       ;

LEGEND    ;Legend on bottom of output

 +1       ;

 +2        WRITE !,?5,"o CI=Checked In ; RB=Rebooked"

 +3        WRITE !,?5,"o 'Cancelled' appointments only reflect appointments cancelled using 'Cancel Clinic Availability'."

 +4        WRITE !,?5,"o 'Checked-In' does not include no-shows or cancelled appointments that have been checked in."

 +5        QUIT 

 +6       ;

COL(SDI)  ;Column placement of appt. status

 +1       ;

 +2       ;input - SDI (appt. type)

 +3       ;output - column placement

 +4        QUIT $SELECT(SDI=1:34,SDI=2:48,SDI=3:63,SDI=4:81,SDI=5:97,SDI=6:92,SDI=7:108,SDI=8:114,SDI=13:87,SDI=14:103)

 +5       ;

LEN(SDI)  ;Length of column

 +1       ;

 +2       ;input - SDI (appt. type)

 +3       ;output - length of column

 +4        QUIT $SELECT(SDI=1:10,SDI=2:11,SDI=3:15,SDI=4:5,SDI=6:4,SDI=5:5,SDI=7:4,SDI=8:9,SDI=13:4,SDI=14:4)

 +5       ;